Fix quote ' not matching in htmlContain* functions

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.

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"

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 "<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon</p></body></html>"
+              bodyEquals "<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon and <span>O'Kon</span></p></body></html>"
 
               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 ("<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 and <span>O'Kon</span></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)

yesod-test/yesod-test.cabal

@@ -1,5 +1,5 @@
 name:               yesod-test
-version:            1.6.13
+version:            1.6.14
 license:            MIT
 license-file:       LICENSE
 author:             Nubis <nubis@woobiz.com.ar>
@@ -41,6 +41,7 @@ library
                    , xml-conduit               >= 1.0
                    , xml-types                 >= 0.3
                    , yesod-core                >= 1.6.17
+                   , blaze-markup
 
     exposed-modules: Yesod.Test
                      Yesod.Test.CssQuery