hspec-wai 0.6.6 → 0.7.0

raw patch · 4 files changed

+55/−36 lines, 4 filesdep −with-locationdep ~hspec-expectationsPVP ok

version bump matches the API change (PVP)

Dependencies removed: with-location

Dependency ranges changed: hspec-expectations

API changes (from Hackage documentation)

Files

• hspec-wai.cabal +6/−8
• src/Test/Hspec/Wai.hs +6/−3
• src/Test/Hspec/Wai/Internal.hs +2/−2
• src/Test/Hspec/Wai/Matcher.hs +41/−23

@@ -1,9 +1,9 @@--- This file has been generated from package.yaml by hpack version 0.11.0.+-- This file has been generated from package.yaml by hpack version 0.15.0. -- -- see: https://github.com/sol/hpack  name:             hspec-wai-version:          0.6.6+version:          0.7.0 homepage:         https://github.com/hspec/hspec-wai#readme bug-reports:      https://github.com/hspec/hspec-wai/issues license:          MIT@@ -42,15 +42,14 @@     , wai >= 3     , wai-extra >= 3     , hspec-core == 2.*-    , hspec-expectations+    , hspec-expectations >= 0.8.0     , QuickCheck-    , with-location >= 0.1.0   exposed-modules:       Test.Hspec.Wai       Test.Hspec.Wai.QuickCheck       Test.Hspec.Wai.Internal-  other-modules:       Test.Hspec.Wai.Matcher+  other-modules:       Test.Hspec.Wai.Util       Paths_hspec_wai   default-language: Haskell2010@@ -60,7 +59,7 @@   main-is: Spec.hs   hs-source-dirs:       src-    , test+      test   ghc-options: -Wall   build-depends:       base == 4.*@@ -73,9 +72,8 @@     , wai >= 3     , wai-extra >= 3     , hspec-core == 2.*-    , hspec-expectations+    , hspec-expectations >= 0.8.0     , QuickCheck-    , with-location >= 0.1.0     , hspec     , QuickCheck   other-modules:

@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-} -- | Have a look at the <https://github.com/hspec/hspec-wai#readme README> for -- an example of how to use this library. module Test.Hspec.Wai (@@ -21,8 +22,11 @@  -- * Matching on the response , shouldRespondWith+ , ResponseMatcher(..) , MatchHeader(..)+, MatchBody(..)+, Body , (<:>)  -- * Helpers and re-exports@@ -40,12 +44,11 @@ import           Network.HTTP.Types import           Network.Wai.Test hiding (request) import qualified Network.Wai.Test as Wai-import           Data.WithLocation+import           Test.Hspec.Expectations  import           Test.Hspec.Core.Spec hiding (pending, pendingWith) import qualified Test.Hspec.Core.Spec as Core import           Test.Hspec.Core.Hooks-import           Test.Hspec.Expectations (expectationFailure)  import           Test.Hspec.Wai.Util import           Test.Hspec.Wai.Internal@@ -97,7 +100,7 @@ -- -- > get "/" `shouldRespondWith` "foo" {matchHeaders = ["Content-Type" <:> "text/plain"]} -- > -- matches if body is "foo", status is 200 and ther is a header field "Content-Type: text/plain"-shouldRespondWith :: WithLocation (WaiSession SResponse -> ResponseMatcher -> WaiExpectation)+shouldRespondWith :: HasCallStack => WaiSession SResponse -> ResponseMatcher -> WaiExpectation shouldRespondWith action matcher = do   r <- action   forM_ (match r matcher) (liftIO . expectationFailure)

@@ -22,12 +22,12 @@ import           Test.Hspec.Wai.Util (formatHeader)  -- | An expectation in the `WaiSession` monad.  Failing expectations are--- communicated through exceptions (similar to `Expectation` and+-- communicated through exceptions (similar to `Test.Hspec.Expectations.Expectation` and -- `Test.HUnit.Base.Assertion`). type WaiExpectation = WaiSession ()  -- | A <http://www.yesodweb.com/book/web-application-interface WAI> test--- session that carries the `Application` under test an some client state.+-- session that carries the `Application` under test and some client state. newtype WaiSession a = WaiSession {unWaiSession :: Session a}   deriving (Functor, Applicative, Monad, MonadIO) 

@@ -2,7 +2,10 @@ module Test.Hspec.Wai.Matcher (   ResponseMatcher(..) , MatchHeader(..)+, MatchBody(..)+, Body , (<:>)+, bodyEquals , match ) where @@ -13,6 +16,7 @@ import           Data.Maybe import           Data.String import           Data.Text.Lazy.Encoding (encodeUtf8)+import qualified Data.Text.Lazy as T import           Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LB import           Network.HTTP.Types@@ -20,19 +24,39 @@  import           Test.Hspec.Wai.Util +type Body = LB.ByteString+ data ResponseMatcher = ResponseMatcher {   matchStatus :: Int , matchHeaders :: [MatchHeader]-, matchBody :: Maybe LB.ByteString+, matchBody :: MatchBody } -data MatchHeader = MatchHeader ([Header] -> Maybe String)+data MatchHeader = MatchHeader ([Header] -> Body -> Maybe String) +data MatchBody = MatchBody ([Header] -> Body -> Maybe String)++bodyEquals :: Body -> MatchBody+bodyEquals body = MatchBody (\_ actual -> bodyMatcher actual body)+  where+    bodyMatcher :: Body -> Body -> Maybe String+    bodyMatcher (toStrict -> actual) (toStrict -> expected) = actualExpected "body mismatch:" actual_ expected_ <$ guard (actual /= expected)+      where+        (actual_, expected_) = case (safeToString actual, safeToString expected) of+          (Just x, Just y) -> (x, y)+          _ -> (show actual, show expected)++matchAny :: MatchBody+matchAny = MatchBody (\_ _ -> Nothing)++instance IsString MatchBody where+  fromString = bodyEquals . encodeUtf8 . T.pack+ instance IsString ResponseMatcher where-  fromString s = ResponseMatcher 200 [] (Just . encodeUtf8 . fromString $ s)+  fromString = ResponseMatcher 200 [] . fromString  instance Num ResponseMatcher where-  fromInteger n = ResponseMatcher (fromInteger n) [] Nothing+  fromInteger n = ResponseMatcher (fromInteger n) [] matchAny   (+) =    error "ResponseMatcher does not support (+)"   (-) =    error "ResponseMatcher does not support (-)"   (*) =    error "ResponseMatcher does not support (*)"@@ -40,34 +64,28 @@   signum = error "ResponseMatcher does not support `signum`"  match :: SResponse -> ResponseMatcher -> Maybe String-match (SResponse (Status status _) headers body) (ResponseMatcher expectedStatus expectedHeaders expectedBody) = mconcat [+match (SResponse (Status status _) headers body) (ResponseMatcher expectedStatus expectedHeaders (MatchBody bodyMatcher)) = mconcat [     actualExpected "status mismatch:" (show status) (show expectedStatus) <$ guard (status /= expectedStatus)-  , checkHeaders headers expectedHeaders-  , expectedBody >>= matchBody_ body+  , checkHeaders headers body expectedHeaders+  , bodyMatcher headers body   ]-  where-    matchBody_ (toStrict -> actual) (toStrict -> expected) = actualExpected "body mismatch:" actual_ expected_ <$ guard (actual /= expected)-      where-        (actual_, expected_) = case (safeToString actual, safeToString expected) of-          (Just x, Just y) -> (x, y)-          _ -> (show actual, show expected) -    actualExpected :: String -> String -> String -> String-    actualExpected message actual expected = unlines [-        message-      , "  expected: " ++ expected-      , "  but got:  " ++ actual-      ]+actualExpected :: String -> String -> String -> String+actualExpected message actual expected = unlines [+    message+  , "  expected: " ++ expected+  , "  but got:  " ++ actual+  ] -checkHeaders :: [Header] -> [MatchHeader] -> Maybe String-checkHeaders headers m = case go m of+checkHeaders :: [Header] -> Body -> [MatchHeader] -> Maybe String+checkHeaders headers body m = case go m of     [] -> Nothing     xs -> Just (mconcat xs ++ "the actual headers were:\n" ++ unlines (map formatHeader headers))   where-    go = catMaybes . map (\(MatchHeader p) -> p headers)+    go = catMaybes . map (\(MatchHeader p) -> p headers body)  (<:>) :: HeaderName -> ByteString -> MatchHeader-name <:> value = MatchHeader $ \headers -> guard (header `notElem` headers) >> (Just . unlines) [+name <:> value = MatchHeader $ \headers _body -> guard (header `notElem` headers) >> (Just . unlines) [     "missing header:"   , formatHeader header   ]