snap-testing 0.3.0.0 → 0.4.0.0
raw patch · 2 files changed
+34/−18 lines, 2 files
Files
- snap-testing.cabal +1/−5
- src/Snap/Test/BDD.hs +33/−13
snap-testing.cabal view
@@ -1,10 +1,6 @@--- Initial snap-testing.cabal generated by cabal init. For further--- documentation, see http://haskell.org/cabal/users-guide/- name: snap-testing-version: 0.3.0.0+version: 0.4.0.0 synopsis: A library for BDD-style testing with the Snap Web Framework--- description: homepage: https://github.com/dbp/snap-testing license: BSD3 license-file: LICENSE
src/Snap/Test/BDD.hs view
@@ -6,7 +6,11 @@ SnapTesting , TestRequest , TestLog+ , SnapTestingConfig (..) + -- * Configuration+ , defaultConfig+ -- * Running tests , runSnapTests , consoleReport@@ -47,18 +51,18 @@ , quickCheck ) where +import Prelude hiding (FilePath) import Data.Map (Map, fromList) import Data.ByteString (ByteString, isInfixOf) import Data.Text (Text, pack, unpack)-import qualified Data.Text as T (append)+import qualified Data.Text as T (append, isInfixOf) import Data.Text.Encoding (encodeUtf8) import Data.Monoid (mempty, mconcat) import Data.Maybe (fromMaybe)-import Control.Monad (liftM, zipWithM, void)+import Control.Monad (void, unless) import Control.Monad.Trans import Control.Monad.Trans.State (StateT, evalStateT) import qualified Control.Monad.Trans.State as S (get, put)-import Control.Monad.Trans.Writer (WriterT(..), tell) import Control.Exception (SomeException, catch) import System.Process (system) import Snap.Core (Response(..), getHeader)@@ -82,8 +86,16 @@ type TestRequest = RequestBuilder IO () -- | TestLog is what is streamed to report generators. It is a flatten tree structure.-data TestLog = NameStart Text | NameEnd | TestPass Text | TestFail Text deriving Show+data TestLog = NameStart Text | NameEnd | TestPass Text | TestFail Text | TestError Text deriving Show +data SnapTestingConfig = SnapTestingConfig { reportGenerators :: [InputStream TestLog -> IO ()]+ }++defaultConfig :: SnapTestingConfig+defaultConfig = SnapTestingConfig { reportGenerators = [consoleReport]+ }++ -- | dupN duplicates an input stream N times dupN :: Int -> InputStream a -> IO [InputStream a] dupN 0 s = return []@@ -93,13 +105,14 @@ return (a:rest) -- | Run a set of tests, putting the results through the specified report generators-runSnapTests :: [InputStream TestLog -> IO ()] -- ^ Report generators+runSnapTests :: SnapTestingConfig -- ^ Configuration for test runner -> Handler b b () -- ^ Site that requests are run against (often route routes, where routes are your sites routes). -> SnapletInit b b -- ^ Site initializer -> SnapTesting b () -- ^ Block of tests -> IO ()-runSnapTests rgs site app tests = do+runSnapTests conf site app tests = do (inp, out) <- S.makeChanPipe+ let rgs = reportGenerators conf istreams <- dupN (length rgs) inp consumers <- mapM (\(inp, hndl) -> async (hndl inp)) (zip istreams rgs) evalStateT tests (site, app, out)@@ -122,16 +135,21 @@ printIndent indent putStr (unpack n) cr (indent + indentUnit)- Just (NameEnd) -> cr (indent - indentUnit)- Just (TestPass n) -> do putStr " PASSED"+ Just NameEnd -> cr (indent - indentUnit)+ Just (TestPass _) -> do putStr " PASSED" cr indent- Just (TestFail er) -> do putStr " FAILED"- cr indent+ Just (TestFail _) -> do putStr " FAILED"+ cr indent+ Just (TestError msg) -> do putStr " ERROR("+ putStr (unpack msg)+ putStr ")"+ cr indent indentUnit = 2 printIndent n = putStr (replicate n ' ') --- | Sends the test results to desktop notifications on linux. Prints how many tests passed and failed.+-- | Sends the test results to desktop notifications on linux.+-- Prints how many tests passed and failed. linuxDesktopReport :: InputStream TestLog -> IO () linuxDesktopReport stream = do res <- S.toList stream@@ -149,6 +167,8 @@ in (1 + p, 1 + t) count (TestFail _ : xs) = let (p, t) = count xs in (p, 1 + t)+ count (TestError _ : xs) = let (p, t) = count xs+ in (p, 1 + t) count (_ : xs) = count xs writeRes :: TestLog -> SnapTesting b ()@@ -271,7 +291,7 @@ -> SnapTesting b a eval act = do (_, app, _) <- S.get- liftIO $ fmap (either (error. unpack) id) $ evalHandlerSafe act app+ liftIO $ fmap (either (error . unpack) id) $ evalHandlerSafe act app -- | Given a site to site function (like, generating a random user and logging in), run the given block of test with the modified state.@@ -311,7 +331,7 @@ (site, app, _) <- S.get res <- liftIO $ runHandlerSafe req site app case res of- Left err -> writeRes (TestFail $ T.append "Handler returned an error: " err)+ Left err -> writeRes (TestError err) Right response -> do testlog <- asrt response writeRes testlog