Merge pull request #603 from axel-angel/checkboxesField

Add checkboxesField{,List} fields (based on multiSelectField{,List})

yesod-form/Yesod/Form/Fields.hs

@@ -36,6 +36,8 @@ module Yesod.Form.Fields
     , selectFieldList
     , radioField
     , radioFieldList
+    , checkboxesFieldList
+    , checkboxesField
     , multiSelectField
     , multiSelectFieldList
     , Option (..)
@@ -388,6 +390,28 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
                -> Field (HandlerT site IO) a
 radioFieldList = radioField . optionsPairs
 
+checkboxesFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)]
+                     -> Field (HandlerT site IO) [a]
+checkboxesFieldList = checkboxesField . optionsPairs
+
+checkboxesField :: (Eq a, RenderMessage site FormMessage)
+                 => HandlerT site IO (OptionList a)
+                 -> Field (HandlerT site IO) [a]
+checkboxesField ioptlist = (multiSelectField ioptlist)
+    { fieldView =
+        \theId name attrs val isReq -> do
+            opts <- fmap olOptions $ handlerToWidget ioptlist
+            let optselected (Left _) _ = False
+                optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
+            [whamlet|
+                <span ##{theId}>
+                    $forall opt <- opts
+                        <label>
+                            <input type=checkbox name=#{name} value=#{optionExternalValue opt} *{attrs} :optselected val opt:checked>
+                            #{optionDisplay opt}
+                |]
+    }
+
 radioField :: (Eq a, RenderMessage site FormMessage)
            => HandlerT site IO (OptionList a)
            -> Field (HandlerT site IO) a