module Test.Hspec.Runner (
hspec
, hspecResult
, hspecWith
, Summary (..)
, Config (..)
, ColorMode (..)
, Path
, defaultConfig
, configAddFilter
, hspecWithFormatter
) where
import Control.Monad
import Control.Applicative
import Data.Monoid
import Data.Maybe
import System.IO
import System.Environment (getProgName, getArgs, withArgs)
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 Control.Monad.IO.Class (liftIO)
import Test.Hspec.Compat (lookupEnv)
import Test.Hspec.Util (Path, stdGenToInteger)
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.Options (Options(..), ColorMode(..), defaultOptions)
import Test.Hspec.Runner.Tree
import Test.Hspec.Runner.Eval
filterSpecs :: (Path -> Bool) -> [Tree a] -> [Tree a]
filterSpecs p = goSpecs []
where
goSpecs groups = mapMaybe (goSpec groups)
goSpec groups spec = case spec of
Leaf requirement _ -> guard (p (groups, requirement)) >> return spec
Node group specs -> case goSpecs (groups ++ [group]) specs of
[] -> Nothing
xs -> Just (Node group xs)
hspec :: Spec -> IO ()
hspec = hspecWithOptions defaultOptions
hspecWithFormatter :: IsFormatter a => a -> Spec -> IO ()
hspecWithFormatter formatter spec = do
f <- toFormatter formatter
hspecWithOptions defaultOptions {optionsFormatter = f} spec
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
hspecWithOptions :: Options -> Spec -> IO ()
hspecWithOptions opts spec = do
prog <- getProgName
args <- getArgs
c <- getConfig opts prog args
withArgs [] $ do
r <- hspecWith c spec
unless (summaryFailures r == 0) exitFailure
hspecResult :: Spec -> IO Summary
hspecResult = hspecWith defaultConfig
hspecWith :: Config -> Spec -> IO Summary
hspecWith c_ spec_ = withHandle c_ $ \h -> do
c <- ensureStdGen c_
let formatter = configFormatter c
seed = (stdGenToInteger . fst . fromJust . QC.replay . configQuickCheckArgs) c
spec
| configDryRun c = mapSpecItem markSuccess spec_
| otherwise = spec_
useColor <- doesUseColor h c
withHiddenCursor useColor h $
runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do
runFormatter useColor h c formatter (maybe id filterSpecs (configFilterPredicate c) $ (map toTree . runSpecM) spec) `finally_` do
failedFormatter formatter
footerFormatter formatter
xs <- map failureRecordPath <$> getFailMessages
liftIO $ writeFailureReport FailureReport {
failureReportSeed = seed
, failureReportMaxSuccess = QC.maxSuccess (configQuickCheckArgs c)
, failureReportMaxSize = QC.maxSize (configQuickCheckArgs c)
, failureReportMaxDiscardRatio = QC.maxDiscardRatio (configQuickCheckArgs c)
, failureReportPaths = 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 <*> (not <$> isDumb)
ColorNever -> return False
ColorAlways -> return True
withHandle :: Config -> (Handle -> IO a) -> IO a
withHandle c action = case configHandle c of
Left h -> action h
Right path -> withFile path WriteMode action
isDumb :: IO Bool
isDumb = maybe False (== "dumb") <$> lookupEnv "TERM"
markSuccess :: Item () -> Item ()
markSuccess item = item {itemExample = evaluateExample Success}
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)