haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add clickOn function (closes #1406)

Browse Source
This commit is contained in:
Mark Wotton 2017-06-14 13:40:44 -04:00
parent 2ade837223
commit ee9ef1eac5
5 changed files with 57 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
yesod-test/ChangeLog.md
View File

@ -1,3 +1,7 @@
## 1.5.7
* Add clickOn
## 1.5.6 ## 1.5.6
* Add assertNotEq. * Add assertNotEq.

11
yesod-test/Yesod/Test.hs
View File

@ -62,6 +62,7 @@ module Yesod.Test
, setRequestBody , setRequestBody
, RequestBuilder , RequestBuilder
, setUrl , setUrl
, clickOn
-- *** Adding fields by label -- *** Adding fields by label
-- | Yesod can auto generate field names, so you are never sure what -- | Yesod can auto generate field names, so you are never sure what
@ -830,6 +831,16 @@ setUrl url' = do
, rbdGets = rbdGets rbd ++ H.parseQuery (TE.encodeUtf8 urlQuery) , rbdGets = rbdGets rbd ++ H.parseQuery (TE.encodeUtf8 urlQuery)
} }
clickOn :: Yesod site => Query -> YesodExample site ()
clickOn query = do
withResponse' yedResponse ["Tried to invoke clickOn in order to read HTML of a previous response."] $ \ res ->
case findAttributeBySelector (simpleBody res) query "href" of
Left err -> failure $ query <> " did not parse: " <> T.pack (show err)
Right [[match]] -> get match
Right matches -> failure $ "Expected exactly one match for clickOn: got " <> T.pack (show matches)
-- | Simple way to set HTTP request body -- | Simple way to set HTTP request body
-- --
-- ==== __ Examples__ -- ==== __ Examples__

28
yesod-test/Yesod/Test/TransversingCSS.hs
View File

@ -27,6 +27,7 @@ Only a subset of the CSS spec is currently supported:
module Yesod.Test.TransversingCSS ( module Yesod.Test.TransversingCSS (
findBySelector, findBySelector,
findAttributeBySelector,
HtmlLBS, HtmlLBS,
Query, Query,
-- * For HXT hackers -- * For HXT hackers
@ -58,9 +59,30 @@ type HtmlLBS = L.ByteString
-- --
-- * Right: List of matching Html fragments. -- * Right: List of matching Html fragments.
findBySelector :: HtmlLBS -> Query -> Either String [String] findBySelector :: HtmlLBS -> Query -> Either String [String]
findBySelector html query = (\x -> map (renderHtml . toHtml . node) . runQuery x) findBySelector html query =
Control.Applicative.<$> (Right $ fromDocument $ HD.parseLBS html) map (renderHtml . toHtml . node) <$> findCursorsBySelector html query
Control.Applicative.<*> parseQuery query
-- | Perform a css 'Query' on 'Html'. Returns Either
--
-- * Left: Query parse error.
--
-- * Right: List of matching Cursors
findCursorsBySelector :: HtmlLBS -> Query -> Either String [Cursor]
findCursorsBySelector html query =
runQuery (fromDocument $ HD.parseLBS html)
<$> parseQuery query
-- | Perform a css 'Query' on 'Html'. Returns Either
--
-- * Left: Query parse error.
--
-- * Right: List of matching Cursors
--
-- Since 1.5.7
findAttributeBySelector :: HtmlLBS -> Query -> T.Text -> Either String [[T.Text]]
findAttributeBySelector html query attr =
map (laxAttribute attr) <$> findCursorsBySelector html query
-- Run a compiled query on Html, returning a list of matching Html fragments. -- Run a compiled query on Html, returning a list of matching Html fragments.
runQuery :: Cursor -> [[SelectorGroup]] -> [Cursor] runQuery :: Cursor -> [[SelectorGroup]] -> [Cursor]

12
yesod-test/test/main.hs
View File

@ -34,6 +34,7 @@ import Data.ByteString.Lazy.Char8 ()
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Text.HTML.DOM as HD import qualified Text.HTML.DOM as HD
import Network.HTTP.Types.Status (status301, status303, unsupportedMediaType415) import Network.HTTP.Types.Status (status301, status303, unsupportedMediaType415)
import Control.Exception.Lifted(SomeException, try)
parseQuery_ :: Text -> [[SelectorGroup]] parseQuery_ :: Text -> [[SelectorGroup]]
parseQuery_ = either error id . parseQuery parseQuery_ = either error id . parseQuery
@ -169,6 +170,15 @@ main = hspec $ do
addToken_ "body" addToken_ "body"
statusIs 200 statusIs 200
bodyEquals "12345" bodyEquals "12345"
yit "can follow a link via clickOn" $ do
get ("/htmlWithLink" :: Text)
clickOn "a#thelink"
statusIs 200
get ("/htmlWithLink" :: Text)
(bad :: Either SomeException ()) <- try (clickOn "a#nonexistentlink")
assertEq "bad link" (isLeft bad) True
ydescribe "utf8 paths" $ do ydescribe "utf8 paths" $ do
yit "from path" $ do yit "from path" $ do
@ -326,6 +336,8 @@ app = liteApp $ do
onStatic "html" $ dispatchTo $ onStatic "html" $ dispatchTo $
return ("<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon</p></body></html>" :: Text) return ("<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon</p></body></html>" :: Text)
onStatic "htmlWithLink" $ dispatchTo $
return ("<html><head><title>A link</title></head><body><a href=\"/html\" id=\"thelink\">Link!</a></body></html>" :: Text)
onStatic "labels" $ dispatchTo $ onStatic "labels" $ dispatchTo $
return ("<html><label><input type='checkbox' name='fooname' id='foobar'>Foo Bar</label></html>" :: Text) return ("<html><label><input type='checkbox' name='fooname' id='foobar'>Foo Bar</label></html>" :: Text)

2
yesod-test/yesod-test.cabal
View File

@ -1,5 +1,5 @@
name: yesod-test name: yesod-test
version: 1.5.6 version: 1.5.7
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Nubis <nubis@woobiz.com.ar> author: Nubis <nubis@woobiz.com.ar>