diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md index 0245581e..81fbda95 100644 --- a/yesod-test/ChangeLog.md +++ b/yesod-test/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.5.7 + +* Add clickOn + ## 1.5.6 * Add assertNotEq. diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 79a62df5..9dca90f6 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -62,6 +62,7 @@ module Yesod.Test , setRequestBody , RequestBuilder , setUrl + , clickOn -- *** Adding fields by label -- | 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) } +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 -- -- ==== __ Examples__ diff --git a/yesod-test/Yesod/Test/TransversingCSS.hs b/yesod-test/Yesod/Test/TransversingCSS.hs index 658f30a0..bcf555a6 100644 --- a/yesod-test/Yesod/Test/TransversingCSS.hs +++ b/yesod-test/Yesod/Test/TransversingCSS.hs @@ -10,16 +10,16 @@ and it returns a list of the HTML fragments that matched the given query. Only a subset of the CSS spec is currently supported: * By tag name: /table td a/ - + * By class names: /.container .content/ * By Id: /#oneId/ * By attribute: /[hasIt]/, /[exact=match]/, /[contains*=text]/, /[starts^=with]/, /[ends$=with]/ - + * Union: /a, span, p/ - - * Immediate children: /div > p/ + + * Immediate children: /div > p/ * Get jiggy with it: /div[data-attr=yeah] > .mon, .foo.bar div, #oneThing/ @@ -27,6 +27,7 @@ Only a subset of the CSS spec is currently supported: module Yesod.Test.TransversingCSS ( findBySelector, + findAttributeBySelector, HtmlLBS, Query, -- * For HXT hackers @@ -58,9 +59,30 @@ type HtmlLBS = L.ByteString -- -- * Right: List of matching Html fragments. findBySelector :: HtmlLBS -> Query -> Either String [String] -findBySelector html query = (\x -> map (renderHtml . toHtml . node) . runQuery x) - Control.Applicative.<$> (Right $ fromDocument $ HD.parseLBS html) - Control.Applicative.<*> parseQuery query +findBySelector html query = + map (renderHtml . toHtml . node) <$> findCursorsBySelector html 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. runQuery :: Cursor -> [[SelectorGroup]] -> [Cursor] diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index ff2cca7c..705e3532 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -34,6 +34,7 @@ import Data.ByteString.Lazy.Char8 () import qualified Data.Map as Map import qualified Text.HTML.DOM as HD import Network.HTTP.Types.Status (status301, status303, unsupportedMediaType415) +import Control.Exception.Lifted(SomeException, try) parseQuery_ :: Text -> [[SelectorGroup]] parseQuery_ = either error id . parseQuery @@ -169,6 +170,15 @@ main = hspec $ do addToken_ "body" statusIs 200 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 yit "from path" $ do @@ -326,6 +336,8 @@ app = liteApp $ do onStatic "html" $ dispatchTo $ return ("Hello

Hello World

Hello Moon

" :: Text) + onStatic "htmlWithLink" $ dispatchTo $ + return ("A linkLink!" :: Text) onStatic "labels" $ dispatchTo $ return ("" :: Text) diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index cd1dddc7..8e834f10 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -1,5 +1,5 @@ name: yesod-test -version: 1.5.6 +version: 1.5.7 license: MIT license-file: LICENSE author: Nubis