From 60d0429ad83b14fdf5d56c17349f67fd6093d843 Mon Sep 17 00:00:00 2001
From: Stanislav Smirnov <stanislav.ktak.smirnov@gmail.com>
Date: Mon, 19 Aug 2024 03:01:18 +0300
Subject: [PATCH] Add checkByLabel to yesod-test for testing checkboxes

---
 yesod-test/ChangeLog.md     |  4 ++++
 yesod-test/Yesod/Test.hs    | 35 +++++++++++++++++++++++++++++++++++
 yesod-test/test/main.hs     | 30 +++++++++++++++++++++++++++---
 yesod-test/yesod-test.cabal |  2 +-
 4 files changed, 67 insertions(+), 4 deletions(-)

diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md
index ba4c2b11e..1c857f74c 100644
--- a/yesod-test/ChangeLog.md
+++ b/yesod-test/ChangeLog.md
@@ -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)
diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index 4bfb7585a..67183b636 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/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
diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs
index 028036a39..2c3fc880a 100644
--- a/yesod-test/test/main.hs
+++ b/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
diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal
index 2e8526f4a..eeeeddec8 100644
--- a/yesod-test/yesod-test.cabal
+++ b/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 <nubis@woobiz.com.ar>