haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add implicit param HasCallStack to assertions

Browse Source
This commit is contained in:
Sebastián Estrella 2017-07-18 23:01:04 -05:00
parent 7038ae6317
commit a58a4d88cd
3 changed files with 31 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
yesod-test/ChangeLog.md
View File

@ -1,3 +1,7 @@
## 1.5.8
* Added implicit parameter HasCallStack to assertions.
[#1421](https://github.com/yesodweb/yesod/pull/1421)
## 1.5.7 ## 1.5.7
* Add clickOn. * Add clickOn.

40
yesod-test/Yesod/Test.hs
View File

@ -4,6 +4,8 @@
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE ConstraintKinds #-}
{-| {-|
Yesod.Test is a pragmatic framework for testing web applications built Yesod.Test is a pragmatic framework for testing web applications built
@ -150,6 +152,16 @@ import Data.Time.Clock (getCurrentTime)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Text.Show.Pretty (ppShow) import Text.Show.Pretty (ppShow)
import Data.Monoid (mempty) import Data.Monoid (mempty)
#if MIN_VERSION_base(4,9,0)
import GHC.Stack (HasCallStack)
#elif MIN_VERSION_base(4,8,1)
import GHC.Stack (CallStack)
type HasCallStack = (?callStack :: CallStack)
#else
import GHC.Exts (Constraint)
type HasCallStack = (() :: Constraint)
#endif
-- | The state used in a single test case defined using 'yit' -- | The state used in a single test case defined using 'yit'
-- --
@ -330,7 +342,7 @@ htmlQuery = htmlQuery' yedResponse []
-- In case they are not equal, error mesasge includes the two values. -- In case they are not equal, error mesasge includes the two values.
-- --
-- @since 1.5.2 -- @since 1.5.2
assertEq :: (Eq a, Show a) => String -> a -> a -> YesodExample site () assertEq :: (HasCallStack, Eq a, Show a) => String -> a -> a -> YesodExample site ()
assertEq m a b = assertEq m a b =
liftIO $ HUnit.assertBool msg (a == b) liftIO $ HUnit.assertBool msg (a == b)
where msg = "Assertion: " ++ m ++ "\n" ++ where msg = "Assertion: " ++ m ++ "\n" ++
@ -342,24 +354,24 @@ assertEq m a b =
-- In case they are equal, error mesasge includes the values. -- In case they are equal, error mesasge includes the values.
-- --
-- @since 1.5.6 -- @since 1.5.6
assertNotEq :: (Eq a, Show a) => String -> a -> a -> YesodExample site () assertNotEq :: (HasCallStack, Eq a, Show a) => String -> a -> a -> YesodExample site ()
assertNotEq m a b = assertNotEq m a b =
liftIO $ HUnit.assertBool msg (a /= b) liftIO $ HUnit.assertBool msg (a /= b)
where msg = "Assertion: " ++ m ++ "\n" ++ where msg = "Assertion: " ++ m ++ "\n" ++
"Both arguments: " ++ ppShow a ++ "\n" "Both arguments: " ++ ppShow a ++ "\n"
{-# DEPRECATED assertEqual "Use assertEq instead" #-} {-# DEPRECATED assertEqual "Use assertEq instead" #-}
assertEqual :: (Eq a) => String -> a -> a -> YesodExample site () assertEqual :: (HasCallStack, Eq a) => String -> a -> a -> YesodExample site ()
assertEqual = assertEqualNoShow assertEqual = assertEqualNoShow
-- | Asserts that the two given values are equal. -- | Asserts that the two given values are equal.
-- --
-- @since 1.5.2 -- @since 1.5.2
assertEqualNoShow :: (Eq a) => String -> a -> a -> YesodExample site () assertEqualNoShow :: (HasCallStack, Eq a) => String -> a -> a -> YesodExample site ()
assertEqualNoShow msg a b = liftIO $ HUnit.assertBool msg (a == b) assertEqualNoShow msg a b = liftIO $ HUnit.assertBool msg (a == b)
-- | Assert the last response status is as expected. -- | Assert the last response status is as expected.
statusIs :: Int -> YesodExample site () statusIs :: HasCallStack => Int -> YesodExample site ()
statusIs number = withResponse $ \ SResponse { simpleStatus = s } -> statusIs number = withResponse $ \ SResponse { simpleStatus = s } ->
liftIO $ flip HUnit.assertBool (H.statusCode s == number) $ concat liftIO $ flip HUnit.assertBool (H.statusCode s == number) $ concat
[ "Expected status was ", show number [ "Expected status was ", show number
@ -367,7 +379,7 @@ statusIs number = withResponse $ \ SResponse { simpleStatus = s } ->
] ]
-- | Assert the given header key/value pair was returned. -- | Assert the given header key/value pair was returned.
assertHeader :: CI BS8.ByteString -> BS8.ByteString -> YesodExample site () assertHeader :: HasCallStack => CI BS8.ByteString -> BS8.ByteString -> YesodExample site ()
assertHeader header value = withResponse $ \ SResponse { simpleHeaders = h } -> assertHeader header value = withResponse $ \ SResponse { simpleHeaders = h } ->
case lookup header h of case lookup header h of
Nothing -> failure $ T.pack $ concat Nothing -> failure $ T.pack $ concat
@ -387,7 +399,7 @@ assertHeader header value = withResponse $ \ SResponse { simpleHeaders = h } ->
] ]
-- | Assert the given header was not included in the response. -- | Assert the given header was not included in the response.
assertNoHeader :: CI BS8.ByteString -> YesodExample site () assertNoHeader :: HasCallStack => CI BS8.ByteString -> YesodExample site ()
assertNoHeader header = withResponse $ \ SResponse { simpleHeaders = h } -> assertNoHeader header = withResponse $ \ SResponse { simpleHeaders = h } ->
case lookup header h of case lookup header h of
Nothing -> return () Nothing -> return ()
@ -400,14 +412,14 @@ assertNoHeader header = withResponse $ \ SResponse { simpleHeaders = h } ->
-- | Assert the last response is exactly equal to the given text. This is -- | Assert the last response is exactly equal to the given text. This is
-- useful for testing API responses. -- useful for testing API responses.
bodyEquals :: String -> YesodExample site () bodyEquals :: HasCallStack => String -> YesodExample site ()
bodyEquals text = withResponse $ \ res -> bodyEquals text = withResponse $ \ res ->
liftIO $ HUnit.assertBool ("Expected body to equal " ++ text) $ liftIO $ HUnit.assertBool ("Expected body to equal " ++ text) $
(simpleBody res) == encodeUtf8 (TL.pack text) (simpleBody res) == encodeUtf8 (TL.pack text)
-- | Assert the last response has the given text. The check is performed using the response -- | Assert the last response has the given text. The check is performed using the response
-- body in full text form. -- body in full text form.
bodyContains :: String -> YesodExample site () bodyContains :: HasCallStack => String -> YesodExample site ()
bodyContains text = withResponse $ \ res -> bodyContains text = withResponse $ \ res ->
liftIO $ HUnit.assertBool ("Expected body to contain " ++ text) $ liftIO $ HUnit.assertBool ("Expected body to contain " ++ text) $
(simpleBody res) `contains` text (simpleBody res) `contains` text
@ -415,7 +427,7 @@ bodyContains text = withResponse $ \ res ->
-- | Assert the last response doesn't have the given text. The check is performed using the response -- | Assert the last response doesn't have the given text. The check is performed using the response
-- body in full text form. -- body in full text form.
-- @since 1.5.3 -- @since 1.5.3
bodyNotContains :: String -> YesodExample site () bodyNotContains :: HasCallStack => String -> YesodExample site ()
bodyNotContains text = withResponse $ \ res -> bodyNotContains text = withResponse $ \ res ->
liftIO $ HUnit.assertBool ("Expected body not to contain " ++ text) $ liftIO $ HUnit.assertBool ("Expected body not to contain " ++ text) $
not $ contains (simpleBody res) text not $ contains (simpleBody res) text
@ -425,7 +437,7 @@ contains a b = DL.isInfixOf b (TL.unpack $ decodeUtf8 a)
-- | Queries the HTML using a CSS selector, and all matched elements must contain -- | Queries the HTML using a CSS selector, and all matched elements must contain
-- the given string. -- the given string.
htmlAllContain :: Query -> String -> YesodExample site () htmlAllContain :: HasCallStack => Query -> String -> YesodExample site ()
htmlAllContain query search = do htmlAllContain query search = do
matches <- htmlQuery query matches <- htmlQuery query
case matches of case matches of
@ -437,7 +449,7 @@ htmlAllContain query search = do
-- element contains the given string. -- element contains the given string.
-- --
-- Since 0.3.5 -- Since 0.3.5
htmlAnyContain :: Query -> String -> YesodExample site () htmlAnyContain :: HasCallStack => Query -> String -> YesodExample site ()
htmlAnyContain query search = do htmlAnyContain query search = do
matches <- htmlQuery query matches <- htmlQuery query
case matches of case matches of
@ -450,7 +462,7 @@ htmlAnyContain query search = do
-- inverse of htmlAnyContains). -- inverse of htmlAnyContains).
-- --
-- Since 1.2.2 -- Since 1.2.2
htmlNoneContain :: Query -> String -> YesodExample site () htmlNoneContain :: HasCallStack => Query -> String -> YesodExample site ()
htmlNoneContain query search = do htmlNoneContain query search = do
matches <- htmlQuery query matches <- htmlQuery query
case DL.filter (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) of case DL.filter (DL.isInfixOf search) (map (TL.unpack . decodeUtf8) matches) of
@ -460,7 +472,7 @@ htmlNoneContain query search = do
-- | Performs a CSS query on the last response and asserts the matched elements -- | Performs a CSS query on the last response and asserts the matched elements
-- are as many as expected. -- are as many as expected.
htmlCount :: Query -> Int -> YesodExample site () htmlCount :: HasCallStack => Query -> Int -> YesodExample site ()
htmlCount query count = do htmlCount query count = do
matches <- fmap DL.length $ htmlQuery query matches <- fmap DL.length $ htmlQuery query
liftIO $ flip HUnit.assertBool (matches == count) liftIO $ flip HUnit.assertBool (matches == count)

2
yesod-test/yesod-test.cabal
View File

@ -1,5 +1,5 @@
name: yesod-test name: yesod-test
version: 1.5.7 version: 1.5.8
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Nubis <nubis@woobiz.com.ar> author: Nubis <nubis@woobiz.com.ar>