hspec-snap 0.3.3.1 → 0.4.0.0
raw patch · 4 files changed
+50/−37 lines, 4 filesdep ~hspec-snapPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hspec-snap
API changes (from Hackage documentation)
- Test.Hspec.Snap: instance Eq TestResponse
- Test.Hspec.Snap: instance Example (SnapHspecM b ())
- Test.Hspec.Snap: instance Show TestResponse
+ Test.Hspec.Snap: instance GHC.Classes.Eq Test.Hspec.Snap.RespCode
+ Test.Hspec.Snap: instance GHC.Classes.Eq Test.Hspec.Snap.TestResponse
+ Test.Hspec.Snap: instance GHC.Classes.Ord Test.Hspec.Snap.RespCode
+ Test.Hspec.Snap: instance GHC.Num.Num Test.Hspec.Snap.RespCode
+ Test.Hspec.Snap: instance GHC.Read.Read Test.Hspec.Snap.RespCode
+ Test.Hspec.Snap: instance GHC.Show.Show Test.Hspec.Snap.RespCode
+ Test.Hspec.Snap: instance GHC.Show.Show Test.Hspec.Snap.TestResponse
+ Test.Hspec.Snap: instance Test.Hspec.Core.Example.Example (Test.Hspec.Snap.SnapHspecM b ())
- Test.Hspec.Snap: Html :: Text -> TestResponse
+ Test.Hspec.Snap: Html :: RespCode -> Text -> TestResponse
- Test.Hspec.Snap: Json :: ByteString -> TestResponse
+ Test.Hspec.Snap: Json :: RespCode -> ByteString -> TestResponse
- Test.Hspec.Snap: Other :: Int -> TestResponse
+ Test.Hspec.Snap: Other :: RespCode -> TestResponse
- Test.Hspec.Snap: Redirect :: Int -> Text -> TestResponse
+ Test.Hspec.Snap: Redirect :: RespCode -> Text -> TestResponse
Files
- CHANGELOG +2/−0
- hspec-snap.cabal +2/−2
- spec/Main.hs +4/−3
- src/Test/Hspec/Snap.hs +42/−32
CHANGELOG view
@@ -1,3 +1,5 @@+0.4.0.0 - 2015-10-7 - Add response codes to responses.+ 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.
hspec-snap.cabal view
@@ -1,5 +1,5 @@ name: hspec-snap-version: 0.3.3.1+version: 0.4.0.0 synopsis: A library for testing with Hspec and the Snap Web Framework homepage: https://github.com/dbp/hspec-snap license: BSD3@@ -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.1+ build-depends: hspec-snap == 0.4.0.0
spec/Main.hs view
@@ -177,7 +177,8 @@ post "/params" (params [("q", "hello")]) >>= shouldHaveText "POST hello" post "/params" (params [("r", "hello")]) >>= shouldNotHaveText "hello" it "should post json" $ do- Json raw <- postJson "/postJson" exampleObj+ resp@(Json _ raw) <- postJson "/postJson" exampleObj+ should200 resp Just (ExampleObject 43 "foo!") `shouldEqual` decode raw it "should not match <html> on PUT request" $ put "/test" M.empty >>= shouldNotHaveText "<html>"@@ -201,9 +202,9 @@ get "/redirect" >>= shouldNot300To "/redirect" get "/test" >>= shouldNot300To "/redirect" it "differentiates between response content types" $ do- Json raw <- get "/json"+ Json _ raw <- get "/json" Just exampleObj `shouldEqual` decode raw- Html doc <- get "/test"+ Html _ doc <- get "/test" doc `shouldEqual` html describe "stateful changes" $ do let isE = use mv >>= \m -> liftIO $ isEmptyMVar m
src/Test/Hspec/Snap.hs view
@@ -1,13 +1,14 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-} module Test.Hspec.Snap ( -- * Running blocks of hspec-snap tests@@ -114,14 +115,18 @@ import qualified Text.HandsomeSoup as HS import qualified Text.XML.HXT.Core as HXT +-- derives Num and Ord to avoid excessive newtype wrapping and unwrapping+-- in pattern matching, etc.+newtype RespCode = RespCode Int deriving (Show, Read, Eq, Num, Ord)+ -- | The result of making requests against your application. Most -- assertions act against these types (for example, `should200`, -- `shouldHaveSelector`, etc).-data TestResponse = Html Text- | Json LBS.ByteString+data TestResponse = Html RespCode Text+ | Json RespCode LBS.ByteString | NotFound- | Redirect Int Text- | Other Int+ | Redirect RespCode Text+ | Other RespCode | Empty deriving (Show, Eq) @@ -315,10 +320,10 @@ -- | Restricts a response to matches for a given CSS selector. -- Does nothing to non-Html responses. restrictResponse :: Text -> TestResponse -> TestResponse-restrictResponse selector (Html body) =+restrictResponse selector (Html code body) = case HXT.runLA (HXT.xshow $ HXT.hread HXT.>>> HS.css (T.unpack selector)) (T.unpack body) of- [] -> Html ""- matches -> Html (T.concat (map T.pack matches))+ [] -> Html code ""+ matches -> Html code (T.concat (map T.pack matches)) restrictResponse _ r = r -- | Runs an arbitrary stateful action from your application.@@ -383,13 +388,14 @@ -- | 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 (Html _ _) = setResult Success+should200 (Json 200 _) = setResult Success+should200 (Other 200) = setResult Success should200 r = setResult (Fail Nothing (show r)) -- | Asserts that the response is not a normal 200. shouldNot200 :: TestResponse -> SnapHspecM b ()-shouldNot200 (Html _) = setResult (Fail Nothing "Got Html back.")+shouldNot200 (Html _ _) = setResult (Fail Nothing "Got Html back.") shouldNot200 (Other 200) = setResult (Fail Nothing "Got Other with 200 back.") shouldNot200 _ = setResult Success @@ -428,7 +434,7 @@ -- | Assert that a response (which should be Html) has a given selector. shouldHaveSelector :: Text -> TestResponse -> SnapHspecM b ()-shouldHaveSelector selector r@(Html body) =+shouldHaveSelector selector r@(Html _ body) = setResult $ if haveSelector' selector r then Success else Fail Nothing msg@@ -437,7 +443,7 @@ -- | Assert that a response (which should be Html) doesn't have a given selector. shouldNotHaveSelector :: Text -> TestResponse -> SnapHspecM b ()-shouldNotHaveSelector selector r@(Html body) =+shouldNotHaveSelector selector r@(Html _ body) = setResult $ if haveSelector' selector r then Fail Nothing msg else Success@@ -445,7 +451,7 @@ shouldNotHaveSelector _ _ = setResult Success haveSelector' :: Text -> TestResponse -> Bool-haveSelector' selector (Html body) =+haveSelector' selector (Html _ body) = case HXT.runLA (HXT.hread HXT.>>> HS.css (T.unpack selector)) (T.unpack body) of [] -> False _ -> True@@ -453,7 +459,7 @@ -- | Asserts that the response (which should be Html) contains the given text. shouldHaveText :: Text -> TestResponse -> SnapHspecM b ()-shouldHaveText match (Html body) =+shouldHaveText match (Html _ body) = if T.isInfixOf match body then setResult Success else setResult (Fail Nothing $ T.unpack $ T.concat [body, "' contains '", match, "'."])@@ -461,7 +467,7 @@ -- | Asserts that the response (which should be Html) does not contain the given text. shouldNotHaveText :: Text -> TestResponse -> SnapHspecM b ()-shouldNotHaveText match (Html body) =+shouldNotHaveText match (Html _ body) = if T.isInfixOf match body then setResult (Fail Nothing $ T.unpack $ T.concat [body, "' contains '", match, "'."]) else setResult Success@@ -520,23 +526,27 @@ case res of Left err -> error $ T.unpack err- Right response ->- case rspStatus response of+ Right response -> let respCode = respStatus response in+ case respCode of 404 -> return NotFound 200 -> liftIO $ parse200 response- _ -> if rspStatus response >= 300 && rspStatus response < 400+ _ -> if respCode >= 300 && respCode < 400 then do let url = fromMaybe "" $ getHeader "Location" response- return (Redirect (rspStatus response) (T.decodeUtf8 url))- else return (Other (rspStatus response))+ return (Redirect respCode (T.decodeUtf8 url))+ else return (Other respCode) +respStatus :: Response -> RespCode+respStatus = RespCode . rspStatus++ parse200 :: Response -> IO TestResponse parse200 resp = let body = getResponseBody resp contentType = getHeader "content-type" resp in case contentType of- Just "application/json" -> Json . fromStrict <$> body- _ -> Html . T.decodeUtf8 <$> body+ Just "application/json" -> Json 200 . fromStrict <$> body+ _ -> Html 200 . T.decodeUtf8 <$> body -- | Runs a request against a given handler (often the whole site), -- with the given state. Returns any triggered exception, or the response.