Yesod test add check for checkboxes

yesod-form/ChangeLog.md

@@ -1,5 +1,9 @@
 # ChangeLog for yesod-form
 
+## 1.7.9
+
+* Added `checkboxesField'` for creating checkbox in more correct way than original `checkboxesField`
+  Function `checkboxesField` marked as deprecated. [#1843](https://github.com/yesodweb/yesod/pull/1843)
 
 ## 1.7.8
 

yesod-form/Yesod/Form/Fields.hs

@@ -52,6 +52,7 @@ module Yesod.Form.Fields
     , radioFieldList
     , withRadioField
     , checkboxesField
+    , checkboxesField'
     , checkboxesFieldList
     , multiSelectField
     , multiSelectFieldList
@@ -125,6 +126,7 @@ import Data.Monoid
 import Data.Char (isHexDigit)
 
 {-# DEPRECATED radioField "This function seems to have a bug (label could not be found with byLabel algorithm)" #-}
+{-# DEPRECATED checkboxesField "This function seems to have a bug (label could not be found with byLabel algorithm)" #-}
 
 defaultFormMessage :: FormMessage -> Text
 defaultFormMessage = englishFormMessage
@@ -533,6 +535,26 @@ checkboxesField ioptlist = (multiSelectField ioptlist)
                 |]
     }
 
+-- | Creates an input with @type="checkbox"@ for selecting multiple options.
+checkboxesField' :: Eq a
+                 => HandlerFor site (OptionList a)
+                 -> Field (HandlerFor site) [a]
+checkboxesField' ioptlist = (multiSelectField ioptlist)
+    { fieldView =
+        \theId name attrs val _isReq -> do
+            opts <- olOptions <$> handlerToWidget ioptlist
+            let optselected (Left _) _ = False
+                optselected (Right vals) opt = optionInternalValue opt `elem` vals
+            [whamlet|
+                <span ##{theId}>
+                    $forall opt <- opts
+                        <input id=#{theId}-#{optionExternalValue opt} type=checkbox name=#{name} value=#{optionExternalValue opt} *{attrs} :optselected val opt:checked>
+                        <label for=#{theId}-#{optionExternalValue opt}>
+                            #{optionDisplay opt}
+                |]
+    }
+
+
 -- | Creates an input with @type="radio"@ for selecting one option.
 radioField :: (Eq a, RenderMessage site FormMessage)
            => HandlerFor site (OptionList a)

yesod-form/yesod-form.cabal

@@ -1,6 +1,6 @@
 cabal-version:   >= 1.10
 name:            yesod-form
-version:         1.7.8
+version:         1.7.9
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <[email protected]>

yesod-test/ChangeLog.md

@@ -1,5 +1,9 @@
 # ChangeLog for yesod-test
 
+## 1.6.18
+
+* Add `checkByLabel` to yesod-test. [#1843](https://github.com/yesodweb/yesod/pull/1843)
+
 ## 1.6.17
 
 * Add `chooseByLabel` to yesod-test. [#1842](https://github.com/yesodweb/yesod/pull/1842)

yesod-test/Yesod/Test.hs

@@ -178,6 +178,7 @@ module Yesod.Test
     , fileByLabelPrefix
     , fileByLabelSuffix
     , chooseByLabel
+    , checkByLabel
 
     -- *** CSRF Tokens
     -- | In order to prevent CSRF exploits, yesod-form adds a hidden input
@@ -1716,6 +1717,40 @@ chooseByLabel label = do
     value <- genericValueFromLabel (==) label
     addPostParam name value
 
+-- | Finds the @\<label>@ with the given value, finds its corresponding @\<input>@, then make this input checked.
+-- It is assumed the @\<input>@ has @type=checkbox@.
+--
+-- ==== __Examples__
+--
+-- Given this HTML, we want to submit @f1=2@ and @f1=4@ (i.e. checked checkboxes are "Blue" and "Black") to the server:
+--
+-- > <form method="POST">
+-- >   <label for="hident2">Colors</label>
+-- >   <span id="hident2">
+-- >     <input id="hident2-1" type="checkbox" name="f1" value="1">
+-- >     <label for="hident2-1">Red</label>
+-- >     <input id="hident2-2" type="checkbox" name="f1" value="2" checked>
+-- >     <label for="hident2-2">Blue</label>
+-- >     <input id="hident2-3" type="checkbox" name="f1" value="3">
+-- >     <label for="hident2-3">Gray</label>
+-- >     <input id="hident2-4" type="checkbox" name="f1" value="4" checked>
+-- >     <label for="hident2-4">Black</label>
+-- >   </span>
+-- > </form>
+--
+-- You can set this parameter like so:
+--
+-- > request $ do
+-- >   checkByLabel "Blue"
+-- >   checkByLabel "Black"
+--
+-- @since 1.6.18
+checkByLabel :: T.Text -> RequestBuilder site ()
+checkByLabel label = do
+    name <- genericNameFromLabel (==) label
+    value <- genericValueFromLabel (==) label
+    addPostParam name value
+
 -- |
 -- This looks up the value of a field based on the contents of the label pointing to it.
 genericValueFromLabel :: HasCallStack => (T.Text -> T.Text -> Bool) -> T.Text -> RequestBuilder site T.Text

yesod-test/test/main.hs

@@ -322,6 +322,15 @@ main = hspec $ do
                     chooseByLabel "Blue"
                     addToken
                 bodyContains "colorRadioButton = Just Blue"
+            yit "can click check boxes" $ do
+                get ("/labels-checkboxes" :: Text)
+                request $ do
+                    setMethod "POST"
+                    setUrl ("/labels-checkboxes" :: Text)
+                    checkByLabel "Red"
+                    checkByLabel "Gray"
+                    addToken
+                bodyContains "colorCheckBoxes = [Gray,Red]"
 
         ydescribe "byLabel-related tests" $ do
             yit "fails with \"More than one label contained\" error" $ do
@@ -667,19 +676,34 @@ app = liteApp $ do
     onStatic "labels-radio-buttons" $ dispatchTo $ do
         ((result, widget), _) <- runFormPost
                     $ renderDivs
-                    $ ColorForm <$> aopt (radioField' optionsEnum) "Color" Nothing
+                    $ RadioButtonForm <$> aopt (radioField' optionsEnum) "Color" Nothing
         case result of
             FormSuccess color -> return $ toHtml $ show color
             _ -> defaultLayout [whamlet|$newline never
+                                <p>
+                                  ^{toHtml $ show result}
                                 <form method=post action="labels-radio-buttons">
                                   ^{widget}
                                |]
 
+    onStatic "labels-checkboxes" $ dispatchTo $ do
+        ((result, widget), _) <- runFormPost
+                    $ renderDivs
+                    $ CheckboxesForm <$> areq (checkboxesField' optionsEnum) "Checkboxes" (Just [Blue, Black])
+        case result of
+            FormSuccess color -> return $ toHtml $ show color
+            _ -> defaultLayout [whamlet|$newline never
+                                <p>
+                                  ^{toHtml $ show result}
+                                <form method=post action="labels-checkboxes">
+                                  ^{widget}
+                               |]
+
 data Color = Red | Blue | Gray | Black
     deriving (Show, Eq, Enum, Bounded)
 
-newtype ColorForm = ColorForm { colorRadioButton :: Maybe Color }
-    deriving Show
+newtype RadioButtonForm = RadioButtonForm { colorRadioButton :: Maybe Color } deriving Show
+newtype CheckboxesForm = CheckboxesForm { colorCheckBoxes :: [Color] } deriving Show
 
 cookieApp :: LiteApp
 cookieApp = liteApp $ do

yesod-test/yesod-test.cabal

@@ -1,5 +1,5 @@
 name:               yesod-test
-version:            1.6.17
+version:            1.6.18
 license:            MIT
 license-file:       LICENSE
 author:             Nubis <[email protected]>