yesod-test 1.6.14 → 1.6.15
raw patch · 5 files changed
+87/−14 lines, 5 files
Files
- ChangeLog.md +5/−0
- README.md +3/−3
- Yesod/Test.hs +59/−10
- test/main.hs +19/−0
- yesod-test.cabal +1/−1
ChangeLog.md view
@@ -1,5 +1,10 @@ # ChangeLog for yesod-test ++## 1.6.15++* Add `bySelectorLabelContain`. [#1781](https://github.com/yesodweb/yesod/pull/1781)+ ## 1.6.14 * Fix quotes not matching in htmlContain* functions [#1768](https://github.com/yesodweb/yesod/pull/1768).
README.md view
@@ -42,9 +42,9 @@ addToken -- Add the CSRF _token field with the currently shown value. -- Lookup field by the text on the labels pointing to them. - byLabel "Email:" "gustavo@cerati.com" - byLabel "Password:" "secret" - byLabel "Confirm:" "secret" + byLabelExact "Email:" "gustavo@cerati.com" + byLabelExact "Password:" "secret" + byLabelExact "Confirm:" "secret" it "Sends another form, this one has a file" $ do request $ do
Yesod/Test.hs view
@@ -170,6 +170,7 @@ , byLabelContain , byLabelPrefix , byLabelSuffix+ , bySelectorLabelContain , fileByLabel , fileByLabelExact , fileByLabelContain@@ -876,9 +877,36 @@ case mres of Nothing -> failure "genericNameFromLabel: No response available" Just res -> return res+ let body = simpleBody res+ case genericNameFromHTML match label body of+ Left e -> failure e+ Right x -> pure x++-- |+-- This looks up the name of a field based on a CSS selector and the contents of the label pointing to it.+genericNameFromSelectorLabel :: HasCallStack => (T.Text -> T.Text -> Bool) -> T.Text -> T.Text -> RequestBuilder site T.Text+genericNameFromSelectorLabel match selector label = do+ mres <- fmap rbdResponse getSIO+ res <-+ case mres of+ Nothing -> failure "genericNameSelectorFromLabel: No response available"+ Just res -> return res+ let body = simpleBody res+ html <-+ case findBySelector body selector of+ Left parseError -> failure $ "genericNameFromSelectorLabel: Parse error" <> T.pack parseError+ Right [] -> failure $ "genericNameFromSelectorLabel: No fragments match selector " <> selector+ Right [matchingFragment] -> pure $ BSL8.pack matchingFragment+ Right _matchingFragments -> failure $ "genericNameFromSelectorLabel: Multiple fragments match selector " <> selector+ case genericNameFromHTML match label html of+ Left e -> failure e+ Right x -> pure x++genericNameFromHTML :: (T.Text -> T.Text -> Bool) -> T.Text -> HtmlLBS -> Either T.Text T.Text+genericNameFromHTML match label html = let- body = simpleBody res- mlabel = parseHTML body+ parsedHTML = parseHTML html+ mlabel = parsedHTML $// C.element "label" >=> isContentMatch label mfor = mlabel >>= attribute "for"@@ -887,26 +915,26 @@ | x `match` T.concat (c $// content) = [c] | otherwise = [] - case mfor of+ in case mfor of for:[] -> do- let mname = parseHTML body+ let mname = parsedHTML $// attributeIs "id" for >=> attribute "name" case mname of- "":_ -> failure $ T.concat+ "":_ -> Left $ T.concat [ "Label " , label , " resolved to id " , for , " which was not found. " ]- name:_ -> return name- [] -> failure $ "No input with id " <> for+ name:_ -> Right name+ [] -> Left $ "No input with id " <> for [] -> case filter (/= "") $ mlabel >>= (child >=> C.element "input" >=> attribute "name") of- [] -> failure $ "No label contained: " <> label- name:_ -> return name- _ -> failure $ "More than one label contained " <> label+ [] -> Left $ "No label contained: " <> label+ name:_ -> Right name+ _ -> Left $ "More than one label contained " <> label 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>@.@@ -916,6 +944,15 @@ name <- genericNameFromLabel match label addPostParam name value +bySelectorLabelWithMatch :: (T.Text -> T.Text -> Bool) -- ^ The matching method which is used to find labels (i.e. exact, contains)+ -> T.Text -- ^ The CSS selector.+ -> T.Text -- ^ The text contained in the @\<label>@.+ -> T.Text -- ^ The value to set the parameter to.+ -> RequestBuilder site ()+bySelectorLabelWithMatch match selector label value = do+ name <- genericNameFromSelectorLabel match selector label+ addPostParam name value+ -- How does this work for the alternate <label><input></label> syntax? -- | Finds the @\<label>@ with the given value, finds its corresponding @\<input>@, then adds a parameter@@ -1028,6 +1065,18 @@ -> T.Text -- ^ The value to set the parameter to. -> RequestBuilder site () byLabelSuffix = byLabelWithMatch T.isSuffixOf++-- |+-- Note: This function throws an error if it finds multiple labels or if the+-- CSS selector fails to parse, doesn't match any fragment, or matches multiple+-- fragments.+--+-- @since 1.6.15+bySelectorLabelContain :: T.Text -- ^ The CSS selector.+ -> T.Text -- ^ The text in the @\<label>@.+ -> T.Text -- ^ The value to set the parameter to.+ -> RequestBuilder site ()+bySelectorLabelContain = bySelectorLabelWithMatch T.isInfixOf fileByLabelWithMatch :: (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>@.
test/main.hs view
@@ -319,6 +319,21 @@ setUrl ("label-contain-error" :: Text) byLabelContain "hobby" "fishing") assertEq "failure wasn't called" (isLeft bad) True+ yit "bySelectorLabelContain looks for the selector and label which contain the given label name" $ do+ get ("/selector-label-contain" :: Text)+ request $ do+ setMethod "POST"+ setUrl ("check-hobby" :: Text)+ bySelectorLabelContain "#hobby-container" "hobby" "fishing"+ res <- maybe "Couldn't get response" simpleBody <$> getResponse+ assertEq "hobby isn't set" res "fishing"+ yit "bySelectorLabelContain throws an error if the selector matches multiple elements" $ do+ get ("selector-label-contain-error" :: Text)+ (bad :: Either SomeException ()) <- try (request $ do+ setMethod "POST"+ setUrl ("check-hobby" :: Text)+ bySelectorLabelContain "#hobby-container" "hobby" "fishing")+ assertEq "failure wasn't called" (isLeft bad) True yit "byLabelPrefix matches over the prefix of the labels" $ do get ("/label-prefix" :: Text) request $ do@@ -576,6 +591,10 @@ return ("<html><label for='hobby'>XXXhobbyXXX</label><input type='text' name='hobby' id='hobby'></html>" :: Text) onStatic "label-contain-error" $ dispatchTo $ return ("<html><label for='hobby'>XXXhobbyXXX</label><label for='hobby2'>XXXhobby2XXX</label><input type='text' name='hobby' id='hobby'><input type='text' name='hobby2' id='hobby2'></html>" :: Text)+ onStatic "selector-label-contain" $ dispatchTo $+ return ("<html><div><label for='hobby-1'>XXXhobbyXXX</label><input type='text' name='hobby-1' id='hobby-1'></div><div id='hobby-container'><label for='hobby'>XXXhobbyXXX</label><input type='text' name='hobby' id='hobby'></div></html>" :: Text)+ onStatic "selector-label-contain-error" $ dispatchTo $+ return ("<html><div id='hobby-container'><label for='hobby-1'>XXXhobbyXXX</label><input type='text' name='hobby-1' id='hobby-1'></div><div id='hobby-container'><label for='hobby'>XXXhobbyXXX</label><input type='text' name='hobby' id='hobby'></div></html>" :: Text) onStatic "label-prefix" $ dispatchTo $ return ("<html><label for='hobby'>hobbyXXX</label><input type='text' name='hobby' id='hobby'></html>" :: Text) onStatic "label-prefix-error" $ dispatchTo $
yesod-test.cabal view
@@ -1,5 +1,5 @@ name: yesod-test-version: 1.6.14+version: 1.6.15 license: MIT license-file: LICENSE author: Nubis <nubis@woobiz.com.ar>