From bdd0f8008386c804827d5f1afacf97e01bd1721b Mon Sep 17 00:00:00 2001
From: Pascal Wittmann <mail@pascal-wittmann.de>
Date: Tue, 25 Oct 2011 17:51:23 +0200
Subject: [PATCH 1/2] added (css) class name to FieldSettings

---
 yesod-form/Yesod/Form/Types.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/yesod-form/Yesod/Form/Types.hs b/yesod-form/Yesod/Form/Types.hs
index c84743fd..986d125f 100644
--- a/yesod-form/Yesod/Form/Types.hs
+++ b/yesod-form/Yesod/Form/Types.hs
@@ -99,10 +99,11 @@ data FieldSettings msg = FieldSettings
     , fsTooltip :: Maybe msg
     , fsId :: Maybe Text
     , fsName :: Maybe Text
+    , fsClass :: Text
     }
 
 instance (a ~ Text) => IsString (FieldSettings a) where
-    fromString s = FieldSettings (fromString s) Nothing Nothing Nothing
+    fromString s = FieldSettings (fromString s) Nothing Nothing Nothing ""
 
 data FieldView sub master = FieldView
     { fvLabel :: Html
@@ -115,8 +116,9 @@ data FieldView sub master = FieldView
 
 data Field sub master a = Field
     { fieldParse :: [Text] -> GGHandler sub master IO (Either (SomeMessage master) (Maybe a))
-    -- | ID, name, (invalid text OR legimiate result), required?
+    -- | ID, name, class, (invalid text OR legimiate result), required?
     , fieldView :: Text
+                -> Text
                 -> Text
                 -> Either Text a
                 -> Bool

From 837f796993694c9d14f3f34b2945a759167ec150 Mon Sep 17 00:00:00 2001
From: Pascal Wittmann <mail@pascal-wittmann.de>
Date: Tue, 25 Oct 2011 17:52:11 +0200
Subject: [PATCH 2/2] adjusted existing fields and functions for the new
 FieldSettings attribute

---
 yesod-form/Yesod/Form/Fields.hs    | 82 ++++++++++++++++--------------
 yesod-form/Yesod/Form/Functions.hs |  2 +-
 yesod-form/Yesod/Form/Jquery.hs    | 13 ++---
 yesod-form/Yesod/Form/MassInput.hs |  1 +
 yesod-form/Yesod/Form/Nic.hs       |  5 +-
 5 files changed, 56 insertions(+), 47 deletions(-)

diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs
index ad94b825..ca11400d 100644
--- a/yesod-form/Yesod/Form/Fields.hs
+++ b/yesod-form/Yesod/Form/Fields.hs
@@ -67,6 +67,7 @@ import Text.Blaze.Renderer.String (renderHtml)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import Data.Text (Text, unpack, pack)
+import qualified Data.Text as T (null)
 import qualified Data.Text.Read
 import Control.Monad.Trans.Class (lift)
 
@@ -110,9 +111,9 @@ intField = Field
             Right (a, "") -> Right a
             _ -> Left $ MsgInvalidInteger s
 
-    , fieldView = \theId name val isReq -> addHamlet
+    , fieldView = \theId name theClass val isReq -> addHamlet
         [HAMLET|\
-<input id="#{theId}" name="#{name}" type="number" :isReq:required="" value="#{showVal val}">
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="number" :isReq:required="" value="#{showVal val}">
 |]
     }
   where
@@ -126,9 +127,9 @@ doubleField = Field
             Right (a, "") -> Right a
             _ -> Left $ MsgInvalidNumber s
 
-    , fieldView = \theId name val isReq -> addHamlet
+    , fieldView = \theId name theClass val isReq -> addHamlet
         [HAMLET|\
-<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{showVal val}">
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="text" :isReq:required="" value="#{showVal val}">
 |]
     }
   where showVal = either id (pack . show)
@@ -136,9 +137,9 @@ doubleField = Field
 dayField :: RenderMessage master FormMessage => Field sub master Day
 dayField = Field
     { fieldParse = blank $ parseDate . unpack
-    , fieldView = \theId name val isReq -> addHamlet
+    , fieldView = \theId name theClass val isReq -> addHamlet
         [HAMLET|\
-<input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{showVal val}">
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="date" :isReq:required="" value="#{showVal val}">
 |]
     }
   where showVal = either id (pack . show)
@@ -146,9 +147,9 @@ dayField = Field
 timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
 timeField = Field
     { fieldParse = blank $ parseTime . unpack
-    , fieldView = \theId name val isReq -> addHamlet
+    , fieldView = \theId name theClass val isReq -> addHamlet
         [HAMLET|\
-<input id="#{theId}" name="#{name}" :isReq:required="" value="#{showVal val}">
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" :isReq:required="" value="#{showVal val}">
 |]
     }
   where
@@ -161,9 +162,10 @@ timeField = Field
 htmlField :: RenderMessage master FormMessage => Field sub master Html
 htmlField = Field
     { fieldParse = blank $ Right . preEscapedText . sanitizeBalance
-    , fieldView = \theId name val _isReq -> addHamlet
+    , fieldView = \theId name theClass val _isReq -> addHamlet
+        -- FIXME: There was a class="html" attribute, for what purpose?
         [HAMLET|\
-<textarea id="#{theId}" name="#{name}" .html>#{showVal val}
+<textarea id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}">#{showVal val}
 |]
     }
   where showVal = either id (pack . renderHtml)
@@ -189,36 +191,36 @@ instance ToHtml Textarea where
 textareaField :: RenderMessage master FormMessage => Field sub master Textarea
 textareaField = Field
     { fieldParse =  blank $ Right . Textarea
-    , fieldView = \theId name val _isReq -> addHamlet
+    , fieldView = \theId name theClass val _isReq -> addHamlet
         [HAMLET|\
-<textarea id="#{theId}" name="#{name}">#{either id unTextarea val}
+<textarea id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}">#{either id unTextarea val}
 |]
     }
 
 hiddenField :: RenderMessage master FormMessage => Field sub master Text
 hiddenField = Field
     { fieldParse = blank $ Right
-    , fieldView = \theId name val _isReq -> addHamlet
+    , fieldView = \theId name theClass val _isReq -> addHamlet
         [HAMLET|\
-<input type="hidden" id="#{theId}" name="#{name}" value="#{either id id val}">
+<input type="hidden" id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" value="#{either id id val}">
 |]
     }
 
 textField :: RenderMessage master FormMessage => Field sub master Text
 textField = Field
     { fieldParse = blank $ Right
-    , fieldView = \theId name val isReq ->
+    , fieldView = \theId name theClass val isReq ->
         [WHAMLET|
-<input id="#{theId}" name="#{name}" type="text" :isReq:required value="#{either id id val}">
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="text" :isReq:required value="#{either id id val}">
 |]
     }
 
 passwordField :: RenderMessage master FormMessage => Field sub master Text
 passwordField = Field
     { fieldParse = blank $ Right
-    , fieldView = \theId name val isReq -> addHamlet
+    , fieldView = \theId name theClass val isReq -> addHamlet
         [HAMLET|\
-<input id="#{theId}" name="#{name}" type="password" :isReq:required="" value="#{either id id val}">
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="password" :isReq:required="" value="#{either id id val}">
 |]
     }
 
@@ -266,9 +268,9 @@ emailField = Field
         \s -> if Email.isValid (unpack s)
                 then Right s
                 else Left $ MsgInvalidEmail s
-    , fieldView = \theId name val isReq -> addHamlet
+    , fieldView = \theId name theClass val isReq -> addHamlet
         [HAMLET|\
-<input id="#{theId}" name="#{name}" type="email" :isReq:required="" value="#{either id id val}">
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="email" :isReq:required="" value="#{either id id val}">
 |]
     }
 
@@ -276,9 +278,9 @@ type AutoFocus = Bool
 searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master Text
 searchField autoFocus = Field
     { fieldParse = blank Right
-    , fieldView = \theId name val isReq -> do
+    , fieldView = \theId name theClass val isReq -> do
         [WHAMLET|\
-<input id="#{theId}" name="#{name}" type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
 |]
         when autoFocus $ do
           -- we want this javascript to be placed immediately after the field
@@ -296,9 +298,9 @@ urlField = Field
         case parseURI $ unpack s of
             Nothing -> Left $ MsgInvalidUrl s
             Just _ -> Right s
-    , fieldView = \theId name val isReq ->
+    , fieldView = \theId name theClass val isReq ->
         [WHAMLET|
-<input ##{theId} name=#{name} type=url :isReq:required value=#{either id id val}>
+<input ##{theId} name=#{name} :T.null theClass:class="#{theClass}" type=url :isReq:required value=#{either id id val}>
 |]
     }
 
@@ -309,12 +311,12 @@ selectField' :: (Eq a, RenderMessage master FormMessage) => GGHandler sub master
 selectField' = selectFieldHelper
     (\theId name inside -> [WHAMLET|<select ##{theId} name=#{name}>^{inside}|]) -- outside
     (\_theId _name isSel -> [WHAMLET|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
-    (\_theId _name value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected>#{text}|]) -- inside
+    (\_theId _name theClass value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected :T.null theClass:class"#{theClass}">#{text}|]) -- inside
 
 multiSelectField :: (Show a, Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master [a]
 multiSelectField = multiSelectFieldHelper
     (\theId name inside -> [WHAMLET|<select ##{theId} multiple name=#{name}>^{inside}|])
-    (\_theId _name value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected>#{text}|])
+    (\_theId _name theClass value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected :T.null theClass:class="#{theClass}">#{text}|])
 
 radioField :: (Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master a
 radioField = radioField' . optionsPairs
@@ -327,25 +329,25 @@ radioField' = selectFieldHelper
     <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>
     <label for=#{theId}-none>_{MsgSelectNone}
 |])
-    (\theId name value isSel text -> [WHAMLET|
+    (\theId name theClass value isSel text -> [WHAMLET|
 <div>
-    <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked>
+    <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked :T.null theClass:class="#{theClass}">
     <label for=#{theId}-#{value}>#{text}
 |])
 
 boolField :: RenderMessage master FormMessage => Field sub master Bool
 boolField = Field
       { fieldParse = return . boolParser
-      , fieldView = \theId name val isReq -> [WHAMLET|
+      , fieldView = \theId name theClass val isReq -> [WHAMLET|
   $if not isReq
-      <input id=#{theId}-none type=radio name=#{name} value=none checked>
+      <input id=#{theId}-none :T.null theClass:class="#{theClass}" type=radio name=#{name} value=none checked>
       <label for=#{theId}-none>_{MsgSelectNone}
 
 
-<input id=#{theId}-yes type=radio name=#{name} value=yes :showVal id val:checked>
+<input id=#{theId}-yes :T.null theClass:class="#{theClass}" type=radio name=#{name} value=yes :showVal id val:checked>
 <label for=#{theId}-yes>_{MsgBoolYes}
 
-<input id=#{theId}-no type=radio name=#{name} value=no :showVal not val:checked>
+<input id=#{theId}-no :T.null theClass:class="#{theClass}" type=radio name=#{name} value=no :showVal not val:checked>
 <label for=#{theId}-no>_{MsgBoolNo}
 |]
     }
@@ -361,15 +363,16 @@ boolField = Field
 
 multiSelectFieldHelper :: (Show a, Eq a)
         => (Text -> Text -> GWidget sub master () -> GWidget sub master ())
-        -> (Text -> Text -> Text -> Bool -> Text -> GWidget sub master ())
+        -> (Text -> Text -> Text -> Text -> Bool -> Text -> GWidget sub master ())
         -> [(Text, a)] -> Field sub master [a]
 multiSelectFieldHelper outside inside opts = Field
     { fieldParse = return . selectParser
-    , fieldView = \theId name vals _ ->
+    , fieldView = \theId name theClass vals _ ->
         outside theId name $ do
             flip mapM_ pairs $ \pair -> inside
                 theId
                 name
+                theClass
                 (pack $ show $ fst pair)
                 ((fst pair) `elem` (either (\_ -> []) selectedVals vals)) -- We are presuming that select fields can't hold invalid values
                 (fst $ snd pair)
@@ -425,19 +428,20 @@ selectFieldHelper
         :: (Eq a, RenderMessage master FormMessage)
         => (Text -> Text -> GWidget sub master () -> GWidget sub master ())
         -> (Text -> Text -> Bool -> GWidget sub master ())
-        -> (Text -> Text -> Text -> Bool -> Text -> GWidget sub master ())
+        -> (Text -> Text -> Text -> Text -> Bool -> Text -> GWidget sub master ())
         -> GGHandler sub master IO (OptionList a) -> Field sub master a
 selectFieldHelper outside onOpt inside opts' = Field
     { fieldParse = \x -> do
         opts <- opts'
         return $ selectParser opts x
-    , fieldView = \theId name val isReq -> do
+    , fieldView = \theId name theClass val isReq -> do
         opts <- fmap olOptions $ lift $ liftIOHandler opts'
         outside theId name $ do
             unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts
             flip mapM_ opts $ \opt -> inside
                 theId
                 name
+                theClass
                 (optionExternalValue opt)
                 ((render opts val) == optionExternalValue opt)
                 (optionDisplay opt)
@@ -471,12 +475,13 @@ fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do
                             let t = renderMessage master langs MsgValueRequired
                              in (FormFailure [t], Just $ toHtml t)
                         Just fi -> (FormSuccess fi, Nothing)
+    let theClass = fsClass fs
     let fv = FieldView
             { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
             , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
             , fvId = id'
             , fvInput = [WHAMLET|
-<input type=file name=#{name} ##{id'}>
+<input type=file name=#{name} ##{id'} :T.null theClass:class="#{theClass}">
 |]
             , fvErrors = errs
             , fvRequired = True
@@ -499,12 +504,13 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
                     case Map.lookup name fenv of
                         Nothing -> (FormSuccess Nothing, Nothing)
                         Just fi -> (FormSuccess $ Just fi, Nothing)
+    let theClass = fsClass fs
     let fv = FieldView
             { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
             , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
             , fvId = id'
             , fvInput = [WHAMLET|
-<input type=file name=#{name} ##{id'}>
+<input type=file name=#{name} ##{id'} :T.null theClass:class="#{theClass}">
 |]
             , fvErrors = errs
             , fvRequired = False
diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs
index f762b621..a1b9cf26 100644
--- a/yesod-form/Yesod/Form/Functions.hs
+++ b/yesod-form/Yesod/Form/Functions.hs
@@ -137,7 +137,7 @@ mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
         { fvLabel = toHtml $ mr2 fsLabel
         , fvTooltip = fmap toHtml $ fmap mr2 fsTooltip
         , fvId = theId
-        , fvInput = fieldView theId name val isReq
+        , fvInput = fieldView theId name fsClass val isReq
         , fvErrors =
             case res of
                 FormFailure [e] -> Just $ toHtml e
diff --git a/yesod-form/Yesod/Form/Jquery.hs b/yesod-form/Yesod/Form/Jquery.hs
index fa6f6e5d..d557ce0d 100644
--- a/yesod-form/Yesod/Form/Jquery.hs
+++ b/yesod-form/Yesod/Form/Jquery.hs
@@ -20,6 +20,7 @@ import Yesod.Form
 import Yesod.Widget
 import Data.Time (UTCTime (..), Day, TimeOfDay (..), timeOfDayToTime,
                   timeToTimeOfDay)
+import qualified Data.Text as T (null)
 import Data.Char (isSpace)
 import Data.Default
 import Text.Hamlet (shamlet)
@@ -78,9 +79,9 @@ jqueryDayField jds = Field
                   Right
               . readMay
               . unpack
-    , fieldView = \theId name val isReq -> do
+    , fieldView = \theId name theClass val isReq -> do
         addHtml [HTML|\
-<input id="#{theId}" name="#{name}" type="date" :isReq:required="" value="#{showVal val}">
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="date" :isReq:required="" value="#{showVal val}">
 |]
         addScript' urlJqueryJs
         addScript' urlJqueryUiJs
@@ -129,9 +130,9 @@ jqueryDayTimeUTCTime (UTCTime day utcTime) =
 jqueryDayTimeField :: (RenderMessage master FormMessage, YesodJquery master) => Field sub master UTCTime
 jqueryDayTimeField = Field
     { fieldParse  = blank $ parseUTCTime . unpack
-    , fieldView = \theId name val isReq -> do
+    , fieldView = \theId name theClass val isReq -> do
         addHtml [HTML|\
-<input id="#{theId}" name="#{name}" :isReq:required="" value="#{showVal val}">
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" :isReq:required="" value="#{showVal val}">
 |]
         addScript' urlJqueryJs
         addScript' urlJqueryUiJs
@@ -159,9 +160,9 @@ jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master
                         => Route master -> Field sub master Text
 jqueryAutocompleteField src = Field
     { fieldParse = blank $ Right
-    , fieldView = \theId name val isReq -> do
+    , fieldView = \theId name theClass val isReq -> do
         addHtml [HTML|\
-<input id="#{theId}" name="#{name}" type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
+<input id="#{theId}" name="#{name}" :T.null theClass:class="#{theClass}" type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
 |]
         addScript' urlJqueryJs
         addScript' urlJqueryUiJs
diff --git a/yesod-form/Yesod/Form/MassInput.hs b/yesod-form/Yesod/Form/MassInput.hs
index 3a3eae40..acc51357 100644
--- a/yesod-form/Yesod/Form/MassInput.hs
+++ b/yesod-form/Yesod/Form/MassInput.hs
@@ -111,6 +111,7 @@ withDelete af = do
                 , fsTooltip = Nothing
                 , fsName = Just deleteName
                 , fsId = Nothing
+                , fsClass = ""
                 } $ Just False
             (res, xml) <- aFormToForm af
             return $ Right (res, xml $ xml2 [])
diff --git a/yesod-form/Yesod/Form/Nic.hs b/yesod-form/Yesod/Form/Nic.hs
index 93fa9d30..4cabd3f8 100644
--- a/yesod-form/Yesod/Form/Nic.hs
+++ b/yesod-form/Yesod/Form/Nic.hs
@@ -20,6 +20,7 @@ import Text.Blaze.Renderer.String (renderHtml)
 import Text.Blaze (preEscapedText)
 import Control.Monad.Trans.Class (lift)
 import Data.Text (Text, pack)
+import qualified Data.Text as T (null)
 import Data.Maybe (listToMaybe)
 
 class YesodNic a where
@@ -30,14 +31,14 @@ class YesodNic a where
 nicHtmlField :: YesodNic master => Field sub master Html
 nicHtmlField = Field
     { fieldParse = return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe
-    , fieldView = \theId name val _isReq -> do
+    , fieldView = \theId name theClass val _isReq -> do
         addHtml
 #if __GLASGOW_HASKELL__ >= 700
                 [shamlet|
 #else
                 [$shamlet|
 #endif
-    <textarea id="#{theId}" name="#{name}" .html>#{showVal val}
+    <textarea id="#{theId}" :T.null theClass:class="#{theClass}" name="#{name}" .html>#{showVal val}
 |]
         addScript' urlNicEdit
         addJulius