From b5fa539f1bc4a369b3e7ab639b25d5774e8c908a Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 13 Aug 2010 17:16:50 +0300
Subject: [PATCH] Remove fpHamlet

---
 Yesod/Form/Class.hs    |  4 ++--
 Yesod/Form/Core.hs     | 12 ++++++------
 Yesod/Form/Jquery.hs   | 12 ++++++------
 Yesod/Form/Nic.hs      |  7 ++-----
 Yesod/Form/Profiles.hs | 34 ++++++++++++----------------------
 5 files changed, 28 insertions(+), 41 deletions(-)

diff --git a/Yesod/Form/Class.hs b/Yesod/Form/Class.hs
index 58c4df15..83f699c8 100644
--- a/Yesod/Form/Class.hs
+++ b/Yesod/Form/Class.hs
@@ -13,9 +13,9 @@ import Data.Int (Int64)
 import Data.Time (Day, TimeOfDay)
 
 class ToForm a y where
-    toForm :: Maybe a -> Form sub y a
+    toForm :: Formlet sub y a
 class ToFormField a y where
-    toFormField :: FormFieldSettings -> Maybe a -> FormField sub y a
+    toFormField :: FormFieldSettings -> FormletField sub y a
 
 instance ToFormField String y where
     toFormField = stringField
diff --git a/Yesod/Form/Core.hs b/Yesod/Form/Core.hs
index 81aab78d..75f4c9e2 100644
--- a/Yesod/Form/Core.hs
+++ b/Yesod/Form/Core.hs
@@ -126,7 +126,7 @@ instance Monoid xml => Applicative (GForm sub url xml) where
 -- 'FieldProfile'.ngs
 requiredFieldHelper :: FieldProfile sub y a -> FormFieldSettings
                     -> Maybe a -> FormField sub y a
-requiredFieldHelper (FieldProfile parse render mkXml w) ffs orig =
+requiredFieldHelper (FieldProfile parse render mkWidget) ffs orig =
   GForm $ \env _ -> do
     let (FormFieldSettings label tooltip theId' name') = ffs
     name <- maybe newFormIdent return name'
@@ -146,7 +146,7 @@ requiredFieldHelper (FieldProfile parse render mkXml w) ffs orig =
             , fiTooltip = tooltip
             , fiIdent = theId
             , fiName = name
-            , fiInput = w theId >> addBody (mkXml theId name val True)
+            , fiInput = mkWidget theId name val True
             , fiErrors = case res of
                             FormFailure [x] -> Just $ string x
                             _ -> Nothing
@@ -157,7 +157,7 @@ requiredFieldHelper (FieldProfile parse render mkXml w) ffs orig =
 -- 'FieldProfile'.
 optionalFieldHelper :: FieldProfile sub y a -> FormFieldSettings
                     -> FormletField sub y (Maybe a)
-optionalFieldHelper (FieldProfile parse render mkXml w) ffs orig' =
+optionalFieldHelper (FieldProfile parse render mkWidget) ffs orig' =
   GForm $ \env _ -> do
     let (FormFieldSettings label tooltip theId' name') = ffs
     let orig = join orig'
@@ -178,7 +178,7 @@ optionalFieldHelper (FieldProfile parse render mkXml w) ffs orig' =
             , fiTooltip = tooltip
             , fiIdent = theId
             , fiName = name
-            , fiInput = w theId >> addBody (mkXml theId name val False)
+            , fiInput = mkWidget theId name val False
             , fiErrors = case res of
                             FormFailure [x] -> Just $ string x
                             _ -> Nothing
@@ -221,8 +221,8 @@ instance IsString FormFieldSettings where
 data FieldProfile sub y a = FieldProfile
     { fpParse :: String -> Either String a
     , fpRender :: a -> String
-    , fpHamlet :: String -> String -> String -> Bool -> Hamlet (Route y)
-    , fpWidget :: String -> GWidget sub y ()
+    -- | ID, name, value, required
+    , fpWidget :: String -> String -> String -> Bool -> GWidget sub y ()
     }
 
 type Form sub y = GForm sub y (GWidget sub y ())
diff --git a/Yesod/Form/Jquery.hs b/Yesod/Form/Jquery.hs
index a4c39349..8f466ebc 100644
--- a/Yesod/Form/Jquery.hs
+++ b/Yesod/Form/Jquery.hs
@@ -49,10 +49,10 @@ jqueryDayFieldProfile = FieldProfile
                   Right
               . readMay
     , fpRender = show
-    , fpHamlet = \theId name val isReq -> [$hamlet|
+    , fpWidget = \theId name val isReq -> do
+        addBody [$hamlet|
 %input#$theId$!name=$name$!type=date!:isReq:required!value=$val$
 |]
-    , fpWidget = \name -> do
         addScript' urlJqueryJs
         addScript' urlJqueryUiJs
         addStylesheet' urlJqueryUiCss
@@ -86,10 +86,10 @@ jqueryDayTimeFieldProfile :: YesodJquery y => FieldProfile sub y UTCTime
 jqueryDayTimeFieldProfile = FieldProfile
     { fpParse  = parseUTCTime
     , fpRender = jqueryDayTimeUTCTime
-    , fpHamlet = \theId name val isReq -> [$hamlet|
+    , fpWidget = \theId name val isReq -> do
+        addBody [$hamlet|
 %input#$theId$!name=$name$!type=date!:isReq:required!value=$val$
 |]
-    , fpWidget = \name -> do
         addScript' urlJqueryJs
         addScript' urlJqueryUiJs
         addScript' urlJqueryUiDateTimePicker
@@ -122,10 +122,10 @@ jqueryAutocompleteFieldProfile :: YesodJquery y => Route y -> FieldProfile sub y
 jqueryAutocompleteFieldProfile src = FieldProfile
     { fpParse = Right
     , fpRender = id
-    , fpHamlet = \theId name val isReq -> [$hamlet|
+    , fpWidget = \theId name val isReq -> do
+        addBody [$hamlet|
 %input.autocomplete#$theId$!name=$name$!type=text!:isReq:required!value=$val$
 |]
-    , fpWidget = \name -> do
         addScript' urlJqueryJs
         addScript' urlJqueryUiJs
         addStylesheet' urlJqueryUiCss
diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs
index a52be361..d6d7c5b1 100644
--- a/Yesod/Form/Nic.hs
+++ b/Yesod/Form/Nic.hs
@@ -7,7 +7,6 @@ module Yesod.Form.Nic
 
 import Yesod.Handler
 import Yesod.Form.Core
-import Yesod.Form.Profiles
 import Yesod.Hamlet
 import Yesod.Widget
 import qualified Data.ByteString.Lazy.UTF8 as U
@@ -27,10 +26,8 @@ nicHtmlFieldProfile :: YesodNic y => FieldProfile sub y Html
 nicHtmlFieldProfile = FieldProfile
     { fpParse = Right . preEscapedString
     , fpRender = U.toString . renderHtml
-    , fpHamlet = \theId name val _isReq -> [$hamlet|
-%textarea.html#$theId$!name=$name$ $val$
-|]
-    , fpWidget = \name -> do
+    , fpWidget = \theId name val _isReq -> do
+        addBody [$hamlet|%textarea.html#$theId$!name=$name$ $val$|]
         addScript' urlNicEdit
         addJavaScript [$julius|bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("$name$")});|]
     }
diff --git a/Yesod/Form/Profiles.hs b/Yesod/Form/Profiles.hs
index 557cf2fc..4ee1bac9 100644
--- a/Yesod/Form/Profiles.hs
+++ b/Yesod/Form/Profiles.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 module Yesod.Form.Profiles
-    ( FieldProfile (..)
-    , stringFieldProfile
+    ( stringFieldProfile
     , textareaFieldProfile
     , hiddenFieldProfile
     , intFieldProfile
@@ -16,6 +15,7 @@ module Yesod.Form.Profiles
     ) where
 
 import Yesod.Form.Core
+import Yesod.Widget
 import Text.Hamlet
 import Data.Time (Day, TimeOfDay(..))
 import qualified Data.ByteString.Lazy.UTF8 as U
@@ -26,10 +26,9 @@ intFieldProfile :: Integral i => FieldProfile sub y i
 intFieldProfile = FieldProfile
     { fpParse = maybe (Left "Invalid integer") Right . readMayI
     , fpRender = showI
-    , fpHamlet = \theId name val isReq -> [$hamlet|
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
 %input#$theId$!name=$name$!type=number!:isReq:required!value=$val$
 |]
-    , fpWidget = \_name -> return ()
     }
   where
     showI x = show (fromIntegral x :: Integer)
@@ -41,70 +40,63 @@ doubleFieldProfile :: FieldProfile sub y Double
 doubleFieldProfile = FieldProfile
     { fpParse = maybe (Left "Invalid number") Right . readMay
     , fpRender = show
-    , fpHamlet = \theId name val isReq -> [$hamlet|
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
 %input#$theId$!name=$name$!type=number!:isReq:required!value=$val$
 |]
-    , fpWidget = \_name -> return ()
     }
 
 dayFieldProfile :: FieldProfile sub y Day
 dayFieldProfile = FieldProfile
     { fpParse = parseDate
     , fpRender = show
-    , fpHamlet = \theId name val isReq -> [$hamlet|
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
 %input#$theId$!name=$name$!type=date!:isReq:required!value=$val$
 |]
-    , fpWidget = const $ return ()
     }
 
 timeFieldProfile :: FieldProfile sub y TimeOfDay
 timeFieldProfile = FieldProfile
     { fpParse = parseTime
     , fpRender = show
-    , fpHamlet = \theId name val isReq -> [$hamlet|
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
 %input#$theId$!name=$name$!:isReq:required!value=$val$
 |]
-    , fpWidget = const $ return ()
     }
 
 htmlFieldProfile :: FieldProfile sub y Html
 htmlFieldProfile = FieldProfile
     { fpParse = Right . preEscapedString
     , fpRender = U.toString . renderHtml
-    , fpHamlet = \theId name val _isReq -> [$hamlet|
+    , fpWidget = \theId name val _isReq -> addBody [$hamlet|
 %textarea.html#$theId$!name=$name$ $val$
 |]
-    , fpWidget = const $ return ()
     }
 
 textareaFieldProfile :: FieldProfile sub y String
 textareaFieldProfile = FieldProfile
     { fpParse = Right
     , fpRender = id
-    , fpHamlet = \theId name val _isReq -> [$hamlet|
+    , fpWidget = \theId name val _isReq -> addBody [$hamlet|
 %textarea#$theId$!name=$name$ $val$
 |]
-    , fpWidget = const $ return ()
     }
 
 hiddenFieldProfile :: FieldProfile sub y String
 hiddenFieldProfile = FieldProfile
     { fpParse = Right
     , fpRender = id
-    , fpHamlet = \theId name val _isReq -> [$hamlet|
+    , fpWidget = \theId name val _isReq -> addBody [$hamlet|
 %input!type=hidden#$theId$!name=$name$!value=$val$
 |]
-    , fpWidget = const $ return ()
     }
 
 stringFieldProfile :: FieldProfile sub y String
 stringFieldProfile = FieldProfile
     { fpParse = Right
     , fpRender = id
-    , fpHamlet = \theId name val isReq -> [$hamlet|
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
 %input#$theId$!name=$name$!type=text!:isReq:required!value=$val$
 |]
-    , fpWidget = \_name -> return ()
     }
 
 readMay :: Read a => String -> Maybe a
@@ -151,10 +143,9 @@ emailFieldProfile = FieldProfile
                         then Right s
                         else Left "Invalid e-mail address"
     , fpRender = id
-    , fpHamlet = \theId name val isReq -> [$hamlet|
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
 %input#$theId$!name=$name$!type=email!:isReq:required!value=$val$
 |]
-    , fpWidget = const $ return ()
     }
 
 urlFieldProfile :: FieldProfile s y String
@@ -163,8 +154,7 @@ urlFieldProfile = FieldProfile
                         Nothing -> Left "Invalid URL"
                         Just _ -> Right s
     , fpRender = id
-    , fpHamlet = \theId name val isReq -> [$hamlet|
+    , fpWidget = \theId name val isReq -> addBody [$hamlet|
 %input#$theId$!name=$name$!type=url!:isReq:required!value=$val$
 |]
-    , fpWidget = const $ return ()
     }