module Test.Hspec.Runner (
hspec
, hspecWith
, Summary (..)
, Config (..)
, ColorMode (..)
, Path
, defaultConfig
, configAddFilter
) where
import Control.Monad
import Control.Applicative
import Data.Monoid
import Data.Maybe
import System.IO
import System.Environment
import System.Exit
import qualified Control.Exception as E
import System.Console.ANSI (hHideCursor, hShowCursor)
import qualified Test.QuickCheck as QC
import System.Random (newStdGen)
import Test.Hspec.Util
import Test.Hspec.Core.Type
import Test.Hspec.Config
import Test.Hspec.Formatters
import Test.Hspec.Formatters.Internal
import Test.Hspec.FailureReport
import Test.Hspec.Timer
filterSpecs :: (Path -> Bool) -> [SpecTree] -> [SpecTree]
filterSpecs p = goSpecs []
where
goSpecs :: [String] -> [SpecTree] -> [SpecTree]
goSpecs groups = catMaybes . map (goSpec groups)
goSpec :: [String] -> SpecTree -> Maybe SpecTree
goSpec groups spec = case spec of
SpecItem requirement _ -> guard (p (groups, requirement)) >> return spec
SpecGroup group specs -> case goSpecs (groups ++ [group]) specs of
[] -> Nothing
xs -> Just (SpecGroup group xs)
runFormatter :: Bool -> Config -> Formatter -> [SpecTree] -> FormatM ()
runFormatter useColor c formatter specs = headerFormatter formatter >> zip [0..] specs `each` go []
where
each :: [a] -> (a -> FormatM ()) -> FormatM ()
each [] _ = pure ()
each (x:xs) f = do
f x
fails <- getFailCount
unless (configFastFail c && fails /= 0) $ do
xs `each` f
eval :: IO Result -> FormatM (Either E.SomeException Result)
eval
| configDryRun c = \_ -> return (Right Success)
| otherwise = liftIO . safeTry . fmap forceResult
go :: [String] -> (Int, SpecTree) -> FormatM ()
go rGroups (n, SpecGroup group xs) = do
exampleGroupStarted formatter n (reverse rGroups) group
zip [0..] xs `each` go (group : rGroups)
exampleGroupDone formatter
go rGroups (_, SpecItem requirement example) = do
progressHandler <- mkProgressHandler
result <- eval (example $ Params (configQuickCheckArgs c) progressHandler)
case result of
Right Success -> do
increaseSuccessCount
exampleSucceeded formatter path
Right (Pending reason) -> do
increasePendingCount
examplePending formatter path reason
Right (Fail err) -> failed (Right err)
Left e -> failed (Left e)
where
path = (groups, requirement)
groups = reverse rGroups
failed err = do
increaseFailCount
addFailMessage path err
exampleFailed formatter path err
mkProgressHandler
| useColor = do
timer <- liftIO $ newTimer 0.05
return $ \p -> do
f <- timer
when f $ do
exampleProgress formatter (configHandle c) path p
| otherwise = return . const $ return ()
hspec :: Spec -> IO ()
hspec spec = do
c <- getConfig
withArgs [] $ do
r <- hspecWith c spec
unless (summaryFailures r == 0) exitFailure
handleReRun :: Config -> IO Config
handleReRun c = do
if configReRun c
then do
readFailureReport c
else do
return c
ensureStdGen :: Config -> IO Config
ensureStdGen c = case QC.replay qcArgs of
Nothing -> do
stdGen <- newStdGen
return c {configQuickCheckArgs = qcArgs {QC.replay = Just (stdGen, 0)}}
_ -> return c
where
qcArgs = configQuickCheckArgs c
hspecWith :: Config -> Spec -> IO Summary
hspecWith c_ spec = do
c <- handleReRun c_ >>= ensureStdGen
let formatter = configFormatter c
h = configHandle c
seed = (stdGenToInteger . fst . fromJust . QC.replay . configQuickCheckArgs) c
useColor <- doesUseColor h c
withHiddenCursor useColor h $
runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do
runFormatter useColor c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do
failedFormatter formatter
footerFormatter formatter
xs <- map failureRecordPath <$> getFailMessages
liftIO $ writeFailureReport (seed, xs)
Summary <$> getTotalCount <*> getFailCount
where
withHiddenCursor :: Bool -> Handle -> IO a -> IO a
withHiddenCursor useColor h
| useColor = E.bracket_ (hHideCursor h) (hShowCursor h)
| otherwise = id
doesUseColor :: Handle -> Config -> IO Bool
doesUseColor h c = case configColorMode c of
ColorAuto -> hIsTerminalDevice h
ColorNever -> return False
ColorAlway -> return True
data Summary = Summary {
summaryExamples :: Int
, summaryFailures :: Int
} deriving (Eq, Show)
instance Monoid Summary where
mempty = Summary 0 0
(Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2)