Merge pull request #1482 from pythonissam/bylabel-contain

Bylabel contain

yesod-test/ChangeLog.md

@@ -1,3 +1,8 @@
+## 1.6.2
+
+* Add byLabel-related functions like byLabelContain
+[#1482](https://github.com/yesodweb/yesod/pull/1482)
+
 ## 1.6.1
 
 * Fix the build with `base-4.11` (GHC 8.4).

yesod-test/Yesod/Test.hs

@@ -76,8 +76,14 @@ module Yesod.Test
     -- on currently displayed label names.
     , byLabel
     , byLabelExact
+    , byLabelContain
+    , byLabelPrefix
+    , byLabelSuffix
     , fileByLabel
     , fileByLabelExact
+    , fileByLabelContain
+    , fileByLabelPrefix
+    , fileByLabelSuffix
 
     -- *** CSRF Tokens
     -- | In order to prevent CSRF exploits, yesod-form adds a hidden input
@@ -169,8 +175,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 byLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use byLabelExact, byLabelContain, byLabelPrefix or byLabelSuffix instead" #-}
-{-# DEPRECATED fileByLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use fileByLabelExact instead" #-}
+{-# DEPRECATED fileByLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use fileByLabelExact, fileByLabelContain, fileByLabelPrefix or fileByLabelSuffix instead" #-}
 
 -- | The state used in a single test case defined using 'yit'
 --
@@ -659,6 +665,48 @@ byLabelExact :: T.Text -- ^ The text in the @\<label>@.
              -> RequestBuilder site ()
 byLabelExact = byLabelWithMatch (==)
 
+-- |
+-- Contain version of 'byLabelExact'
+--
+-- Note: Just like 'byLabel', this function throws an error if it finds multiple labels
+--
+-- @since 1.6.2
+byLabelContain :: T.Text -- ^ The text in the @\<label>@.
+               -> T.Text -- ^ The value to set the parameter to.
+               -> RequestBuilder site ()
+byLabelContain = byLabelWithMatch T.isInfixOf
+
+-- |
+-- Prefix version of 'byLabelExact'
+--
+-- Note: Just like 'byLabel', this function throws an error if it finds multiple labels
+--
+-- @since 1.6.2
+byLabelPrefix :: T.Text -- ^ The text in the @\<label>@.
+              -> T.Text -- ^ The value to set the parameter to.
+              -> RequestBuilder site ()
+byLabelPrefix = byLabelWithMatch T.isPrefixOf
+
+-- |
+-- Suffix version of 'byLabelExact'
+--
+-- Note: Just like 'byLabel', this function throws an error if it finds multiple labels
+--
+-- @since 1.6.2
+byLabelSuffix :: T.Text -- ^ The text in the @\<label>@.
+              -> T.Text -- ^ The value to set the parameter to.
+              -> RequestBuilder site ()
+byLabelSuffix = byLabelWithMatch T.isSuffixOf
+
+fileByLabelWithMatch  :: (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 @\<label>@.
+                      -> FilePath                   -- ^ The path to the file.
+                      -> T.Text                     -- ^ The MIME type of the file, e.g. "image/png".
+                      -> RequestBuilder site ()
+fileByLabelWithMatch match label path mime = do
+  name <- genericNameFromLabel match label
+  addFile name path mime
+
 -- | Finds the @\<label>@ with the given value, finds its corresponding @\<input>@, then adds a file for that input to the request body.
 --
 -- ==== __Examples__
@@ -687,9 +735,7 @@ fileByLabel :: T.Text -- ^ The text contained in the @\<label>@.
             -> FilePath -- ^ The path to the file.
             -> T.Text -- ^ The MIME type of the file, e.g. "image/png".
             -> RequestBuilder site ()
-fileByLabel label path mime = do
+fileByLabel = fileByLabelWithMatch T.isInfixOf
-  name <- genericNameFromLabel T.isInfixOf label
-  addFile name path mime
 
 -- | Finds the @\<label>@ with the given value, finds its corresponding @\<input>@, then adds a file for that input to the request body.
 --
@@ -719,9 +765,43 @@ fileByLabelExact :: T.Text -- ^ The text contained in the @\<label>@.
                  -> FilePath -- ^ The path to the file.
                  -> T.Text -- ^ The MIME type of the file, e.g. "image/png".
                  -> RequestBuilder site ()
-fileByLabelExact label path mime = do
+fileByLabelExact = fileByLabelWithMatch (==)
-  name <- genericNameFromLabel (==) label
+
-  addFile name path mime
+-- |
+-- Contain version of 'fileByLabelExact'
+--
+-- Note: Just like 'fileByLabel', this function throws an error if it finds multiple labels
+--
+-- @since 1.6.2
+fileByLabelContain :: T.Text -- ^ The text contained in the @\<label>@.
+                   -> FilePath -- ^ The path to the file.
+                   -> T.Text -- ^ The MIME type of the file, e.g. "image/png".
+                   -> RequestBuilder site ()
+fileByLabelContain = fileByLabelWithMatch T.isInfixOf
+
+-- |
+-- Prefix version of 'fileByLabelExact'
+--
+-- Note: Just like 'fileByLabel', this function throws an error if it finds multiple labels
+--
+-- @since 1.6.2
+fileByLabelPrefix :: T.Text -- ^ The text contained in the @\<label>@.
+                  -> FilePath -- ^ The path to the file.
+                  -> T.Text -- ^ The MIME type of the file, e.g. "image/png".
+                  -> RequestBuilder site ()
+fileByLabelPrefix = fileByLabelWithMatch T.isPrefixOf
+
+-- |
+-- Suffix version of 'fileByLabelExact'
+--
+-- Note: Just like 'fileByLabel', this function throws an error if it finds multiple labels
+--
+-- @since 1.6.2
+fileByLabelSuffix :: T.Text -- ^ The text contained in the @\<label>@.
+                  -> FilePath -- ^ The path to the file.
+                  -> T.Text -- ^ The MIME type of the file, e.g. "image/png".
+                  -> RequestBuilder site ()
+fileByLabelSuffix = fileByLabelWithMatch T.isSuffixOf
 
 -- | Lookups the hidden input named "_token" and adds its value to the params.
 -- Receives a CSS selector that should resolve to the form element containing the token.

yesod-test/test/main.hs

@@ -30,6 +30,7 @@ import Data.Text (Text, pack)
 import Data.Monoid ((<>))
 import Control.Applicative
 import Network.Wai (pathInfo, requestHeaders)
+import Network.Wai.Test (SResponse(simpleBody))
 import Data.Maybe (fromMaybe)
 import Data.Either (isLeft, isRight)
 
@@ -218,7 +219,7 @@ main = hspec $ do
                     setMethod "POST"
                     setUrl ("/labels" :: Text)
                     byLabel "Foo Bar" "yes"
-        ydescribe "labels2" $ do
+        ydescribe "byLabel-related tests" $ do
             yit "fails with \"More than one label contained\" error" $ do
                 get ("/labels2" :: Text)
                 (bad :: Either SomeException ()) <- try (request $ do
@@ -233,7 +234,48 @@ main = hspec $ do
                     setUrl ("labels2" :: Text)
                     byLabelExact "hobby" "fishing")
                 assertEq "failure was called" (isRight bad) True
-
+            yit "byLabelContain looks for the labels which contain the given label name" $ do
+                get ("/label-contain" :: Text)
+                request $ do
+                    setMethod "POST"
+                    setUrl ("check-hobby" :: Text)
+                    byLabelContain "hobby" "fishing"
+                res <- maybe "Couldn't get response" simpleBody <$> getResponse
+                assertEq "hobby isn't set" res "fishing"
+            yit "byLabelContain throws an error if it finds multiple labels" $ do
+                (bad :: Either SomeException ()) <- try (request $ do
+                    setMethod "POST"
+                    setUrl ("label-contain-error" :: Text)
+                    byLabelContain "hobby" "fishing")
+                assertEq "failure wasn't called" (isLeft bad) True
+            yit "byLabelPrefix matches over the prefix of the labels" $ do
+                get ("/label-prefix" :: Text)
+                request $ do
+                    setMethod "POST"
+                    setUrl ("check-hobby" :: Text)
+                    byLabelPrefix "hobby" "fishing"
+                res <- maybe "Couldn't get response" simpleBody <$> getResponse
+                assertEq "hobby isn't set" res "fishing"
+            yit "byLabelPrefix throws an error if it finds multiple labels" $ do
+                (bad :: Either SomeException ()) <- try (request $ do
+                    setMethod "POST"
+                    setUrl ("label-prefix-error" :: Text)
+                    byLabelPrefix "hobby" "fishing")
+                assertEq "failure wasn't called" (isLeft bad) True
+            yit "byLabelSuffix matches over the suffix of the labels" $ do
+                get ("/label-suffix" :: Text)
+                request $ do
+                    setMethod "POST"
+                    setUrl ("check-hobby" :: Text)
+                    byLabelSuffix "hobby" "fishing"
+                res <- maybe "Couldn't get response" simpleBody <$> getResponse
+                assertEq "hobby isn't set" res "fishing"
+            yit "byLabelSuffix throws an error if it finds multiple labels" $ do
+                (bad :: Either SomeException ()) <- try (request $ do
+                    setMethod "POST"
+                    setUrl ("label-suffix-error" :: Text)
+                    byLabelSuffix "hobby" "fishing")
+                assertEq "failure wasn't called" (isLeft bad) True
         ydescribe "Content-Type handling" $ do
             yit "can set a content-type" $ do
                 request $ do
@@ -383,6 +425,21 @@ app = liteApp $ do
         return ("<html><label><input type='checkbox' name='fooname' id='foobar'>Foo Bar</label></html>" :: Text)
     onStatic "labels2" $ dispatchTo $
         return ("<html><label for='hobby'>hobby</label><label for='hobby2'>hobby2</label><input type='text' name='hobby' id='hobby'><input type='text' name='hobby2' id='hobby2'></html>" :: Text)
+    onStatic "label-contain" $ dispatchTo $
+        return ("<html><label for='hobby'>XXXhobbyXXX</label><input type='text' name='hobby' id='hobby'></html>" :: Text)
+    onStatic "label-contain-error" $ dispatchTo $
+        return ("<html><label for='hobby'>XXXhobbyXXX</label><label for='hobby2'>XXXhobby2XXX</label><input type='text' name='hobby' id='hobby'><input type='text' name='hobby2' id='hobby2'></html>" :: Text)
+    onStatic "label-prefix" $ dispatchTo $
+        return ("<html><label for='hobby'>hobbyXXX</label><input type='text' name='hobby' id='hobby'></html>" :: Text)
+    onStatic "label-prefix-error" $ dispatchTo $
+        return ("<html><label for='hobby'>hobbyXXX</label><label for='hobby2'>hobby2XXX</label><input type='text' name='hobby' id='hobby'><input type='text' name='hobby2' id='hobby2'></html>" :: Text)
+    onStatic "label-suffix" $ dispatchTo $
+        return ("<html><label for='hobby'>XXXhobby</label><input type='text' name='hobby' id='hobby'></html>" :: Text)
+    onStatic "label-suffix-error" $ dispatchTo $
+        return ("<html><label for='hobby'>XXXhobby</label><label for='hobby2'>XXXneo-hobby</label><input type='text' name='hobby' id='hobby'><input type='text' name='hobby2' id='hobby2'></html>" :: Text)
+    onStatic "check-hobby" $ dispatchTo $ do
+        hobby <- lookupPostParam "hobby"
+        return $ fromMaybe "No hobby" hobby
 
     onStatic "checkContentType" $ dispatchTo $ do
         headers <- requestHeaders <$> waiRequest

yesod-test/yesod-test.cabal

@@ -1,5 +1,5 @@
 name:               yesod-test
-version:            1.6.1
+version:            1.6.2
 license:            MIT
 license-file:       LICENSE
 author:             Nubis <nubis@woobiz.com.ar>
@@ -62,6 +62,7 @@ test-suite test
                           , yesod-form >= 1.6
                           , text
                           , wai
+                          , wai-extra
                           , http-types
                           , unliftio