hspec-wai 0.0.0 → 0.1.0

raw patch · 6 files changed

+104/−36 lines, 6 filesdep +case-insensitivedep +markdown-unlitPVP ok

version bump matches the API change (PVP)

Dependencies added: case-insensitive, markdown-unlit

API changes (from Hackage documentation)

Files

• README.lhs +47/−0
• example/Spec.hs +0/−1
• hspec-wai.cabal +8/−6
• src/Test/Hspec/Wai.hs +0/−8
• src/Test/Hspec/Wai/Matcher.hs +26/−21
• src/Test/Hspec/Wai/Util.hs +23/−0

@@ -0,0 +1,47 @@+hspec-wai [![Build Status](https://travis-ci.org/hspec/hspec-wai.svg?branch=master)](https://travis-ci.org/hspec/hspec-wai)+===========++Helpers to test [WAI](http://www.yesodweb.com/book/web-application-interface)+applications with [Hspec](http://hspec.github.io/)++## Example++~~~ {.haskell}+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import           Test.Hspec+import           Test.Hspec.Wai++import           Network.HTTP.Types (status200, hContentType)+import           Network.Wai (Application, responseLBS)++main :: IO ()+main = hspec spec++app :: Application+app _ = ($ responseLBS status200 [("Content-Type", "text/plain")] "hello")++spec :: Spec+spec = before (return app) $ do+  describe "GET /foo" $ do+    it "reponds with 200" $ do+      get "/foo" `shouldRespondWith` 200++    it "reponds with 'hello'" $ do+      get "/foo" `shouldRespondWith` "hello"++    it "reponds with 200 / 'hello'" $ do+      get "/foo" `shouldRespondWith` "hello" {matchStatus = 200}++    it "has Content-Type: text/plain" $ do+      get "/foo" `shouldRespondWith` 200 {matchHeaders = [(hContentType, "text/plain")]}+~~~++## Contributing++1. Fork it+2. Create your feature branch (`git checkout -b my-new-feature`)+3. Commit your changes (`git commit -am 'Add some feature'`)+4. Push to the branch (`git push origin my-new-feature`)+5. Create new Pull Request

@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -1,5 +1,5 @@ name:             hspec-wai-version:          0.0.0+version:          0.1.0 license:          MIT license-file:     LICENSE copyright:        (c) 2012-2014 Fujimura Daisuke,@@ -23,14 +23,16 @@       src   exposed-modules:       Test.Hspec.Wai-    , Test.Hspec.Wai.Internal+      Test.Hspec.Wai.Internal   other-modules:+      Test.Hspec.Wai.Util       Test.Hspec.Wai.Matcher   build-depends:       base == 4.*     , bytestring     , text     , transformers+    , case-insensitive     , http-types     , wai >= 3     , wai-extra >= 3@@ -50,6 +52,7 @@     , bytestring     , text     , transformers+    , case-insensitive     , http-types     , wai     , wai-extra@@ -61,13 +64,12 @@   type:       exitcode-stdio-1.0   ghc-options:-      -Wall -Werror-  hs-source-dirs:-      example+      -Wall -Werror -pgmL markdown-unlit   main-is:-      Spec.hs+      README.lhs   build-depends:       base == 4.*+    , markdown-unlit     , hspec2     , hspec-wai     , http-types

@@ -5,7 +5,6 @@ , post , put , request-, shouldHaveHeader , shouldRespondWith , ResponseMatcher(..) ) where@@ -25,13 +24,6 @@  with :: IO a -> SpecWith a -> Spec with = before---- |--- Passes if the given `Header` exists in the response.-shouldHaveHeader :: WaiSession SResponse -> Header -> WaiExpectation-shouldHaveHeader action header = do-  r <- action-  forM_ (haveHeader r header) (liftIO . expectationFailure)  -- | -- Passs if

@@ -1,7 +1,6 @@ module Test.Hspec.Wai.Matcher (   ResponseMatcher(..) , match-, haveHeader ) where  @@ -10,21 +9,23 @@ import           Data.Functor import           Data.String import           Data.Text.Lazy.Encoding (encodeUtf8)-import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as LB import           Network.HTTP.Types import           Network.Wai.Test +import           Test.Hspec.Wai.Util+ data ResponseMatcher = ResponseMatcher {   matchStatus :: Int+, matchHeaders :: [Header] , matchBody :: Maybe LB.ByteString }  instance IsString ResponseMatcher where-  fromString s = ResponseMatcher 200 (Just . encodeUtf8 . fromString $ s)+  fromString s = ResponseMatcher 200 [] (Just . encodeUtf8 . fromString $ s)  instance Num ResponseMatcher where-  fromInteger n = ResponseMatcher (fromInteger n) Nothing+  fromInteger n = ResponseMatcher (fromInteger n) [] Nothing   (+) =    error "ResponseMatcher does not support (+)"   (-) =    error "ResponseMatcher does not support (-)"   (*) =    error "ResponseMatcher does not support (*)"@@ -32,28 +33,32 @@   signum = error "ResponseMatcher does not support `signum`"  match :: SResponse -> ResponseMatcher -> Maybe String-match (SResponse (Status status _) _ body) (ResponseMatcher expectedStatus expectedBody) = mconcat [-    match_ "status mismatch" status expectedStatus-  , expectedBody >>= match_ "body mismatch" body+match (SResponse (Status status _) headers body) (ResponseMatcher expectedStatus expectedHeaders expectedBody) = mconcat [+    actualExpected "status mismatch:" (show status) (show expectedStatus) <$ guard (status /= expectedStatus)+  , checkHeaders headers expectedHeaders+  , expectedBody >>= matchBody_ body   ]   where-    match_ :: (Show a, Eq a) => String -> a -> a -> Maybe String-    match_ message actual expected = actualExpected message actual expected <$ guard (actual /= expected)+    matchBody_ actual expected = actualExpected "body mismatch:" actual_ expected_ <$ guard (actual /= expected)+      where+        (actual_, expected_) = case (safeToString $ LB.toStrict actual, safeToString $ LB.toStrict expected) of+          (Just x, Just y) -> (x, y)+          _ -> (show actual, show expected) -    actualExpected :: Show a => String -> a -> a -> String+    actualExpected :: String -> String -> String -> String     actualExpected message actual expected = unlines [         message-      , "  expected: " ++ show expected-      , "  but got:  " ++ show actual+      , "  expected: " ++ expected+      , "  but got:  " ++ actual       ] -haveHeader :: SResponse -> Header -> Maybe String-haveHeader (SResponse _ headers _) (name, expected) = go $ lookup name headers+checkHeaders :: [Header] -> [Header] -> Maybe String+checkHeaders actual expected = case filter (`notElem` actual) expected of+  [] -> Nothing+  missing ->+    let msg+          | length missing == 1 = "missing header:"+          | otherwise = "missing headers:"+    in Just $ unlines (msg : formatHeaders missing ++ "the actual headers were:" : formatHeaders actual)   where-    go Nothing = Just $ "header doesn't exist: " ++ show name-    go (Just actual) = if actual == expected-                         then Nothing-                         else (Just . unlines) [ "header mismatch"-                                               , "  expected: \"" ++ B.unpack expected ++ "\""-                                               , "  but got:  \"" ++ B.unpack actual ++ "\""-                                               ]+    formatHeaders = map (("  " ++) . formatHeader)

@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+module Test.Hspec.Wai.Util where++import           Control.Monad+import           Data.Maybe+import           Data.Char+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.CaseInsensitive as CI+import           Network.HTTP.Types++formatHeader :: Header -> String+formatHeader header@(name, value) = fromMaybe (show header) (safeToString $ B.concat [CI.original name, ": ", value])++safeToString :: ByteString -> Maybe String+safeToString bs = do+  str <- either (const Nothing) (Just . T.unpack) (T.decodeUtf8' bs)+  let isSafe = not $ case str of+        [] -> True+        _  -> isSpace (last str) || any (not . isPrint) str+  guard isSafe >> return str