From 71c835569844caa89ad4ff7cf32eab8bc61325e3 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 22 Jul 2010 07:25:06 +0300
Subject: [PATCH] URL settings in Yesod typeclass

---
 Yesod/Form.hs   | 56 +++++++++++++++++++++++++++++--------------------
 Yesod/Urls.hs   | 43 -------------------------------------
 Yesod/Widget.hs |  8 +++++++
 Yesod/Yesod.hs  | 20 ++++++++++++++++++
 yesod.cabal     |  1 -
 5 files changed, 61 insertions(+), 67 deletions(-)
 delete mode 100644 Yesod/Urls.hs

diff --git a/Yesod/Form.hs b/Yesod/Form.hs
index 625548cc..b9323ff9 100644
--- a/Yesod/Form.hs
+++ b/Yesod/Form.hs
@@ -102,7 +102,7 @@ import Yesod.Widget
 import Control.Arrow ((&&&))
 import qualified Text.Email.Validate as Email
 import Data.Char (isSpace)
-import Yesod.Urls
+import Yesod.Yesod (Yesod (..))
 
 -- | A form can produce three different results: there was no data available,
 -- the data was invalid, or there was a successful parse.
@@ -413,19 +413,19 @@ instance ToFormField Day where
 instance ToFormField (Maybe Day) where
     toFormField = maybeDayField
 
-jqueryDayField :: Html () -> Html () -> FormletField sub y Day
+jqueryDayField :: Yesod y => Html () -> Html () -> FormletField sub y Day
 jqueryDayField l t = requiredFieldHelper jqueryDayFieldProfile
     { fpLabel = l
     , fpTooltip = t
     }
 
-maybeJqueryDayField :: Html () -> Html () -> FormletField sub y (Maybe Day)
+maybeJqueryDayField :: Yesod y => Html () -> Html () -> FormletField sub y (Maybe Day)
 maybeJqueryDayField l t = optionalFieldHelper jqueryDayFieldProfile
     { fpLabel = l
     , fpTooltip = t
     }
 
-jqueryDayFieldProfile :: FieldProfile sub y Day
+jqueryDayFieldProfile :: Yesod y => FieldProfile sub y Day
 jqueryDayFieldProfile = FieldProfile
     { fpParse = maybe
                   (Left "Invalid day, must be in YYYY-MM-DD format")
@@ -436,9 +436,9 @@ jqueryDayFieldProfile = FieldProfile
 %input#$name$!name=$name$!type=date!:isReq:required!value=$val$
 |]
     , fpWidget = \name -> do
-        getSetting urlJqueryJs >>= addScriptRemote
-        getSetting urlJqueryUiJs >>= addScriptRemote
-        getSetting urlJqueryUiCss >>= addStylesheetRemote
+        addScript' urlJqueryJs
+        addScript' urlJqueryUiJs
+        addStylesheet' urlJqueryUiCss
         addJavaScript [$hamlet|
 $$(function(){$$("#$name$").datepicker({dateFormat:'yy-mm-dd'})});
 |]
@@ -469,7 +469,7 @@ parseUTCTime s =
             Right date -> ifRight (parseTime timeS)
                                   (\time -> UTCTime date (timeOfDayToTime time))
 
-jqueryDayTimeField :: Html () -> Html () -> FormletField sub y UTCTime
+jqueryDayTimeField :: Yesod y => Html () -> Html () -> FormletField sub y UTCTime
 jqueryDayTimeField l t = requiredFieldHelper jqueryDayTimeFieldProfile
     { fpLabel = l , fpTooltip = t }
 
@@ -488,7 +488,7 @@ jqueryDayTimeUTCTime (UTCTime day utcTime) =
       let (h, apm) = if hour < 12 then (hour, "AM") else (hour - 12, "PM")
       in (show h) ++ ":" ++ (showLeadingZero minute) ++ " " ++ apm
 
-jqueryDayTimeFieldProfile :: FieldProfile sub y UTCTime
+jqueryDayTimeFieldProfile :: Yesod y => FieldProfile sub y UTCTime
 jqueryDayTimeFieldProfile = FieldProfile
     { fpParse  = parseUTCTime
     , fpRender = jqueryDayTimeUTCTime
@@ -496,10 +496,10 @@ jqueryDayTimeFieldProfile = FieldProfile
 %input#$name$!name=$name$!type=date!:isReq:required!value=$val$
 |]
     , fpWidget = \name -> do
-        getSetting urlJqueryJs >>= addScriptRemote
-        getSetting urlJqueryUiJs >>= addScriptRemote
-        getSetting urlJqueryUiDateTimePicker >>= addScriptRemote -- needs slashes, dashes are broken
-        getSetting urlJqueryUiCss >>= addStylesheetRemote
+        addScript' urlJqueryJs
+        addScript' urlJqueryUiJs
+        addScript' urlJqueryUiDateTimePicker
+        addStylesheet' urlJqueryUiCss
         addJavaScript [$hamlet|
 $$(function(){$$("#$name$").datetimepicker({dateFormat : "yyyy/mm/dd h:MM TT"})});
 |]
@@ -616,19 +616,19 @@ instance ToFormField (Maybe (Html ())) where
 
 type Html' = Html ()
 
-nicHtmlField :: Html () -> Html () -> FormletField sub y (Html ())
+nicHtmlField :: Yesod y => Html () -> Html () -> FormletField sub y (Html ())
 nicHtmlField label tooltip = requiredFieldHelper nicHtmlFieldProfile
     { fpLabel = label
     , fpTooltip = tooltip
     }
 
-maybeNicHtmlField :: Html () -> Html () -> FormletField sub y (Maybe (Html ()))
+maybeNicHtmlField :: Yesod y => Html () -> Html () -> FormletField sub y (Maybe (Html ()))
 maybeNicHtmlField label tooltip = optionalFieldHelper nicHtmlFieldProfile
     { fpLabel = label
     , fpTooltip = tooltip
     }
 
-nicHtmlFieldProfile :: FieldProfile sub y (Html ())
+nicHtmlFieldProfile :: Yesod y => FieldProfile sub y (Html ())
 nicHtmlFieldProfile = FieldProfile
     { fpParse = Right . preEscapedString
     , fpRender = U.toString . renderHtml
@@ -636,7 +636,7 @@ nicHtmlFieldProfile = FieldProfile
 %textarea.html#$name$!name=$name$ $val$
 |]
     , fpWidget = \name -> do
-        addScriptRemote "http://js.nicedit.com/nicEdit-latest.js"
+        addScript' urlNicEdit
         addJavaScript [$hamlet|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("$name$")});|]
     , fpName = Nothing
     , fpLabel = mempty
@@ -874,7 +874,7 @@ toLabel (x:rest) = toUpper x : go rest
         | isUpper c = ' ' : c : go cs
         | otherwise = c : go cs
 
-jqueryAutocompleteField ::
+jqueryAutocompleteField :: Yesod y =>
     Route y -> Html () -> Html () -> FormletField sub y String
 jqueryAutocompleteField src l t =
     requiredFieldHelper $ (jqueryAutocompleteFieldProfile src)
@@ -882,7 +882,7 @@ jqueryAutocompleteField src l t =
         , fpTooltip = t
         }
 
-maybeJqueryAutocompleteField ::
+maybeJqueryAutocompleteField :: Yesod y =>
     Route y -> Html () -> Html () -> FormletField sub y (Maybe String)
 maybeJqueryAutocompleteField src l t =
     optionalFieldHelper $ (jqueryAutocompleteFieldProfile src)
@@ -890,7 +890,7 @@ maybeJqueryAutocompleteField src l t =
         , fpTooltip = t
         }
 
-jqueryAutocompleteFieldProfile :: Route y -> FieldProfile sub y String
+jqueryAutocompleteFieldProfile :: Yesod y => Route y -> FieldProfile sub y String
 jqueryAutocompleteFieldProfile src = FieldProfile
     { fpParse = Right
     , fpRender = id
@@ -898,9 +898,9 @@ jqueryAutocompleteFieldProfile src = FieldProfile
 %input.autocomplete#$name$!name=$name$!type=text!:isReq:required!value=$val$
 |]
     , fpWidget = \name -> do
-        getSetting urlJqueryJs >>= addScriptRemote
-        getSetting urlJqueryUiJs >>= addScriptRemote
-        getSetting urlJqueryUiCss >>= addStylesheetRemote
+        addScript' urlJqueryJs
+        addScript' urlJqueryUiJs
+        addStylesheet' urlJqueryUiCss
         addJavaScript [$hamlet|
 $$(function(){$$("#$name$").autocomplete({source:"@src@",minLength:2})});
 |]
@@ -942,3 +942,13 @@ emailInput n =
     requiredFieldHelper emailFieldProfile
     { fpName = Just n
     } Nothing
+
+addScript' :: (y -> Either (Route y) String) -> GWidget sub y ()
+addScript' f = do
+    y <- liftHandler getYesod
+    addScriptEither $ f y
+
+addStylesheet' :: (y -> Either (Route y) String) -> GWidget sub y ()
+addStylesheet' f = do
+    y <- liftHandler getYesod
+    addStylesheetEither $ f y
diff --git a/Yesod/Urls.hs b/Yesod/Urls.hs
deleted file mode 100644
index 9b7c41c2..00000000
--- a/Yesod/Urls.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-module Yesod.Urls
-    ( newSetting
-    , changeSetting
-    , getSetting
-      -- * Default library URLs
-    , urlJqueryJs
-    , urlJqueryUiJs
-    , urlJqueryUiCss
-    , urlJqueryUiDateTimePicker
-    ) where
-
-import Data.IORef (IORef, newIORef, writeIORef, readIORef)
-import System.IO.Unsafe (unsafePerformIO)
-import Control.Monad.IO.Class
-
-newSetting :: a -> IORef a
-newSetting = unsafePerformIO . newIORef
-
-changeSetting :: MonadIO m => IORef a -> a -> m ()
-changeSetting x = liftIO . writeIORef x
-
-getSetting :: MonadIO m => IORef a -> m a
-getSetting = liftIO . readIORef
-
--- | The Google-hosted jQuery 1.4.2 file.
-urlJqueryJs :: IORef String
-urlJqueryJs = newSetting
-    "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
-
--- | The Google-hosted jQuery UI 1.8.1 javascript file.
-urlJqueryUiJs :: IORef String
-urlJqueryUiJs = newSetting
-    "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/jquery-ui.min.js"
-
--- | The Google-hosted jQuery UI 1.8.1 CSS file with cupertino theme.
-urlJqueryUiCss :: IORef String
-urlJqueryUiCss = newSetting
-    "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/themes/cupertino/jquery-ui.css"
-
--- TODO - integrate with static helpers
-urlJqueryUiDateTimePicker :: IORef String
-urlJqueryUiDateTimePicker = newSetting
-    "http://www.projectcodegen.com/jquery.ui.datetimepicker.js.txt"
diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs
index 7630f15d..1737b867 100644
--- a/Yesod/Widget.hs
+++ b/Yesod/Widget.hs
@@ -19,8 +19,10 @@ module Yesod.Widget
     , addStyle
     , addStylesheet
     , addStylesheetRemote
+    , addStylesheetEither
     , addScript
     , addScriptRemote
+    , addScriptEither
     , addHead
     , addBody
     , addJavaScript
@@ -131,6 +133,12 @@ addStylesheetRemote :: String -> GWidget sub master ()
 addStylesheetRemote =
     GWidget . lift . lift . lift . tell . toUnique . Stylesheet . Remote
 
+addStylesheetEither :: Either (Route master) String -> GWidget sub master ()
+addStylesheetEither = either addStylesheet addStylesheetRemote
+
+addScriptEither :: Either (Route master) String -> GWidget sub master ()
+addScriptEither = either addScript addScriptRemote
+
 -- | Link to the specified local script.
 addScript :: Route master -> GWidget sub master ()
 addScript = GWidget . lift . lift . tell . toUnique . Script . Local
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index 9b800dfa..3cba2a6f 100644
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -118,6 +118,26 @@ class Eq (Route a) => Yesod a where
     authRoute :: a -> Maybe (Route a)
     authRoute _ = Nothing
 
+    -- | The jQuery Javascript file.
+    urlJqueryJs :: a -> Either (Route a) String
+    urlJqueryJs _ = Right "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
+
+    -- | The jQuery UI 1.8.1 Javascript file.
+    urlJqueryUiJs :: a -> Either (Route a) String
+    urlJqueryUiJs _ = Right "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/jquery-ui.min.js"
+
+    -- | The jQuery UI 1.8.1 CSS file; defaults to cupertino theme.
+    urlJqueryUiCss :: a -> Either (Route a) String
+    urlJqueryUiCss _ = Right "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/themes/cupertino/jquery-ui.css"
+
+    -- | jQuery UI time picker add-on.
+    urlJqueryUiDateTimePicker :: a -> Either (Route a) String
+    urlJqueryUiDateTimePicker _ = Right "http://www.projectcodegen.com/jquery.ui.datetimepicker.js.txt"
+
+    -- | NIC Editor.
+    urlNicEdit :: a -> Either (Route a) String
+    urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js"
+
 data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
     deriving (Eq, Show, Read)
 
diff --git a/yesod.cabal b/yesod.cabal
index 03ecbb55..25372373 100644
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -53,7 +53,6 @@ library
                      Yesod.Handler
                      Yesod.Internal
                      Yesod.Json
-                     Yesod.Urls
                      Yesod.Request
                      Yesod.Widget
                      Yesod.Yesod