Skip to content

Commit

Permalink
Add checkByLabel to yesod-test for testing checkboxes
Browse files Browse the repository at this point in the history
  • Loading branch information
ktak-007 committed Aug 19, 2024
1 parent 2e66ff9 commit 60d0429
Show file tree
Hide file tree
Showing 4 changed files with 67 additions and 4 deletions.
4 changes: 4 additions & 0 deletions yesod-test/ChangeLog.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,9 @@
# ChangeLog for yesod-test

## 1.6.18

* Add `checkByLabel` to yesod-test.

## 1.6.17

* Add `chooseByLabel` to yesod-test. [#1842](https://github.com/yesodweb/yesod/pull/1842)
Expand Down
35 changes: 35 additions & 0 deletions yesod-test/Yesod/Test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
30 changes: 27 additions & 3 deletions yesod-test/test/main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion yesod-test/yesod-test.cabal
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: yesod-test
version: 1.6.17
version: 1.6.18
license: MIT
license-file: LICENSE
author: Nubis <[email protected]>
Expand Down

0 comments on commit 60d0429

Please sign in to comment.