diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,6 @@ +0.3.2.0 - 2014-11-12 - Add JSON response type, and depend on hspec-2.0 (which deprecates + the hspec2 package). + 0.3.1.0 - 2014-10-27 - Remove broken `afterAll` implementation and depend on hspec2 0.5, which provides a correct implementation. diff --git a/hspec-snap.cabal b/hspec-snap.cabal --- a/hspec-snap.cabal +++ b/hspec-snap.cabal @@ -1,5 +1,5 @@ name: hspec-snap -version: 0.3.1.0 +version: 0.3.2.0 synopsis: A library for testing with Hspec and the Snap Web Framework homepage: https://github.com/dbp/hspec-snap license: BSD3 @@ -22,7 +22,8 @@ , bytestring >= 0.9 && < 0.11 , containers >= 0.4 && < 0.6 , digestive-functors >= 0.7 && < 0.8 - , hspec2 >= 0.5 && < 0.6 + , hspec >= 2.0 && < 2.1 + , hspec-core >= 2.0 && < 2.1 , hxt >= 9.3 && < 9.4 , HandsomeSoup >= 0.3 && < 0.4 , lens >= 3.10 && < 4.5 @@ -38,17 +39,20 @@ hs-source-dirs: spec main-is: Main.hs build-depends: base >= 4.6 && < 4.8 + , aeson >= 0.6 && < 1 , bytestring >= 0.9 && < 0.11 , containers >= 0.4 && < 0.6 , digestive-functors >= 0.7 && < 0.8 - , hspec2 >= 0.5 && < 0.6 + , hspec >= 2.0 && < 2.1 + , hspec-core >= 2.0 && < 2.1 , hxt >= 9.3 && < 9.4 , HandsomeSoup >= 0.3 && < 0.4 , lens >= 3.10 && < 4.5 , mtl >= 2 && < 3 , snap >= 0.13 && < 0.14 , snap-core >= 0.9 && < 0.10 + , snap-extras > 0.4 && < 1 , text >= 0.11 && < 1.2 , transformers >= 0.3 && < 0.5 , directory >= 1.2 && < 1.3 - build-depends: hspec-snap == 0.3.1.0 + build-depends: hspec-snap == 0.3.2.0 diff --git a/spec/Main.hs b/spec/Main.hs --- a/spec/Main.hs +++ b/spec/Main.hs @@ -17,8 +17,13 @@ takeMVar, tryPutMVar, tryTakeMVar) -import Control.Lens +import Control.Lens hiding ((.=)) import Control.Monad (when) +import Data.Aeson (Value(..), (.=) + ,object, decode + ,ToJSON, FromJSON + ,toJSON, parseJSON) +import qualified Data.Aeson as Ae ((.:)) import Data.ByteString (ByteString) import Data.Map (Map) import qualified Data.Map as M @@ -39,6 +44,7 @@ writeBS, writeText) import qualified Snap +import Snap.Extras (writeJSON) import Snap.Snaplet.Session import Snap.Snaplet.Session.Backends.CookieSession import System.Directory (doesFileExist, @@ -81,7 +87,21 @@ testForm = (,) <$> "a" .: check "Should not be empty" (\t -> not $ T.null t) (text Nothing) <*> "b" .: text Nothing +data ExampleObject = ExampleObject Integer Text deriving (Show, Eq) +instance ToJSON ExampleObject where + toJSON (ExampleObject i t) = object [ "aNumber" .= i + , "aString" .= t + ] + +instance FromJSON ExampleObject where + parseJSON (Object o) = ExampleObject <$> o Ae..: "aNumber" <*> + o Ae..: "aString" + parseJSON _ = fail $ "Expected ExampleObject as JSON object" + +exampleObj :: ExampleObject +exampleObj = ExampleObject 42 "foo" + routes :: [(ByteString, Handler App App ())] routes = [("/test", method GET $ writeText html) ,("/test", method POST $ writeText "") @@ -97,6 +117,7 @@ ,("/getsess/:k", do Just k <- fmap T.decodeUtf8 <$> getParam "k" Just r <- with sess $ getFromSession k writeText r) + ,("/json", do writeJSON $ exampleObj) ] app :: MVar (Map Int Foo) -> MVar () -> SnapletInit App App @@ -150,6 +171,11 @@ get "/redirect" >>= should300To "/test" get "/redirect" >>= shouldNot300To "/redirect" get "/test" >>= shouldNot300To "/redirect" + it "differentiates between response content types" $ do + Json raw <- get "/json" + Just exampleObj `shouldEqual` decode raw + Html doc <- get "/test" + doc `shouldEqual` html describe "stateful changes" $ do let isE = use mv >>= \m -> liftIO $ isEmptyMVar m after (\_ -> void $ tryTakeMVar mvar) $ diff --git a/src/Test/Hspec/Snap.hs b/src/Test/Hspec/Snap.hs --- a/src/Test/Hspec/Snap.hs +++ b/src/Test/Hspec/Snap.hs @@ -86,6 +86,8 @@ import qualified Control.Monad.State as S (get, put) import Control.Monad.Trans (liftIO) import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as LBS (ByteString) +import Data.ByteString.Lazy (fromStrict) import qualified Data.Map as M import Data.Maybe (fromJust, fromMaybe, isJust) import Data.Text (Text) @@ -104,7 +106,7 @@ import qualified Snap.Test as Test import Test.Hspec import Test.Hspec (afterAll) -import Test.Hspec.Core +import Test.Hspec.Core.Spec import qualified Text.Digestive as DF import qualified Text.HandsomeSoup as HS import qualified Text.XML.HXT.Core as HXT @@ -112,7 +114,13 @@ -- | The result of making requests against your application. Most -- assertions act against these types (for example, `should200`, -- `shouldHaveSelector`, etc). -data TestResponse = Html Text | NotFound | Redirect Int Text | Other Int | Empty deriving (Show, Eq) +data TestResponse = Html Text + | Json LBS.ByteString + | NotFound + | Redirect Int Text + | Other Int + | Empty + deriving (Show, Eq) -- | The main monad that tests run inside of. This allows both access -- to the application (via requests and `eval`) and to running @@ -492,12 +500,19 @@ case rspStatus response of 404 -> return NotFound 200 -> do - body <- liftIO $ getResponseBody response - return $ Html $ T.decodeUtf8 body + liftIO $ parse200 response _ -> if (rspStatus response) >= 300 && (rspStatus response) < 400 then do let url = fromMaybe "" $ getHeader "Location" response return (Redirect (rspStatus response) (T.decodeUtf8 url)) else return (Other (rspStatus response)) + +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 -- | Runs a request against a given handler (often the whole site), -- with the given state. Returns any triggered exception, or the response.