diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md index 41acb0c8..1a03a169 100644 --- a/yesod-test/ChangeLog.md +++ b/yesod-test/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.5.9 +* Add byLabelExact and related functions +[#1459](https://github.com/yesodweb/yesod/pull/1459) + ## 1.5.8 * Added implicit parameter HasCallStack to assertions. [#1421](https://github.com/yesodweb/yesod/pull/1421) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index e359896b..a9e474d3 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -73,7 +73,9 @@ module Yesod.Test -- These functions let you add parameters to your request based -- on currently displayed label names. , byLabel + , byLabelExact , fileByLabel + , fileByLabelExact -- *** CSRF Tokens -- | In order to prevent CSRF exploits, yesod-form adds a hidden input @@ -162,6 +164,8 @@ import GHC.Exts (Constraint) type HasCallStack = (() :: Constraint) #endif +{-# DEPRECATED byLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use byLabelExact instead" #-} +{-# DEPRECATED fileByLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use fileByLabelExact instead" #-} -- | The state used in a single test case defined using 'yit' -- @@ -523,23 +527,24 @@ addFile name path mimetype = do addPostData (MultipleItemsPostData posts) contents = MultipleItemsPostData $ ReqFilePart name path contents mimetype : posts +-- | -- This looks up the name of a field based on the contents of the label pointing to it. -nameFromLabel :: T.Text -> RequestBuilder site T.Text -nameFromLabel label = do +genericNameFromLabel :: (T.Text -> T.Text -> Bool) -> T.Text -> RequestBuilder site T.Text +genericNameFromLabel match label = do mres <- fmap rbdResponse ST.get res <- case mres of - Nothing -> failure "nameFromLabel: No response available" + Nothing -> failure "genericNameFromLabel: No response available" Just res -> return res let body = simpleBody res mlabel = parseHTML body $// C.element "label" - >=> contentContains label + >=> isContentMatch label mfor = mlabel >>= attribute "for" - contentContains x c - | x `T.isInfixOf` T.concat (c $// content) = [c] + isContentMatch x c + | x `match` T.concat (c $// content) = [c] | otherwise = [] case mfor of @@ -566,6 +571,14 @@ nameFromLabel label = do (<>) :: T.Text -> T.Text -> T.Text (<>) = T.append +byLabelWithMatch :: (T.Text -> T.Text -> Bool) -- ^ The matching method which is used to find labels (i.e. exact, contains) + -> T.Text -- ^ The text contained in the @\