hspec-snap 0.1.0.0 → 0.2.0.0
raw patch · 3 files changed
+108/−24 lines, 3 filesdep ~hspec-snapPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hspec-snap
API changes (from Hackage documentation)
+ Test.Hspec.Snap: Predicate :: (a -> Bool) -> FormExpectations a
+ Test.Hspec.Snap: afterEval :: Handler b b () -> SpecWith (SnapHspecState b) -> SpecWith (SnapHspecState b)
+ Test.Hspec.Snap: beforeEval :: Handler b b () -> SpecWith (SnapHspecState b) -> SpecWith (SnapHspecState b)
+ Test.Hspec.Snap: modifySite :: (Handler b b () -> Handler b b ()) -> SpecWith (SnapHspecState b) -> SpecWith (SnapHspecState b)
+ Test.Hspec.Snap: modifySite' :: (Handler b b () -> Handler b b ()) -> SnapHspecM b a -> SnapHspecM b a
+ Test.Hspec.Snap: restrictResponse :: Text -> TestResponse -> TestResponse
+ Test.Hspec.Snap: shouldChange :: (Show a, Eq a) => (a -> a) -> (Handler b b a) -> SnapHspecM b c -> SnapHspecM b ()
- Test.Hspec.Snap: shouldHaveSelector :: TestResponse -> Text -> SnapHspecM b ()
+ Test.Hspec.Snap: shouldHaveSelector :: Text -> TestResponse -> SnapHspecM b ()
- Test.Hspec.Snap: shouldHaveText :: TestResponse -> Text -> SnapHspecM b ()
+ Test.Hspec.Snap: shouldHaveText :: Text -> TestResponse -> SnapHspecM b ()
- Test.Hspec.Snap: shouldNotHaveSelector :: TestResponse -> Text -> SnapHspecM b ()
+ Test.Hspec.Snap: shouldNotHaveSelector :: Text -> TestResponse -> SnapHspecM b ()
- Test.Hspec.Snap: shouldNotHaveText :: TestResponse -> Text -> SnapHspecM b ()
+ Test.Hspec.Snap: shouldNotHaveText :: Text -> TestResponse -> SnapHspecM b ()
Files
- hspec-snap.cabal +2/−2
- spec/Main.hs +9/−7
- src/Test/Hspec/Snap.hs +97/−15
hspec-snap.cabal view
@@ -1,5 +1,5 @@ name: hspec-snap-version: 0.1.0.0+version: 0.2.0.0 synopsis: A library for testing with Hspec and the Snap Web Framework homepage: https://github.com/dbp/hspec-snap license: BSD3@@ -47,4 +47,4 @@ , snap-core >= 0.9 && < 0.10 , text >= 0.11 && < 1.2 , transformers >= 0.3 && < 0.4- build-depends: hspec-snap == 0.1.0.0+ build-depends: hspec-snap == 0.2.0.0
spec/Main.hs view
@@ -70,15 +70,15 @@ describe "requests" $ do it "should match selector from a GET request" $ do p <- get "/test"- p `shouldHaveSelector` "table td"- p `shouldNotHaveSelector` "table td.doesntexist"- get "/redirect" >>= flip shouldNotHaveSelector "table td.doesntexist"- get "/invalid_url" >>= flip shouldNotHaveSelector "table td.doesntexist"+ shouldHaveSelector "table td" p+ shouldNotHaveSelector "table td.doesntexist" p+ get "/redirect" >>= shouldNotHaveSelector "table td.doesntexist"+ get "/invalid_url" >>= shouldNotHaveSelector "table td.doesntexist" it "should not match <html> on POST request" $- post "/test" M.empty >>= flip shouldNotHaveText "<html>"+ post "/test" M.empty >>= shouldNotHaveText "<html>" it "should post parameters" $ do- post "/params" (params [("q", "hello")]) >>= flip shouldHaveText "hello"- post "/params" (params [("r", "hello")]) >>= flip shouldNotHaveText "hello"+ post "/params" (params [("q", "hello")]) >>= shouldHaveText "hello"+ post "/params" (params [("r", "hello")]) >>= shouldNotHaveText "hello" it "basic equality" $ do eval (return 1) >>= shouldEqual 1 shouldNotEqual 1 2@@ -114,6 +114,8 @@ form (ErrorPaths ["a"]) testForm (M.fromList [("a", ""), ("b", "bar")]) form (ErrorPaths ["a"]) testForm (M.fromList [("b", "bar")]) form (ErrorPaths ["a"]) testForm (M.fromList [])+ it "should call predicates on valid data" $ do+ form (Predicate (("oo" `T.isInfixOf`) . fst)) testForm (M.fromList [("a", "foobar")]) ----------------------------------------------------------
src/Test/Hspec/Snap.hs view
@@ -8,6 +8,10 @@ module Test.Hspec.Snap ( -- * Running blocks of hspec-snap tests snap+ , modifySite+ , modifySite'+ , afterEval+ , beforeEval -- * Core data types , TestResponse(..)@@ -22,10 +26,14 @@ , post , params + -- * Helpers for dealing with TestResponses+ , restrictResponse+ -- * Evaluating application code , eval -- * Unit test assertions+ , shouldChange , shouldEqual , shouldNotEqual , shouldBeTrue@@ -62,12 +70,13 @@ import Control.Concurrent.MVar (modifyMVar, newEmptyMVar, newMVar, putMVar, 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.ByteString (ByteString) import qualified Data.Map as M-import Data.Maybe (fromMaybe)+import Data.Maybe (fromJust, fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -107,6 +116,11 @@ takeMVar mv -- | Runs a given action once after all the tests in the given block have run.+--+-- __Warning__: Due to current limitations to how Hspec works, this only works+-- if all of the tests within the block are run. This means that+-- if you only run some of the tests (using the @-m@ option) the action will+-- not be run. afterAll :: IO () -> SpecWith a -> SpecWith a afterAll action = go where go spec = do forest <- runIO $ runSpecM spec@@ -136,6 +150,22 @@ -- suite can have multiple calls to `snap`, though each one will cause -- the site initializer to run, which is often a slow operation (and -- will slow down test suites).+--+-- __Warning__: Due to current limitations to how Hspec works, the way+-- that we run cleanup actions (using `afterAll`) from your site initializer depends on /all/+-- of the tests within the block passed to `snap` running. This means that+-- if you only run some of the tests (using the @-m@ option) the cleanup+-- won't happen. But, there is no reason why you can't have many calls to+-- `snap`, so the recommended behavior is to only use @-m@ with queries+-- that will run entire blocks. For example:+--+-- > describe "api-tests" $ snap ...+-- > describe "db-tests" $ snap ...+--+-- And then run with @-m api-tests@ or @-m db-tests@, rather than trying+-- to match anything within. Hopefully, hspec will eventually be able to support+-- what we need in such a way that filtering on any query won't prevent the+-- cleanup from running. snap :: Handler b b () -> SnapletInit b b -> SpecWith (SnapHspecState b) -> Spec snap site app spec = do snapinit <- runIO $ getSnaplet (Just "test") app@@ -145,6 +175,34 @@ afterAll (closeSnaplet initstate) $ before (return (SnapHspecState Success site snaplet initstate)) spec +-- | This allows you to change the default handler you are running+-- requests against within a block. This is most likely useful for+-- setting request state (for example, logging a user in).+modifySite :: (Handler b b () -> Handler b b ())+ -> SpecWith (SnapHspecState b)+ -> SpecWith (SnapHspecState b)+modifySite f = beforeWith (\(SnapHspecState r site snaplet initst) ->+ return (SnapHspecState r (f site) snaplet initst))++-- | This performs a similar operation to `modifySite` but in the context+-- of `SnapHspecM` (which is needed if you need to `eval`, produce values, and+-- hand them somewhere else (so they can't be created within `f`).+modifySite' :: (Handler b b () -> Handler b b ())+ -> SnapHspecM b a+ -> SnapHspecM b a+modifySite' f a = do (SnapHspecState r site s i) <- S.get+ S.put (SnapHspecState r (f site) s i)+ a++-- | Evaluate a Handler action after each test.+afterEval :: Handler b b () -> SpecWith (SnapHspecState b) -> SpecWith (SnapHspecState b)+afterEval h = after (\(SnapHspecState r site s i) -> void $ evalHandlerSafe h s i)++-- | Evaluate a Handler action before each test.+beforeEval :: Handler b b () -> SpecWith (SnapHspecState b) -> SpecWith (SnapHspecState b)+beforeEval h = beforeWith (\state@(SnapHspecState r site s i) -> do void $ evalHandlerSafe h s i+ return state)+ -- | Runs a GET request. get :: Text -> SnapHspecM b TestResponse get path = get' path M.empty@@ -162,6 +220,15 @@ post :: Text -> Snap.Params -> SnapHspecM b TestResponse post path ps = runRequest (Test.postUrlEncoded (T.encodeUtf8 path) ps) +-- | Restricts a response to matches for a given CSS selector.+-- Does nothing to non-Html responses.+restrictResponse :: Text -> TestResponse -> TestResponse+restrictResponse selector (Html 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))+restrictResponse _ r = r+ -- | Runs an arbitrary stateful action from your application. eval :: Handler b b a -> SnapHspecM b a eval act = do (SnapHspecState _ _ app is) <- S.get@@ -176,6 +243,19 @@ Success -> S.put (SnapHspecState r s a i) _ -> return () +-- | Asserts that a given stateful action will produce a specific different result after+-- an action has been run.+shouldChange :: (Show a, Eq a)+ => (a -> a)+ -> (Handler b b a)+ -> SnapHspecM b c+ -> SnapHspecM b ()+shouldChange f v act = do before' <- eval v+ act+ after' <- eval v+ shouldEqual (f before') after'++ -- | Asserts that two values are equal. shouldEqual :: (Show a, Eq a) => a@@ -252,41 +332,41 @@ shouldNot300To _ _ = setResult Success -- | Assert that a response (which should be Html) has a given selector.-shouldHaveSelector :: TestResponse -> Text -> SnapHspecM b ()-shouldHaveSelector r@(Html body) selector =- setResult $ if haveSelector' r selector+shouldHaveSelector :: Text -> TestResponse -> SnapHspecM b ()+shouldHaveSelector selector r@(Html body) =+ setResult $ if haveSelector' selector r then Success else (Fail 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 (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 :: TestResponse -> Text -> SnapHspecM b ()-shouldNotHaveSelector r@(Html body) selector =- setResult $ if haveSelector' r selector+shouldNotHaveSelector :: Text -> TestResponse -> SnapHspecM b ()+shouldNotHaveSelector selector r@(Html body) =+ setResult $ if haveSelector' selector r then (Fail msg) else Success where msg = (T.unpack $ T.concat ["Html should not have contained selector: ", selector, "\n\n", body]) shouldNotHaveSelector _ _ = setResult Success -haveSelector' :: TestResponse -> Text -> Bool-haveSelector' (Html body) selector =+haveSelector' :: Text -> TestResponse -> Bool+haveSelector' selector (Html body) = case HXT.runLA (HXT.hread HXT.>>> HS.css (T.unpack selector)) (T.unpack body) of [] -> False _ -> True haveSelector' _ _ = False -- | Asserts that the response (which should be Html) contains the given text.-shouldHaveText :: TestResponse -> Text -> SnapHspecM b ()-shouldHaveText (Html body) match =+shouldHaveText :: Text -> TestResponse -> SnapHspecM b ()+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]))+shouldHaveText match _ = setResult (Fail (T.unpack $ T.concat ["Body contains: ", match])) -- | Asserts that the response (which should be Html) does not contain the given text.-shouldNotHaveText :: TestResponse -> Text -> SnapHspecM b ()-shouldNotHaveText (Html body) match =+shouldNotHaveText :: Text -> TestResponse -> SnapHspecM b ()+shouldNotHaveText match (Html body) = if T.isInfixOf match body then setResult (Fail $ T.unpack $ T.concat [body, "' contains '", match, "'."]) else setResult Success@@ -295,6 +375,7 @@ -- | A data type for tests against forms. data FormExpectations a = Value a -- ^ The value the form should take (and should be valid)+ | Predicate (a -> Bool) | ErrorPaths [Text] -- ^ The error paths that should be populated -- | Tests against digestive-functors forms.@@ -308,6 +389,7 @@ do r <- eval $ DF.postForm "form" theForm (const $ return lookupParam) case expected of Value a -> shouldEqual (snd r) (Just a)+ Predicate f -> shouldBeTrue (isJust (snd r) && f (fromJust (snd r))) ErrorPaths expectedPaths -> do let viewErrorPaths = map (DF.fromPath . fst) $ DF.viewErrors $ fst r shouldBeTrue (all (`elem` viewErrorPaths) expectedPaths