hspec-snap 0.3.2.4 → 0.3.2.5
raw patch · 4 files changed
+43/−6 lines, 4 filesdep ~hspec-snapPVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependency ranges changed: hspec-snap
API changes (from Hackage documentation)
+ Test.Hspec.Snap: delete :: Text -> SnapHspecM b TestResponse
+ Test.Hspec.Snap: put :: Text -> Params -> SnapHspecM b TestResponse
+ Test.Hspec.Snap: put' :: Text -> Text -> Params -> SnapHspecM b TestResponse
Files
- CHANGELOG +2/−0
- hspec-snap.cabal +2/−2
- spec/Main.hs +22/−4
- src/Test/Hspec/Snap.hs +17/−0
CHANGELOG view
@@ -1,3 +1,5 @@+0.3.2.5 - 2015-4-22 - Add support for `PUT` and `DELETE`.+ 0.3.2.4 - 2015-4-9 - Loosen lens bound and remove snap-extras dependency. 0.3.2.3 - 2015-2-27 - Loosen hspec bound.
hspec-snap.cabal view
@@ -1,5 +1,5 @@ name: hspec-snap-version: 0.3.2.4+version: 0.3.2.5 synopsis: A library for testing with Hspec and the Snap Web Framework homepage: https://github.com/dbp/hspec-snap license: BSD3@@ -54,4 +54,4 @@ , text >= 0.11 && < 1.3 , transformers >= 0.3 && < 0.5 , directory >= 1.2 && < 1.3- build-depends: hspec-snap == 0.3.2.4+ build-depends: hspec-snap == 0.3.2.5
spec/Main.hs view
@@ -25,6 +25,7 @@ ,toJSON, parseJSON) import qualified Data.Aeson as Ae ((.:)) import Data.ByteString (ByteString)+import qualified Data.ByteString as BS (concat) import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (fromMaybe)@@ -82,7 +83,7 @@ getSessionLens = sess html :: Text-html = "<table><tr><td>One</td><td>Two</td></tr></table>"+html = "<html><table><tr><td>One</td><td>Two</td></tr></table></html>" testForm :: Form Text (Handler App App) (Text, Text) testForm = (,) <$> "a" .: check "Should not be empty" (\t -> not $ T.null t) (text Nothing)@@ -103,11 +104,21 @@ exampleObj :: ExampleObject exampleObj = ExampleObject 42 "foo" +writeParamsAndMethod :: Maybe ByteString -> Snap.Method -> Handler App App ()+writeParamsAndMethod mq m = case m of+ POST -> writeBS $ methodAndParam "POST "+ PUT -> writeBS $ methodAndParam "PUT "+ _ -> writeBS "Not valid"+ where+ methodAndParam p = BS.concat [p, fromMaybe "" mq]+ routes :: [(ByteString, Handler App App ())] routes = [("/test", method GET $ writeText html) ,("/test", method POST $ writeText "")+ ,("/test", method DELETE $ writeText "deleted")+ ,("/test", method PUT $ writeText "") ,("/params", do mq <- getParam "q"- writeBS $ fromMaybe "" mq)+ writeParamsAndMethod mq =<< (Snap.rqMethod <$> Snap.getRequest)) ,("/redirect", Snap.redirect "/test") ,("/setmv", do m <- use mv void $ liftIO $ tryPutMVar m ()@@ -118,7 +129,7 @@ ,("/getsess/:k", do Just k <- fmap T.decodeUtf8 <$> getParam "k" Just r <- with sess $ getFromSession k writeText r)- ,("/json", do writeJSON $ exampleObj)+ ,("/json", writeJSON $ exampleObj) ] app :: MVar (Map Int Foo) -> MVar () -> SnapletInit App App@@ -151,11 +162,18 @@ shouldNotHaveSelector "table td.doesntexist" p get "/redirect" >>= shouldNotHaveSelector "table td.doesntexist" get "/invalid_url" >>= shouldNotHaveSelector "table td.doesntexist"+ it "should have deleted as text on the response" $+ delete "/test" >>= shouldHaveText "deleted" it "should not match <html> on POST request" $ post "/test" M.empty >>= shouldNotHaveText "<html>" it "should post parameters" $ do- post "/params" (params [("q", "hello")]) >>= shouldHaveText "hello"+ post "/params" (params [("q", "hello")]) >>= shouldHaveText "POST hello" post "/params" (params [("r", "hello")]) >>= shouldNotHaveText "hello"+ it "should not match <html> on PUT request" $+ put "/test" M.empty >>= shouldNotHaveText "<html>"+ it "should put parameters" $ do+ put "/params" (params [("q", "hello")]) >>= shouldHaveText "PUT hello"+ put "/params" (params [("r", "hello")]) >>= shouldNotHaveText "hello" it "basic equality" $ do eval (return 1) >>= shouldEqual 1 shouldNotEqual 1 2
src/Test/Hspec/Snap.hs view
@@ -25,9 +25,12 @@ , Factory(..) -- * Requests+ , delete , get , get' , post+ , put+ , put' , params -- * Helpers for dealing with TestResponses@@ -271,6 +274,10 @@ ++ "\n\nSession was:\n" ++ (T.unpack contents)) else setResult Success +-- | Runs a DELETE request+delete :: Text -> SnapHspecM b TestResponse+delete path = runRequest (Test.delete (T.encodeUtf8 path) M.empty)+ -- | Runs a GET request. get :: Text -> SnapHspecM b TestResponse get path = get' path M.empty@@ -287,6 +294,16 @@ -- | Creates a new POST request, with a set of parameters. post :: Text -> Snap.Params -> SnapHspecM b TestResponse post path ps = runRequest (Test.postUrlEncoded (T.encodeUtf8 path) ps)++-- | Creates a new PUT request, with a set of parameters, with a default type of "application/x-www-form-urlencoded"+put :: Text -> Snap.Params -> SnapHspecM b TestResponse+put path params = put' path "application/x-www-form-urlencoded" params++-- | Creates a new PUT request with a configurable MIME/type+put' :: Text -> Text -> Snap.Params -> SnapHspecM b TestResponse+put' path mime params = runRequest $ do+ Test.put (T.encodeUtf8 path) (T.encodeUtf8 mime) ""+ Test.setQueryString params -- | Restricts a response to matches for a given CSS selector. -- Does nothing to non-Html responses.