Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Implemenatation of chooseRadio function along with tests #1840

Closed
wants to merge 3 commits into from
Closed

Implemenatation of chooseRadio function along with tests #1840

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
55dffd0
Implemenatation of chooseRadio function along with tests
chrissound Jul 29, 2024
4f1de67
Document chooseRadio in ChangeLog.md
chrissound Jul 29, 2024
a77cc8d
Improve chooseRadio better variable names, more concise and more appr…
chrissound Aug 1, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions yesod-test/ChangeLog.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
# ChangeLog for yesod-test

## 1.6.17

* Add `chooseRadio` to yesod-test. [#1840](https://github.com/yesodweb/yesod/pull/1840)

## 1.6.16

Expand Down
35 changes: 35 additions & 0 deletions yesod-test/Yesod/Test.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -177,6 +177,7 @@ module Yesod.Test
, fileByLabelContain
, fileByLabelPrefix
, fileByLabelSuffix
, chooseRadio

-- *** CSRF Tokens
-- | In order to prevent CSRF exploits, yesod-form adds a hidden input
Expand Down Expand Up @@ -958,6 +959,40 @@ genericNameFromHTML match label html =
name:_ -> Right name
_ -> Left $ "More than one label contained " <> label


-- | Choose a given value from a radio input, identified by the value of it's corresponding label.
-- This is a very simple and naive function, which could fail in more complex scenarios. Potentially still quite useful.
--
-- Given this HTML, and we want to submit @color=Red@ to the server:
--
-- > <form method="POST">
-- > <label for="color-red">Red</label>
-- > <input id="color-red" name="color" value="Red" />
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think typical radio input markup should look like this:

<input id="color-red" name="color" value="red">
<label for="color-red">Red</label>

i.e., the input should come before the label. Also, self-closing tags don't need a trailing slash.

-- > <label for="color-blue">Blue</label>
-- > <input id="color-blue" name="color" value="Blue" />
-- > </form>
--
-- You can set this parameter like so:
--
-- > request $ do
-- > chooseRadio "Red"
--
-- @since 1.6.17
chooseRadio :: T.Text -- ^ The text contained within the @\<label>@.
-> RequestBuilder site ()
chooseRadio v = do
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think v could be a better name. Perhaps labelText?

mres <- fmap rbdResponse getSIO
res <-
case mres of
Nothing -> failure "chooseRadio: No response available"
Just res -> return res
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Since you're only using mres in one place, you may as well inline it.

Suggested change
mres <- fmap rbdResponse getSIO
res <-
case mres of
Nothing -> failure "chooseRadio: No response available"
Just res -> return res
res <- case rbdResponse <$> getSIO of
Nothing -> failure "chooseRadio: No response available"
Just res -> pure res

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm pretty sure this can't be inlined unless using LamdbdaCase >>= \case? Otherwise we need >>= (\v -> case v of ...) but I think that is less readable but happy to do that if preferred.

let body = simpleBody res
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Similar deal here — this binding is only used once, so it may as well be inlined below.


let name = genericNameFromHTML (==) (v) body
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Unless my eyes (and brain) are failing me, I think the parentheses are redundant here.

Suggested change
let name = genericNameFromHTML (==) (v) body
let name = genericNameFromHTML (==) labelText (simpleBody res)

case name of
Right name' -> addPostParam name' $ v
Left e -> failure $ e
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The function application operators are redundant in both cases. Also, let's try to use slightly more descriptive names 🙂

Suggested change
Right name' -> addPostParam name' $ v
Left e -> failure $ e
Right name' -> addPostParam name' labelText
Left err -> failure err


byLabelWithMatch :: (T.Text -> T.Text -> Bool) -- ^ The matching method which is used to find labels (i.e. exact, contains)
-> T.Text -- ^ The text contained in the @\<label>@.
-> T.Text -- ^ The value to set the parameter to.
Expand Down
11 changes: 11 additions & 0 deletions yesod-test/test/main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -307,6 +307,15 @@ main = hspec $ do
statusIs 200
bodyEquals "שלום"

ydescribe "chooseRadio" $ do
yit "can choose radio" $ do
get ("/label-with-radio" :: Text)
request $ do
setMethod "POST"
setUrl ("check-hobby" :: Text)
chooseRadio "surfing"
res <- maybe "Couldn't get response" simpleBody <$> getResponse
assertEq "hobby isn't set" res "surfing"
ydescribe "labels" $ do
yit "can click checkbox" $ do
get ("/labels" :: Text)
Expand Down Expand Up @@ -629,6 +638,8 @@ app = liteApp $ do
return ("<html><label for='hobby'>XXXhobby</label><input type='text' name='hobby' id='hobby'></html>" :: Text)
onStatic "label-suffix-error" $ dispatchTo $
return ("<html><label for='hobby'>XXXhobby</label><label for='hobby2'>XXXneo-hobby</label><input type='text' name='hobby' id='hobby'><input type='text' name='hobby2' id='hobby2'></html>" :: Text)
onStatic "label-with-radio" $ dispatchTo $
return ("<html><label for='hobby-fishing'><input type='radio' name='hobby' id='hobby-fishing' value='fishing'>fishing</label><label for='hobby-surfing'><input type='radio' name='hobby' id='hobby-surfing' value='surfing'>surfing</label></html>" :: Text)
onStatic "check-hobby" $ dispatchTo $ do
hobby <- lookupPostParam "hobby"
return $ fromMaybe "No hobby" hobby
Expand Down
2 changes: 1 addition & 1 deletion yesod-test/yesod-test.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: yesod-test
version: 1.6.16
version: 1.6.17
license: MIT
license-file: LICENSE
author: Nubis <[email protected]>
Expand Down
Loading