From 71d013854a81ca8d3d467fabd25b76c35603cf89 Mon Sep 17 00:00:00 2001
From: Eric Ahlberg <eahlberg@gmail.com>
Date: Fri, 7 Oct 2022 17:41:54 +0200
Subject: [PATCH] Add versions of 'htmlAnyContain' etc. which match strings
 verbatim

---
 yesod-test/Yesod/Test.hs | 58 ++++++++++++++++++++++++++++++++++++++++
 yesod-test/test/main.hs  |  7 +++--
 2 files changed, 63 insertions(+), 2 deletions(-)

diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index 91884608c..0b3caedbc 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -204,6 +204,9 @@ module Yesod.Test
     , htmlAllContain
     , htmlAnyContain
     , htmlNoneContain
+    , htmlAllContainPreEscaped
+    , htmlAnyContainPreEscaped
+    , htmlNoneContainPreEscaped
     , htmlCount
     , requireJSONResponse
 
@@ -754,6 +757,61 @@ htmlNoneContain query search = do
     found -> failure $ "Found " <> T.pack (show $ length found) <>
                 " instances of " <> T.pack search <> " in " <> query <> " elements"
 
+-- | Queries the HTML using a CSS selector, and all matched elements must contain
+-- the given string verbatim.
+--
+-- ==== __Examples__
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > get HomeR
+-- > htmlAllContainPreEscaped "meta" " "content=\"site description\""-- Every <meta> tag contain the string "content=site description" verbatim
+--
+-- Since 16.6.6
+htmlAllContainPreEscaped :: HasCallStack => Query -> String -> YesodExample site ()
+htmlAllContainPreEscaped 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  ++ " matches: " ++ show matches) $
+          DL.all (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches)
+
+-- | Queries the HTML using a CSS selector, and passes if any matched
+-- element contains the given string verbatim.
+--
+-- ==== __Examples__
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > get HomeR
+-- > htmlAnyContainPreEscaped "meta" "content=\"site description\"" -- At least one <meta> tag contains the string "content=site description" verbatim
+--
+-- Since 16.6.6
+htmlAnyContainPreEscaped :: HasCallStack => Query -> String -> YesodExample site ()
+htmlAnyContainPreEscaped 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 ++ " matches: " ++ show matches) $
+          DL.any (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches)
+
+-- | Queries the HTML using a CSS selector, and fails if any matched
+-- element contains the given string verbatim (in other words, it is
+-- the logical inverse of htmlAnyContainPreEscaped).
+--
+-- ==== __Examples__
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > get HomeR
+-- > htmlNoneContainPreEscaped "meta" "content=\"site description\"" -- No <meta> tag contains the string "content=site description" verbatim
+--
+-- Since 16.6.6
+htmlNoneContainPreEscaped :: HasCallStack => Query -> String -> YesodExample site ()
+htmlNoneContainPreEscaped query search = do
+  matches <- htmlQuery query
+  case DL.filter (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) of
+    [] -> return ()
+    found -> failure $ "Found " <> T.pack (show $ length found) <>
+                " instances of " <> T.pack search <> " in " <> query <> " elements"
+
 -- | Performs a CSS query on the last response and asserts the matched elements
 -- are as many as expected.
 --
diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs
index 4276c8500..62711a677 100644
--- a/yesod-test/test/main.hs
+++ b/yesod-test/test/main.hs
@@ -201,6 +201,9 @@ main = hspec $ do
             yit "finding html" $ do
                 get ("/html" :: Text)
                 statusIs 200
+                htmlAnyContainPreEscaped "meta" "content=\"site description\""
+                htmlAllContainPreEscaped "meta"  "content=\"site description"
+                htmlNoneContainPreEscaped "meta" "foobar"
                 htmlCount "p" 2
                 htmlAllContain "p" "Hello"
                 htmlAllContain "span" "O'Kon"
@@ -230,7 +233,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 and <span>O'Kon</span></p></body></html>"
+              bodyEquals "<html><head><meta name=description content=\"site description\"/><meta name=og:description content=\"site description og\"/><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")
@@ -579,7 +582,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 and <span>O'Kon</span></p></body></html>" :: Text)
+        return ("<html><head><meta name=description content=\"site description\"/><meta name=og:description content=\"site description og\"/><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)