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 Test.Hspec.Util (Path, safeEvaluate)
import Test.Hspec.Core.Type
import Test.Hspec.Config
import Test.Hspec.Formatters
import Test.Hspec.Formatters.Internal
import Test.Hspec.FailureReport
import System.Console.ANSI (hHideCursor, hShowCursor)
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
| configDryRun c = \_ -> return (Right Success)
| otherwise = liftIO . safeEvaluate
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
hspecWith :: Config -> Spec -> IO Summary
hspecWith c_ spec = do
c <- if configReRun c_
then do
readFailureReport c_
else do
return c_
let formatter = configFormatter c
h = configHandle c
useColor <- doesUseColor h c
when useColor (hHideCursor h)
runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) h $ do
runFormatter useColor c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do
failedFormatter formatter
liftIO $ when useColor (hShowCursor h)
footerFormatter formatter
xs <- map failureRecordPath <$> getFailMessages
liftIO $ writeFailureReport (show xs)
Summary <$> getTotalCount <*> getFailCount
where
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)