diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,5 @@ +0.3.3.1 - 2015-9-8 - Upgrade to hspec 2.2 (this is breaking, so we require it). + 0.3.3.0 - 2015-6-5 - Add postJson helper. 0.3.2.9 - 2015-5-22 - Typo in previous release (dependency in test suite was wrong). diff --git a/hspec-snap.cabal b/hspec-snap.cabal --- a/hspec-snap.cabal +++ b/hspec-snap.cabal @@ -1,5 +1,5 @@ name: hspec-snap -version: 0.3.3.0 +version: 0.3.3.1 synopsis: A library for testing with Hspec and the Snap Web Framework homepage: https://github.com/dbp/hspec-snap license: BSD3 @@ -23,8 +23,8 @@ , bytestring >= 0.9 && < 0.11 , containers >= 0.4 && < 0.6 , digestive-functors >= 0.7 && < 0.9 - , hspec >= 2.0 && < 2.2 - , hspec-core >= 2.0 && < 2.2 + , hspec >= 2.2 && < 2.3 + , hspec-core >= 2.2 && < 2.3 , hxt >= 9.3 && < 9.4 , HandsomeSoup >= 0.3 && < 0.5 , lens >= 3.10 && < 5 @@ -45,8 +45,8 @@ , bytestring >= 0.9 && < 0.11 , containers >= 0.4 && < 0.6 , digestive-functors >= 0.7 && < 0.9 - , hspec >= 2.0 && < 2.2 - , hspec-core >= 2.0 && < 2.2 + , hspec >= 2.2 && < 2.3 + , hspec-core >= 2.2 && < 2.3 , hxt >= 9.3 && < 9.4 , HandsomeSoup >= 0.3 && < 0.5 , lens >= 3.10 && < 5 @@ -56,4 +56,4 @@ , text >= 0.11 && < 1.3 , transformers >= 0.3 && < 0.5 , directory >= 1.2 && < 1.3 - build-depends: hspec-snap == 0.3.3.0 + build-depends: hspec-snap == 0.3.3.1 diff --git a/src/Test/Hspec/Snap.hs b/src/Test/Hspec/Snap.hs --- a/src/Test/Hspec/Snap.hs +++ b/src/Test/Hspec/Snap.hs @@ -81,18 +81,18 @@ ) where import Control.Applicative ((<$>)) -import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar - ,putMVar, readMVar, takeMVar) +import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, + readMVar, takeMVar) import Control.Exception (SomeException, catch) import Control.Monad (void) import Control.Monad.State (StateT (..), runStateT) import qualified Control.Monad.State as S (get, put) import Control.Monad.Trans (liftIO) -import Data.Aeson (encode, ToJSON) +import Data.Aeson (ToJSON, encode) import Data.ByteString (ByteString) -import qualified Data.ByteString.Lazy as LBS (ByteString) import Data.ByteString.Lazy (fromStrict, toStrict) +import qualified Data.ByteString.Lazy as LBS (ByteString) import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Text (Text) @@ -264,15 +264,15 @@ do contents <- sessContents if t `T.isInfixOf` contents then setResult Success - else setResult (Fail $ "Session did not contain: " ++ T.unpack t - ++ "\n\nSession was:\n" ++ T.unpack contents) + else setResult (Fail Nothing $ "Session did not contain: " ++ T.unpack t + ++ "\n\nSession was:\n" ++ T.unpack contents) sessionShouldNotContain :: Text -> SnapHspecM b () sessionShouldNotContain t = do contents <- sessContents if t `T.isInfixOf` contents - then setResult (Fail $ "Session should not have contained: " ++ T.unpack t - ++ "\n\nSession was:\n" ++ T.unpack contents) + then setResult (Fail Nothing $ "Session should not have contained: " ++ T.unpack t + ++ "\n\nSession was:\n" ++ T.unpack contents) else setResult Success -- | Runs a DELETE request @@ -358,7 +358,7 @@ -> SnapHspecM b () shouldEqual a b = if a == b then setResult Success - else setResult (Fail ("Should have held: " ++ show a ++ " == " ++ show b)) + else setResult (Fail Nothing ("Should have held: " ++ show a ++ " == " ++ show b)) -- | Asserts that two values are not equal. shouldNotEqual :: (Show a, Eq a) @@ -366,64 +366,64 @@ -> a -> SnapHspecM b () shouldNotEqual a b = if a == b - then setResult (Fail ("Should not have held: " ++ show a ++ " == " ++ show b)) + then setResult (Fail Nothing ("Should not have held: " ++ show a ++ " == " ++ show b)) else setResult Success -- | Asserts that the value is True. shouldBeTrue :: Bool -> SnapHspecM b () shouldBeTrue True = setResult Success -shouldBeTrue False = setResult (Fail "Value should have been True.") +shouldBeTrue False = setResult (Fail Nothing "Value should have been True.") -- | Asserts that the value is not True (otherwise known as False). shouldNotBeTrue :: Bool -> SnapHspecM b () shouldNotBeTrue False = setResult Success -shouldNotBeTrue True = setResult (Fail "Value should have been True.") +shouldNotBeTrue True = setResult (Fail Nothing "Value should have been True.") -- | Asserts that the response is a success (either Html, or Other with status 200). should200 :: TestResponse -> SnapHspecM b () should200 (Html _) = setResult Success should200 (Other 200) = setResult Success -should200 r = setResult (Fail (show r)) +should200 r = setResult (Fail Nothing (show r)) -- | Asserts that the response is not a normal 200. shouldNot200 :: TestResponse -> SnapHspecM b () -shouldNot200 (Html _) = setResult (Fail "Got Html back.") -shouldNot200 (Other 200) = setResult (Fail "Got Other with 200 back.") +shouldNot200 (Html _) = setResult (Fail Nothing "Got Html back.") +shouldNot200 (Other 200) = setResult (Fail Nothing "Got Other with 200 back.") shouldNot200 _ = setResult Success -- | Asserts that the response is a NotFound. should404 :: TestResponse -> SnapHspecM b () should404 NotFound = setResult Success -should404 r = setResult (Fail (show r)) +should404 r = setResult (Fail Nothing (show r)) -- | Asserts that the response is not a NotFound. shouldNot404 :: TestResponse -> SnapHspecM b () -shouldNot404 NotFound = setResult (Fail "Got NotFound back.") +shouldNot404 NotFound = setResult (Fail Nothing "Got NotFound back.") shouldNot404 _ = setResult Success -- | Asserts that the response is a redirect. should300 :: TestResponse -> SnapHspecM b () should300 (Redirect _ _) = setResult Success -should300 r = setResult (Fail (show r)) +should300 r = setResult (Fail Nothing (show r)) -- | Asserts that the response is not a redirect. shouldNot300 :: TestResponse -> SnapHspecM b () -shouldNot300 (Redirect _ _) = setResult (Fail "Got Redirect back.") +shouldNot300 (Redirect _ _) = setResult (Fail Nothing "Got Redirect back.") shouldNot300 _ = setResult Success -- | Asserts that the response is a redirect, and thet the url it -- redirects to starts with the given path. should300To :: Text -> TestResponse -> SnapHspecM b () should300To pth (Redirect _ to) | pth `T.isPrefixOf` to = setResult Success -should300To _ r = setResult (Fail (show r)) +should300To _ r = setResult (Fail Nothing (show r)) -- | Asserts that the response is not a redirect to a given path. Note -- that it can still be a redirect for this assertion to succeed, the -- path it redirects to just can't start with the given path. shouldNot300To :: Text -> TestResponse -> SnapHspecM b () -shouldNot300To pth (Redirect _ to) | pth `T.isPrefixOf` to = setResult (Fail "Got Redirect back.") +shouldNot300To pth (Redirect _ to) | pth `T.isPrefixOf` to = setResult (Fail Nothing "Got Redirect back.") shouldNot300To _ _ = setResult Success -- | Assert that a response (which should be Html) has a given selector. @@ -431,15 +431,15 @@ shouldHaveSelector selector r@(Html body) = setResult $ if haveSelector' selector r then Success - else Fail msg + else Fail Nothing msg where msg = T.unpack $ T.concat ["Html should have contained selector: ", selector, "\n\n", body] -shouldHaveSelector match _ = setResult (Fail (T.unpack $ T.concat ["Non-HTML body should have contained css selector: ", match])) +shouldHaveSelector match _ = setResult (Fail Nothing (T.unpack $ T.concat ["Non-HTML body should have contained css selector: ", match])) -- | Assert that a response (which should be Html) doesn't have a given selector. shouldNotHaveSelector :: Text -> TestResponse -> SnapHspecM b () shouldNotHaveSelector selector r@(Html body) = setResult $ if haveSelector' selector r - then Fail msg + then Fail Nothing msg else Success where msg = T.unpack $ T.concat ["Html should not have contained selector: ", selector, "\n\n", body] shouldNotHaveSelector _ _ = setResult Success @@ -456,14 +456,14 @@ shouldHaveText match (Html body) = if T.isInfixOf match body then setResult Success - else setResult (Fail $ T.unpack $ T.concat [body, "' contains '", match, "'."]) -shouldHaveText match _ = setResult (Fail (T.unpack $ T.concat ["Body contains: ", match])) + else setResult (Fail Nothing $ T.unpack $ T.concat [body, "' contains '", match, "'."]) +shouldHaveText match _ = setResult (Fail Nothing (T.unpack $ T.concat ["Body contains: ", match])) -- | Asserts that the response (which should be Html) does not contain the given text. shouldNotHaveText :: Text -> TestResponse -> SnapHspecM b () shouldNotHaveText match (Html body) = if T.isInfixOf match body - then setResult (Fail $ T.unpack $ T.concat [body, "' contains '", match, "'."]) + then setResult (Fail Nothing $ T.unpack $ T.concat [body, "' contains '", match, "'."]) else setResult Success shouldNotHaveText _ _ = setResult Success @@ -486,12 +486,12 @@ Value a -> shouldEqual (snd r) (Just a) Predicate f -> case snd r of - Nothing -> setResult (Fail $ T.unpack $ + Nothing -> setResult (Fail Nothing $ T.unpack $ T.append "Expected form to validate. Resulted in errors: " (T.pack (show $ DF.viewErrors $ fst r))) Just v -> if f v then setResult Success - else setResult (Fail $ T.unpack $ + else setResult (Fail Nothing $ T.unpack $ T.append "Expected predicate to pass on value: " (T.pack (show v))) ErrorPaths expectedPaths -> @@ -499,11 +499,11 @@ if all (`elem` viewErrorPaths) expectedPaths then if length viewErrorPaths == length expectedPaths then setResult Success - else setResult (Fail $ "Number of errors did not match test. Got:\n\n " + else setResult (Fail Nothing $ "Number of errors did not match test. Got:\n\n " ++ show viewErrorPaths ++ "\n\nBut expected:\n\n" ++ show expectedPaths) - else setResult (Fail $ "Did not have all errors specified. Got:\n\n" + else setResult (Fail Nothing $ "Did not have all errors specified. Got:\n\n" ++ show viewErrorPaths ++ "\n\nBut expected:\n\n" ++ show expectedPaths)