From 46308c8d1f7632d5ac76b596d0b28bc8cac212c1 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 25 Mar 2012 17:57:19 +0200
Subject: [PATCH] fsClass to fsAttrs

---
 yesod-form/Yesod/Form/Fields.hs    | 83 ++++++++++++++----------------
 yesod-form/Yesod/Form/Functions.hs |  2 +-
 yesod-form/Yesod/Form/Jquery.hs    |  9 ++--
 yesod-form/Yesod/Form/MassInput.hs |  2 +-
 yesod-form/Yesod/Form/Nic.hs       |  5 +-
 yesod-form/Yesod/Form/Types.hs     |  6 +--
 yesod-form/yesod-form.cabal        |  2 +-
 7 files changed, 52 insertions(+), 57 deletions(-)

diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs
index 63bb36e6..609c7600 100644
--- a/yesod-form/Yesod/Form/Fields.hs
+++ b/yesod-form/Yesod/Form/Fields.hs
@@ -70,7 +70,6 @@ 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
 import qualified Data.Text.Read
 
 import qualified Data.Map as Map
@@ -99,8 +98,8 @@ intField = Field
             Right (a, "") -> Right a
             _ -> Left $ MsgInvalidInteger s
 
-    , fieldView = \theId name theClass val isReq -> toWidget [hamlet|
-<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="number" :isReq:required="" value="#{showVal val}">
+    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+<input id="#{theId}" name="#{name}" *{attrs} type="number" :isReq:required="" value="#{showVal val}">
 |]
     }
   where
@@ -114,8 +113,8 @@ doubleField = Field
             Right (a, "") -> Right a
             _ -> Left $ MsgInvalidNumber s
 
-    , fieldView = \theId name theClass val isReq -> toWidget [hamlet|
-<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="text" :isReq:required="" value="#{showVal val}">
+    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{showVal val}">
 |]
     }
   where showVal = either id (pack . show)
@@ -123,8 +122,8 @@ doubleField = Field
 dayField :: RenderMessage master FormMessage => Field sub master Day
 dayField = Field
     { fieldParse = blank $ parseDate . unpack
-    , fieldView = \theId name theClass val isReq -> toWidget [hamlet|
-<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="date" :isReq:required="" value="#{showVal val}">
+    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
 |]
     }
   where showVal = either id (pack . show)
@@ -132,8 +131,8 @@ dayField = Field
 timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
 timeField = Field
     { fieldParse = blank $ parseTime . unpack
-    , fieldView = \theId name theClass val isReq -> toWidget [hamlet|
-<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate "" theClass}" :isReq:required="" value="#{showVal val}">
+    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}">
 |]
     }
   where
@@ -146,9 +145,9 @@ timeField = Field
 htmlField :: RenderMessage master FormMessage => Field sub master Html
 htmlField = Field
     { fieldParse = blank $ Right . preEscapedText . sanitizeBalance
-    , fieldView = \theId name theClass val _isReq -> toWidget [hamlet|
+    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
         -- FIXME: There was a class="html" attribute, for what purpose?
-<textarea id="#{theId}" name="#{name}" :not (null theClass):class=#{T.intercalate " " theClass}>#{showVal val}
+<textarea id="#{theId}" name="#{name}" *{attrs}>#{showVal val}
 |]
     }
   where showVal = either id (pack . renderHtml)
@@ -174,33 +173,33 @@ instance ToHtml Textarea where
 textareaField :: RenderMessage master FormMessage => Field sub master Textarea
 textareaField = Field
     { fieldParse =  blank $ Right . Textarea
-    , fieldView = \theId name theClass val _isReq -> toWidget [hamlet|
-<textarea id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}">#{either id unTextarea val}
+    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
+<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val}
 |]
     }
 
 hiddenField :: RenderMessage master FormMessage => Field sub master Text
 hiddenField = Field
     { fieldParse = blank $ Right
-    , fieldView = \theId name theClass val _isReq -> toWidget [hamlet|
-<input type="hidden" id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" value="#{either id id val}">
+    , fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
+<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id id val}">
 |]
     }
 
 textField :: RenderMessage master FormMessage => Field sub master Text
 textField = Field
     { fieldParse = blank $ Right
-    , fieldView = \theId name theClass val isReq ->
+    , fieldView = \theId name attrs val isReq ->
         [whamlet|
-<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="text" :isReq:required value="#{either id id val}">
+<input id="#{theId}" name="#{name}" *{attrs} 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 theClass val isReq -> toWidget [hamlet|
-<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="password" :isReq:required="" value="#{either id id val}">
+    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}">
 |]
     }
 
@@ -248,8 +247,8 @@ emailField = Field
         \s -> if Email.isValid (unpack s)
                 then Right s
                 else Left $ MsgInvalidEmail s
-    , fieldView = \theId name theClass val isReq -> toWidget [hamlet|
-<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="email" :isReq:required="" value="#{either id id val}">
+    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}">
 |]
     }
 
@@ -257,9 +256,9 @@ type AutoFocus = Bool
 searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master Text
 searchField autoFocus = Field
     { fieldParse = blank Right
-    , fieldView = \theId name theClass val isReq -> do
+    , fieldView = \theId name attrs val isReq -> do
         [whamlet|\
-<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
+<input id="#{theId}" name="#{name}" *{attrs} 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
@@ -276,9 +275,9 @@ urlField = Field
         case parseURI $ unpack s of
             Nothing -> Left $ MsgInvalidUrl s
             Just _ -> Right s
-    , fieldView = \theId name theClass val isReq ->
+    , fieldView = \theId name attrs val isReq ->
         [whamlet|
-<input ##{theId} name=#{name} :not (null theClass):class="#{T.intercalate " " theClass}" type=url :isReq:required value=#{either id id val}>
+<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}>
 |]
     }
 
@@ -289,7 +288,7 @@ selectField :: (Eq a, RenderMessage master FormMessage) => GHandler 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 theClass value isSel text -> [whamlet|<option value=#{value} :isSel:selected :not (null theClass):class="#{T.intercalate " " theClass}">#{text}|]) -- inside
+    (\_theId _name attrs value isSel text -> [whamlet|<option value=#{value} :isSel:selected *{attrs}>#{text}|]) -- inside
 
 multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a]
 multiSelectFieldList = multiSelectField . optionsPairs
@@ -307,11 +306,11 @@ multiSelectField ioptlist =
              Nothing -> return $ Left "Error parsing values"
              Just res -> return $ Right $ Just res
 
-    view theId name theClass val isReq = do
+    view theId name attrs val isReq = do
         opts <- fmap olOptions $ lift ioptlist
         let selOpts = map (id &&& (optselected val)) opts
         [whamlet|
-            <select ##{theId} name=#{name} :isReq:required multiple :not (null theClass):class=#{T.intercalate " " theClass}>
+            <select ##{theId} name=#{name} :isReq:required multiple *{attrs}>
                 $forall (opt, optsel) <- selOpts
                     <option value=#{optionExternalValue opt} :optsel:selected>#{optionDisplay opt}
                 |]
@@ -330,25 +329,25 @@ radioField = selectFieldHelper
     <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>
     <label for=#{theId}-none>_{MsgSelectNone}
 |])
-    (\theId name theClass value isSel text -> [whamlet|
+    (\theId name attrs value isSel text -> [whamlet|
 <div>
-    <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked :not (null theClass):class="#{T.intercalate " " theClass}">
+    <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}>
     <label for=#{theId}-#{value}>#{text}
 |])
 
 boolField :: RenderMessage master FormMessage => Field sub master Bool
 boolField = Field
       { fieldParse = return . boolParser
-      , fieldView = \theId name theClass val isReq -> [whamlet|
+      , fieldView = \theId name attrs val isReq -> [whamlet|
   $if not isReq
-      <input id=#{theId}-none :not (null theClass):class="#{T.intercalate " " theClass}" type=radio name=#{name} value=none checked>
+      <input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked>
       <label for=#{theId}-none>_{MsgSelectNone}
 
 
-<input id=#{theId}-yes :not (null theClass):class="#{T.intercalate " " theClass}" type=radio name=#{name} value=yes :showVal id val:checked>
+<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked>
 <label for=#{theId}-yes>_{MsgBoolYes}
 
-<input id=#{theId}-no :not (null theClass):class="#{T.intercalate " " theClass}" type=radio name=#{name} value=no :showVal not val:checked>
+<input id=#{theId}-no *{attrs} type=radio name=#{name} value=no :showVal not val:checked>
 <label for=#{theId}-no>_{MsgBoolNo}
 |]
     }
@@ -372,8 +371,8 @@ boolField = Field
 checkBoxField :: RenderMessage m FormMessage => Field s m Bool
 checkBoxField = Field
     { fieldParse = return . checkBoxParser
-    , fieldView  = \theId name theClass val _ -> [whamlet|
-<input id=#{theId} :not (null theClass):class="#{T.intercalate " " theClass}" type=checkbox name=#{name} value=yes :showVal id val:checked>
+    , fieldView  = \theId name attrs val _ -> [whamlet|
+<input id=#{theId} *{attrs} type=checkbox name=#{name} value=yes :showVal id val:checked>
 |]
     }
 
@@ -435,20 +434,20 @@ selectFieldHelper
         :: (Eq a, RenderMessage master FormMessage)
         => (Text -> Text -> GWidget sub master () -> GWidget sub master ())
         -> (Text -> Text -> Bool -> GWidget sub master ())
-        -> (Text -> Text -> [Text] -> Text -> Bool -> Text -> GWidget sub master ())
+        -> (Text -> Text -> [(Text, Text)] -> Text -> Bool -> Text -> GWidget sub master ())
         -> GHandler sub master (OptionList a) -> Field sub master a
 selectFieldHelper outside onOpt inside opts' = Field
     { fieldParse = \x -> do
         opts <- opts'
         return $ selectParser opts x
-    , fieldView = \theId name theClass val isReq -> do
+    , fieldView = \theId name attrs val isReq -> do
         opts <- fmap olOptions $ lift 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
+                attrs
                 (optionExternalValue opt)
                 ((render opts val) == optionExternalValue opt)
                 (optionDisplay opt)
@@ -482,13 +481,12 @@ 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'} :not (null theClass):class="#{T.intercalate " " theClass}">
+<input type=file name=#{name} ##{id'} *{fsAttrs fs}>
 |]
             , fvErrors = errs
             , fvRequired = True
@@ -511,13 +509,12 @@ 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'} :not (null theClass):class="#{T.intercalate " " theClass}">
+<input type=file name=#{name} ##{id'} *{fsAttrs fs}>
 |]
             , fvErrors = errs
             , fvRequired = False
diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs
index 18b9a9fe..d44644d6 100644
--- a/yesod-form/Yesod/Form/Functions.hs
+++ b/yesod-form/Yesod/Form/Functions.hs
@@ -132,7 +132,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 fsClass val isReq
+        , fvInput = fieldView theId name fsAttrs 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 7c434ed4..f95e3bbb 100644
--- a/yesod-form/Yesod/Form/Jquery.hs
+++ b/yesod-form/Yesod/Form/Jquery.hs
@@ -18,7 +18,6 @@ import Yesod.Core (Route)
 import Yesod.Form
 import Yesod.Widget
 import Data.Time (Day)
-import qualified Data.Text as T
 import Data.Default
 import Text.Hamlet (shamlet)
 import Text.Julius (julius)
@@ -63,9 +62,9 @@ jqueryDayField jds = Field
                   Right
               . readMay
               . unpack
-    , fieldView = \theId name theClass val isReq -> do
+    , fieldView = \theId name attrs val isReq -> do
         toWidget [shamlet|
-<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="date" :isReq:required="" value="#{showVal val}">
+<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
 |]
         addScript' urlJqueryJs
         addScript' urlJqueryUiJs
@@ -102,9 +101,9 @@ jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master
                         => Route master -> Field sub master Text
 jqueryAutocompleteField src = Field
     { fieldParse = blank $ Right
-    , fieldView = \theId name theClass val isReq -> do
+    , fieldView = \theId name attrs val isReq -> do
         toWidget [shamlet|
-<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
+<input id="#{theId}" name="#{name}" *{attrs} 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 595ea744..cbb64ad7 100644
--- a/yesod-form/Yesod/Form/MassInput.hs
+++ b/yesod-form/Yesod/Form/MassInput.hs
@@ -101,7 +101,7 @@ withDelete af = do
                 , fsTooltip = Nothing
                 , fsName = Just deleteName
                 , fsId = Nothing
-                , fsClass = []
+                , fsAttrs = []
                 } $ 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 a6cbfe52..94e1adcf 100644
--- a/yesod-form/Yesod/Form/Nic.hs
+++ b/yesod-form/Yesod/Form/Nic.hs
@@ -19,7 +19,6 @@ import Text.Julius (julius)
 import Text.Blaze.Renderer.String (renderHtml)
 import Text.Blaze (preEscapedText)
 import Data.Text (Text, pack)
-import qualified Data.Text as T
 import Data.Maybe (listToMaybe)
 
 class Yesod a => YesodNic a where
@@ -30,9 +29,9 @@ class Yesod a => YesodNic a where
 nicHtmlField :: YesodNic master => Field sub master Html
 nicHtmlField = Field
     { fieldParse = return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe
-    , fieldView = \theId name theClass val _isReq -> do
+    , fieldView = \theId name attrs val _isReq -> do
         toWidget [shamlet|
-    <textarea id="#{theId}" :not (null theClass):class="#{T.intercalate " " theClass}" name="#{name}" .html>#{showVal val}
+    <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
 |]
         addScript' urlNicEdit
         master <- lift getYesod
diff --git a/yesod-form/Yesod/Form/Types.hs b/yesod-form/Yesod/Form/Types.hs
index 94b440fe..eb003978 100644
--- a/yesod-form/Yesod/Form/Types.hs
+++ b/yesod-form/Yesod/Form/Types.hs
@@ -99,7 +99,7 @@ data FieldSettings msg = FieldSettings
     , fsTooltip :: Maybe msg
     , fsId :: Maybe Text
     , fsName :: Maybe Text
-    , fsClass :: [Text]
+    , fsAttrs :: [(Text, Text)]
     }
 
 instance (a ~ Text) => IsString (FieldSettings a) where
@@ -116,10 +116,10 @@ data FieldView sub master = FieldView
 
 data Field sub master a = Field
     { fieldParse :: [Text] -> GHandler sub master (Either (SomeMessage master) (Maybe a))
-    -- | ID, name, class, (invalid text OR legimiate result), required?
+    -- | ID, name, attrs, (invalid text OR legimiate result), required?
     , fieldView :: Text
                 -> Text
-                -> [Text]
+                -> [(Text, Text)]
                 -> Either Text a
                 -> Bool
                 -> GWidget sub master ()
diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal
index f8aa5222..36f40b10 100644
--- a/yesod-form/yesod-form.cabal
+++ b/yesod-form/yesod-form.cabal
@@ -1,5 +1,5 @@
 name:            yesod-form
-version:         1.0.0.20120316
+version:         1.0.0.20120325
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>