diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md index 1f641f2f2..8afbf67c7 100644 --- a/yesod-test/ChangeLog.md +++ b/yesod-test/ChangeLog.md @@ -1,5 +1,10 @@ # ChangeLog for yesod-test +## 1.6.14 + +* Fix quotes not matching in htmlContain* functions [#1768](https://github.com/yesodweb/yesod/pull/1768). +* Add logging of the matches found of these functions [#1768](https://github.com/yesodweb/yesod/pull/1768). + ## 1.6.13 * Add `Yesod.Test.Internal.SIO` module to expose the `SIO` type. diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index f2adff409..f6a9de049 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -241,6 +241,8 @@ import qualified Network.Socket.Internal as Sock import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI +import qualified Text.Blaze.Renderer.String as Blaze +import qualified Text.Blaze as Blaze import Network.Wai import Network.Wai.Test hiding (assertHeader, assertNoHeader, request) import Control.Monad.IO.Class @@ -708,8 +710,13 @@ htmlAllContain query search = do matches <- htmlQuery query case matches of [] -> failure $ "Nothing matched css query: " <> query - _ -> liftIO $ HUnit.assertBool ("Not all "++T.unpack query++" contain "++search) $ - DL.all (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) + _ -> liftIO $ HUnit.assertBool ("Not all "++T.unpack query++" contain "++search ++ " matches: " ++ show matches) $ + DL.all (DL.isInfixOf (escape search)) (map (TL.unpack . decodeUtf8) matches) + +-- | puts the search trough the same escaping as the matches are. +-- this helps with matching on special characters +escape :: String -> String +escape = Blaze.renderMarkup . Blaze.string -- | Queries the HTML using a CSS selector, and passes if any matched -- element contains the given string. @@ -726,8 +733,8 @@ htmlAnyContain query search = do matches <- htmlQuery query case matches of [] -> failure $ "Nothing matched css query: " <> query - _ -> liftIO $ HUnit.assertBool ("None of "++T.unpack query++" contain "++search) $ - DL.any (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) + _ -> liftIO $ HUnit.assertBool ("None of "++T.unpack query++" contain "++search ++ " matches: " ++ show matches) $ + DL.any (DL.isInfixOf (escape search)) (map (TL.unpack . decodeUtf8) matches) -- | Queries the HTML using a CSS selector, and fails if any matched -- element contains the given string (in other words, it is the logical @@ -743,7 +750,7 @@ htmlAnyContain query search = do htmlNoneContain :: HasCallStack => Query -> String -> YesodExample site () htmlNoneContain query search = do matches <- htmlQuery query - case DL.filter (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) of + case DL.filter (DL.isInfixOf (escape search)) (map (TL.unpack . decodeUtf8) matches) of [] -> return () found -> failure $ "Found " <> T.pack (show $ length found) <> " instances of " <> T.pack search <> " in " <> query <> " elements" diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index 16acdf79b..808ccf656 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -36,6 +36,7 @@ import Network.Wai.Test (SResponse(simpleBody)) import Data.Maybe (fromMaybe) import Data.Either (isLeft, isRight) +import Test.HUnit.Lang import Data.ByteString.Lazy.Char8 () import qualified Data.Map as Map import qualified Text.HTML.DOM as HD @@ -202,9 +203,17 @@ main = hspec $ do statusIs 200 htmlCount "p" 2 htmlAllContain "p" "Hello" + htmlAllContain "span" "O'Kon" htmlAnyContain "p" "World" htmlAnyContain "p" "Moon" + htmlAnyContain "p" "O'Kon" htmlNoneContain "p" "Sun" + + -- we found it so we know the + -- matching on quotes works for NoneContain + withRunInIO $ \runInIO -> + shouldThrow (runInIO (htmlNoneContain "span" "O'Kon")) + (\case HUnitFailure _ _ -> True) yit "finds the CSRF token by css selector" $ do get ("/form" :: Text) statusIs 200 @@ -221,7 +230,7 @@ main = hspec $ do get ("/htmlWithLink" :: Text) clickOn "a#thelink" statusIs 200 - bodyEquals "
Hello World
Hello Moon
" + bodyEquals "Hello World
Hello Moon and O'Kon
" get ("/htmlWithLink" :: Text) bad <- tryAny (clickOn "a#nonexistentlink") @@ -555,7 +564,7 @@ app = liteApp $ do FormSuccess (foo, _) -> return $ toHtml foo _ -> defaultLayout widget onStatic "html" $ dispatchTo $ - return ("Hello World
Hello Moon
" :: Text) + return ("Hello World
Hello Moon and O'Kon
" :: Text) onStatic "htmlWithLink" $ dispatchTo $ return ("