hspec-core (empty) → 2.0.0

raw patch · 34 files changed

+3439/−0 lines, 34 filesdep +HUnitdep +QuickCheckdep +ansi-terminalsetup-changed

Dependencies added: HUnit, QuickCheck, ansi-terminal, async, base, deepseq, ghc-paths, hspec-expectations, hspec-meta, process, quickcheck-io, random, setenv, silently, tf-random, time, transformers

Files

• LICENSE +21/−0
• Setup.lhs +3/−0
• hspec-core.cabal +106/−0
• src/Test/Hspec/Compat.hs +83/−0
• src/Test/Hspec/Config.hs +82/−0
• src/Test/Hspec/Core/Example.hs +121/−0
• src/Test/Hspec/Core/Formatters.hs +216/−0
• src/Test/Hspec/Core/Formatters/Internal.hs +262/−0
• src/Test/Hspec/Core/Hooks.hs +74/−0
• src/Test/Hspec/Core/QuickCheck.hs +37/−0
• src/Test/Hspec/Core/QuickCheckUtil.hs +60/−0
• src/Test/Hspec/Core/Runner.hs +174/−0
• src/Test/Hspec/Core/Runner/Eval.hs +157/−0
• src/Test/Hspec/Core/Spec.hs +70/−0
• src/Test/Hspec/Core/Spec/Monad.hs +65/−0
• src/Test/Hspec/Core/Tree.hs +103/−0
• src/Test/Hspec/Core/Util.hs +132/−0
• src/Test/Hspec/FailureReport.hs +36/−0
• src/Test/Hspec/Options.hs +178/−0
• src/Test/Hspec/Timer.hs +14/−0
• test/Helper.hs +89/−0
• test/Mock.hs +15/−0
• test/Spec.hs +1/−0
• test/Test/Hspec/CompatSpec.hs +33/−0
• test/Test/Hspec/Core/ExampleSpec.hs +136/−0
• test/Test/Hspec/Core/FormattersSpec.hs +227/−0
• test/Test/Hspec/Core/HooksSpec.hs +230/−0
• test/Test/Hspec/Core/QuickCheckUtilSpec.hs +31/−0
• test/Test/Hspec/Core/RunnerSpec.hs +399/−0
• test/Test/Hspec/Core/SpecSpec.hs +69/−0
• test/Test/Hspec/Core/UtilSpec.hs +103/−0
• test/Test/Hspec/FailureReportSpec.hs +39/−0
• test/Test/Hspec/OptionsSpec.hs +44/−0
• test/Test/Hspec/TimerSpec.hs +29/−0

@@ -0,0 +1,21 @@+Copyright (c) 2011-2014 Simon Hengel <sol@typeful.net>+Copyright (c) 2011-2012 Trystan Spangler <trystan.s@comcast.net>+Copyright (c) 2011-2011 Greg Weber <greg@gregweber.info>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,106 @@+name:             hspec-core+version:          2.0.0+license:          MIT+license-file:     LICENSE+copyright:        (c) 2011-2014 Simon Hengel,+                  (c) 2011-2012 Trystan Spangler,+                  (c) 2011 Greg Weber+maintainer:       Simon Hengel <sol@typeful.net>+build-type:       Simple+cabal-version:    >= 1.10+category:         Testing+stability:        experimental+bug-reports:      https://github.com/hspec/hspec/issues+homepage:         http://hspec.github.io/+synopsis:         A Testing Framework for Haskell+description:      This package exposes internal types and functions that can be+                  used to extend Hspec's functionality.++source-repository head+  type: git+  location: https://github.com/hspec/hspec+  subdir: hspec-core++library+  ghc-options:+      -Wall+  hs-source-dirs:+      src+  build-depends:+      base >= 4.3 && < 5+    , random+    , tf-random+    , setenv+    , ansi-terminal >= 0.5+    , time+    , transformers >= 0.2.2.0+    , deepseq+    , HUnit >= 1.2.5+    , QuickCheck >= 2.5.1+    , quickcheck-io+    , hspec-expectations+    , async >= 2+  exposed-modules:+      Test.Hspec.Core.Spec+      Test.Hspec.Core.Hooks+      Test.Hspec.Core.Runner+      Test.Hspec.Core.Formatters+      Test.Hspec.Core.QuickCheck+      Test.Hspec.Core.Util+  other-modules:+      Test.Hspec.Compat+      Test.Hspec.Core.Example+      Test.Hspec.Core.Tree+      Test.Hspec.Core.Spec.Monad+      Test.Hspec.Core.QuickCheckUtil+      Test.Hspec.Config+      Test.Hspec.Options+      Test.Hspec.FailureReport+      Test.Hspec.Core.Runner.Eval+      Test.Hspec.Core.Formatters.Internal+      Test.Hspec.Timer+  default-language: Haskell2010++test-suite spec+  type:+      exitcode-stdio-1.0+  hs-source-dirs:+      src, test+  main-is:+      Spec.hs+  other-modules:+      Helper+      Mock+      Test.Hspec.CompatSpec+      Test.Hspec.Core.ExampleSpec+      Test.Hspec.Core.FormattersSpec+      Test.Hspec.Core.HooksSpec+      Test.Hspec.Core.QuickCheckUtilSpec+      Test.Hspec.Core.RunnerSpec+      Test.Hspec.Core.SpecSpec+      Test.Hspec.Core.UtilSpec+      Test.Hspec.FailureReportSpec+      Test.Hspec.OptionsSpec+      Test.Hspec.TimerSpec+  ghc-options:+      -Wall+  build-depends:+      base == 4.*+    , random+    , tf-random+    , setenv+    , ansi-terminal+    , time+    , transformers+    , deepseq+    , HUnit+    , QuickCheck+    , quickcheck-io+    , hspec-expectations+    , async++    , hspec-meta >= 1.12+    , silently >= 1.2.4+    , process+    , ghc-paths+  default-language: Haskell2010

@@ -0,0 +1,83 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Compat (+  showType+, showFullType+, readMaybe+, lookupEnv+, module Data.IORef+#if !MIN_VERSION_base(4,6,0)+, modifyIORef'+#endif+) where++#if !MIN_VERSION_base(4,3,0)+import           Control.Monad.Trans.Error () -- for Monad (Either e)+#endif++import           Data.Typeable (Typeable, typeOf, typeRepTyCon)+import           Text.Read+import           Data.IORef+import           System.Environment++#if MIN_VERSION_base(4,4,0)+import           Data.Typeable.Internal (tyConModule, tyConName)+#endif++#if !MIN_VERSION_base(4,6,0)+import qualified Text.ParserCombinators.ReadP as P+#endif++#if !MIN_VERSION_base(4,6,0)+-- |Strict version of 'modifyIORef'+modifyIORef' :: IORef a -> (a -> a) -> IO ()+modifyIORef' ref f = do+    x <- readIORef ref+    let x' = f x+    x' `seq` writeIORef ref x'++-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+-- A 'Left' value indicates a parse error.+readEither :: Read a => String -> Either String a+readEither s =+  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of+    [x] -> Right x+    []  -> Left "Prelude.read: no parse"+    _   -> Left "Prelude.read: ambiguous parse"+ where+  read' =+    do x <- readPrec+       lift P.skipSpaces+       return x++-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+readMaybe :: Read a => String -> Maybe a+readMaybe s = case readEither s of+                Left _  -> Nothing+                Right a -> Just a++-- | Return the value of the environment variable @var@, or @Nothing@ if+-- there is no such value.+--+-- For POSIX users, this is equivalent to 'System.Posix.Env.getEnv'.+lookupEnv :: String -> IO (Maybe String)+lookupEnv k = lookup k `fmap` getEnvironment+#endif++showType :: Typeable a => a -> String+showType a = let t = typeRepTyCon (typeOf a) in+#if MIN_VERSION_base(4,4,0)+  show t+#else+  (reverse . takeWhile (/= '.') . reverse . show) t+#endif+++showFullType :: Typeable a => a -> String+showFullType a = let t = typeRepTyCon (typeOf a) in+#if MIN_VERSION_base(4,4,0)+  tyConModule t ++ "." ++ tyConName t+#else+  show t+#endif

@@ -0,0 +1,82 @@+module Test.Hspec.Config (+  Config (..)+, ColorMode(..)+, defaultConfig+, getConfig+, configAddFilter+, configQuickCheckArgs+) where++import           Control.Applicative+import           System.IO+import           System.Exit+import qualified Test.QuickCheck as QC++import           Test.Hspec.Core.Util+import           Test.Hspec.Options+import           Test.Hspec.FailureReport+import           Test.Hspec.Core.QuickCheckUtil (mkGen)++-- | Add a filter predicate to config.  If there is already a filter predicate,+-- then combine them with `||`.+configAddFilter :: (Path -> Bool) -> Config -> Config+configAddFilter p1 c = c {+    configFilterPredicate = Just p1 `filterOr` configFilterPredicate c+  }++mkConfig :: Maybe FailureReport -> Config -> Config+mkConfig mFailureReport opts = opts {+    configFilterPredicate = matchFilter `filterOr` rerunFilter+  , configQuickCheckSeed = mSeed+  , configQuickCheckMaxSuccess = mMaxSuccess+  , configQuickCheckMaxDiscardRatio = mMaxDiscardRatio+  , configQuickCheckMaxSize = mMaxSize+  }+  where++    mSeed = configQuickCheckSeed opts <|> (failureReportSeed <$> mFailureReport)+    mMaxSuccess = configQuickCheckMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport)+    mMaxSize = configQuickCheckMaxSize opts <|> (failureReportMaxSize <$> mFailureReport)+    mMaxDiscardRatio = configQuickCheckMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport)++    matchFilter = configFilterPredicate opts++    rerunFilter = flip elem . failureReportPaths <$> mFailureReport++configQuickCheckArgs :: Config -> QC.Args+configQuickCheckArgs c = qcArgs+  where+    qcArgs = (+        maybe id setSeed (configQuickCheckSeed c)+      . maybe id setMaxDiscardRatio (configQuickCheckMaxDiscardRatio c)+      . maybe id setMaxSize (configQuickCheckMaxSize c)+      . maybe id setMaxSuccess (configQuickCheckMaxSuccess c)) QC.stdArgs++    setMaxSuccess :: Int -> QC.Args -> QC.Args+    setMaxSuccess n args = args {QC.maxSuccess = n}++    setMaxSize :: Int -> QC.Args -> QC.Args+    setMaxSize n args = args {QC.maxSize = n}++    setMaxDiscardRatio :: Int -> QC.Args -> QC.Args+    setMaxDiscardRatio n args = args {QC.maxDiscardRatio = n}++    setSeed :: Integer -> QC.Args -> QC.Args+    setSeed n args = args {QC.replay = Just (mkGen (fromIntegral n), 0)}++getConfig :: Config -> String -> [String] -> IO Config+getConfig opts_ prog args = do+  case parseOptions opts_ prog args of+    Left (err, msg) -> exitWithMessage err msg+    Right opts -> do+      r <- if configRerun opts then readFailureReport else return Nothing+      return (mkConfig r opts)++exitWithMessage :: ExitCode -> String -> IO a+exitWithMessage err msg = do+  hPutStr h msg+  exitWith err+  where+    h = case err of+      ExitSuccess -> stdout+      _           -> stderr

@@ -0,0 +1,121 @@+{-# LANGUAGE CPP, TypeFamilies, FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-}+module Test.Hspec.Core.Example (+  Example (..)+, Params (..)+, ActionWith+, Progress+, ProgressCallback+, Result (..)+) where++import           Data.Maybe (fromMaybe)+import           Data.List (isPrefixOf)+import           Test.HUnit.Lang (HUnitFailure(..))+import qualified Control.Exception as E+import           Data.Typeable (Typeable)+import qualified Test.QuickCheck as QC+import           Test.Hspec.Expectations (Expectation)++import qualified Test.QuickCheck.State as QC+import qualified Test.QuickCheck.Property as QCP+import qualified Test.QuickCheck.IO ()++import           Test.Hspec.Core.QuickCheckUtil+import           Test.Hspec.Core.Util+import           Test.Hspec.Compat++-- | A type class for examples+class Example e where+  type Arg e+#if __GLASGOW_HASKELL__ >= 704+  type Arg e = ()+#endif+  evaluateExample :: e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result++data Params = Params {+  paramsQuickCheckArgs  :: QC.Args+, paramsSmallCheckDepth :: Int+} deriving (Show)++type Progress = (Int, Int)+type ProgressCallback = Progress -> IO ()++-- | An `IO` action that expects an argument of type @a@+type ActionWith a = a -> IO ()++-- | The result of running an example+data Result = Success | Pending (Maybe String) | Fail String+  deriving (Eq, Show, Read, Typeable)++instance E.Exception Result++instance Example Bool where+  type Arg Bool = ()+  evaluateExample b _ _ _ = if b then return Success else return (Fail "")++instance Example Expectation where+  type Arg Expectation = ()+  evaluateExample e = evaluateExample (\() -> e)++instance Example (a -> Expectation) where+  type Arg (a -> Expectation) = a+  evaluateExample e _ action _ = (action e >> return Success) `E.catches` [+      E.Handler (\(HUnitFailure err) -> return (Fail err))+    , E.Handler (return :: Result -> IO Result)+    ]++instance Example Result where+  type Arg Result = ()+  evaluateExample r _ _ _ = return r++instance Example QC.Property where+  type Arg QC.Property = ()+  evaluateExample e = evaluateExample (\() -> e)++instance Example (a -> QC.Property) where+  type Arg (a -> QC.Property) = a+  evaluateExample p c action progressCallback = do+    r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty action p)+    return $+      case r of+        QC.Success {}               -> Success+        QC.Failure {QC.output = m}  -> fromMaybe (Fail $ sanitizeFailureMessage r) (parsePending m)+        QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ pluralize n "test" )+        QC.NoExpectedFailure {}     -> Fail ("No expected failure")+    where+      qcProgressCallback = QCP.PostTest QCP.NotCounterexample $+        \st _ -> progressCallback (QC.numSuccessTests st, QC.maxSuccessTests st)++      sanitizeFailureMessage :: QC.Result -> String+      sanitizeFailureMessage r = let m = QC.output r in strip $+#if MIN_VERSION_QuickCheck(2,7,0)+        case QC.theException r of+          Just e -> let numbers = formatNumbers r in+            "uncaught exception: " ++ formatException e ++ " " ++ numbers ++ "\n" ++ case lines m of+              x:xs | x == (exceptionPrefix ++ show e ++ "' " ++ numbers ++ ": ") -> unlines xs+              _ -> m+          Nothing ->+#endif+            (addFalsifiable . stripFailed) m++      addFalsifiable :: String -> String+      addFalsifiable m+        | "(after " `isPrefixOf` m = "Falsifiable " ++ m+        | otherwise = m++      stripFailed :: String -> String+      stripFailed m+        | prefix `isPrefixOf` m = drop n m+        | otherwise = m+        where+          prefix = "*** Failed! "+          n = length prefix++      parsePending :: String -> Maybe Result+      parsePending m+        | exceptionPrefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m+        | otherwise = Nothing+        where+          n = length exceptionPrefix++      exceptionPrefix = "*** Failed! Exception: '"

@@ -0,0 +1,216 @@+-- |+-- Stability: experimental+--+-- This module contains formatters that can be used with+-- `Test.Hspec.Runner.hspecWith`.+module Test.Hspec.Core.Formatters (++-- * Formatters+  silent+, specdoc+, progress+, failed_examples++-- * Implementing a custom Formatter+-- |+-- A formatter is a set of actions.  Each action is evaluated when a certain+-- situation is encountered during a test run.+--+-- Actions live in the `FormatM` monad.  It provides access to the runner state+-- and primitives for appending to the generated report.+, Formatter (..)+, FormatM++-- ** Accessing the runner state+, getSuccessCount+, getPendingCount+, getFailCount+, getTotalCount++, FailureRecord (..)+, getFailMessages+, usedSeed++, getCPUTime+, getRealTime++-- ** Appending to the gerenated report+, write+, writeLine+, newParagraph++-- ** Dealing with colors+, withInfoColor+, withSuccessColor+, withPendingColor+, withFailColor++-- ** Helpers+, formatException+) where++import           Data.Maybe+import           Test.Hspec.Core.Util+import           Test.Hspec.Core.Spec (Location(..), LocationAccuracy(..))+import           Text.Printf+import           Control.Monad (when, unless)+import           Data.Foldable (forM_)+import           Control.Applicative+import           System.IO (hPutStr, hFlush)++-- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make+-- sure, that we only use the public API to implement formatters.+--+-- Everything imported here has to be re-exported, so that users can implement+-- their own formatters.+import Test.Hspec.Core.Formatters.Internal (+    Formatter (..)+  , FormatM++  , getSuccessCount+  , getPendingCount+  , getFailCount+  , getTotalCount++  , FailureRecord (..)+  , getFailMessages+  , usedSeed++  , getCPUTime+  , getRealTime++  , write+  , writeLine+  , newParagraph++  , withInfoColor+  , withSuccessColor+  , withPendingColor+  , withFailColor+  )++silent :: Formatter+silent = Formatter {+  headerFormatter     = return ()+, exampleGroupStarted = \_ _ -> return ()+, exampleGroupDone    = return ()+, exampleProgress     = \_ _ _ -> return ()+, exampleSucceeded    = \_ -> return ()+, exampleFailed       = \_ _ -> return ()+, examplePending      = \_ _  -> return ()+, failedFormatter     = return ()+, footerFormatter     = return ()+}+++specdoc :: Formatter+specdoc = silent {++  headerFormatter = do+    writeLine ""++, exampleGroupStarted = \nesting name -> do+    writeLine (indentationFor nesting ++ name)++, exampleProgress = \h _ p -> do+    hPutStr h (formatProgress p)+    hFlush h++, exampleSucceeded = \(nesting, requirement) -> withSuccessColor $ do+    writeLine $ indentationFor nesting ++ requirement++, exampleFailed = \(nesting, requirement) _ -> withFailColor $ do+    n <- getFailCount+    writeLine $ indentationFor nesting ++ requirement ++ " FAILED [" ++ show n ++ "]"++, examplePending = \(nesting, requirement) reason -> withPendingColor $ do+    writeLine $ indentationFor nesting ++ requirement ++ "\n     # PENDING: " ++ fromMaybe "No reason given" reason++, failedFormatter = defaultFailedFormatter++, footerFormatter = defaultFooter+} where+    indentationFor nesting = replicate (length nesting * 2) ' '+    formatProgress (current, total)+      | total == 0 = show current ++ "\r"+      | otherwise  = show current ++ "/" ++ show total ++ "\r"+++progress :: Formatter+progress = silent {+  exampleSucceeded = \_   -> withSuccessColor $ write "."+, exampleFailed    = \_ _ -> withFailColor    $ write "F"+, examplePending   = \_ _ -> withPendingColor $ write "."+, failedFormatter  = defaultFailedFormatter+, footerFormatter  = defaultFooter+}+++failed_examples :: Formatter+failed_examples   = silent {+  failedFormatter = defaultFailedFormatter+, footerFormatter = defaultFooter+}++defaultFailedFormatter :: FormatM ()+defaultFailedFormatter = do+  writeLine ""++  failures <- getFailMessages++  forM_ (zip [1..] failures) $ \x -> do+    formatFailure x+    writeLine ""++  when (hasBestEffortLocations failures) $ do+    withInfoColor $ writeLine "Source locations marked with \"best-effort\" are calculated heuristically and may be incorrect."+    writeLine ""++  unless (null failures) $ do+    write "Randomized with seed " >> usedSeed >>= writeLine . show+    writeLine ""+  where+    hasBestEffortLocations :: [FailureRecord] -> Bool+    hasBestEffortLocations = any p+      where+        p :: FailureRecord -> Bool+        p failure = (locationAccuracy <$> failureRecordLocation failure) == Just BestEffort++    formatFailure :: (Int, FailureRecord) -> FormatM ()+    formatFailure (n, FailureRecord mLoc path reason) = do+      write (show n ++ ") ")+      writeLine (formatRequirement path)+      withFailColor $ do+        unless (null err) $ do+          writeLine err+      forM_ mLoc $ \loc -> do+        writeLine ""+        withInfoColor $ writeLine (formatLoc loc)+      where+        err = either (("uncaught exception: " ++) . formatException) id reason+        formatLoc (Location file line _column accuracy) = "# " ++ file ++ ":" ++ show line ++ bestEffortMarking+          where+            bestEffortMarking = case accuracy of+              ExactLocation -> ""+              BestEffort -> " (best-effort)"++defaultFooter :: FormatM ()+defaultFooter = do++  writeLine =<< (++)+    <$> (printf "Finished in %1.4f seconds"+    <$> getRealTime) <*> (maybe "" (printf ", used %1.4f seconds of CPU time") <$> getCPUTime)++  fails   <- getFailCount+  pending <- getPendingCount+  total   <- getTotalCount++  let c | fails /= 0   = withFailColor+        | pending /= 0 = withPendingColor+        | otherwise    = withSuccessColor+  c $ do+    write $ pluralize total   "example"+    write (", " ++ pluralize fails "failure")+    unless (pending == 0) $+      write (", " ++ show pending ++ " pending")+  writeLine ""

@@ -0,0 +1,262 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Test.Hspec.Core.Formatters.Internal (++-- * Public API+  Formatter (..)+, FormatM++, getSuccessCount+, getPendingCount+, getFailCount+, getTotalCount++, FailureRecord (..)+, getFailMessages+, usedSeed++, getCPUTime+, getRealTime++, write+, writeLine+, newParagraph++, withInfoColor+, withSuccessColor+, withPendingColor+, withFailColor++-- * Functions for internal use+, runFormatM+, increaseSuccessCount+, increasePendingCount+, increaseFailCount+, addFailMessage+, finally_+) where++import qualified System.IO as IO+import           System.IO (Handle)+import           Control.Monad+import           Control.Applicative+import           Control.Exception (SomeException, AsyncException(..), bracket_, try, throwIO)+import           System.Console.ANSI+import           Control.Monad.Trans.State hiding (gets, modify)+import           Control.Monad.IO.Class+import qualified System.CPUTime as CPUTime+import           Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)++import           Test.Hspec.Core.Util (Path)+import           Test.Hspec.Compat+import           Test.Hspec.Core.Spec (Progress, Location)++-- | A lifted version of `Control.Monad.Trans.State.gets`+gets :: (FormatterState -> a) -> FormatM a+gets f = FormatM $ do+  f <$> (get >>= liftIO . readIORef)++-- | A lifted version of `Control.Monad.Trans.State.modify`+modify :: (FormatterState -> FormatterState) -> FormatM ()+modify f = FormatM $ do+  get >>= liftIO . (`modifyIORef'` f)++data FormatterState = FormatterState {+  stateHandle     :: Handle+, stateUseColor   :: Bool+, produceHTML     :: Bool+, successCount    :: Int+, pendingCount    :: Int+, failCount       :: Int+, failMessages    :: [FailureRecord]+, stateUsedSeed   :: Integer+, cpuStartTime    :: Maybe Integer+, startTime       :: POSIXTime+}++-- | The random seed that is used for QuickCheck.+usedSeed :: FormatM Integer+usedSeed = gets stateUsedSeed++-- | The total number of examples encountered so far.+totalCount :: FormatterState -> Int+totalCount s = successCount s + pendingCount s + failCount s++-- NOTE: We use an IORef here, so that the state persists when UserInterrupt is+-- thrown.+newtype FormatM a = FormatM (StateT (IORef FormatterState) IO a)+  deriving (Functor, Applicative, Monad, MonadIO)++runFormatM :: Bool -> Bool -> Bool -> Integer -> Handle -> FormatM a -> IO a+runFormatM useColor produceHTML_ printCpuTime seed handle (FormatM action) = do+  time <- getPOSIXTime+  cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing+  st <- newIORef (FormatterState handle useColor produceHTML_ 0 0 0 [] seed cpuTime time)+  evalStateT action st++-- | Increase the counter for successful examples+increaseSuccessCount :: FormatM ()+increaseSuccessCount = modify $ \s -> s {successCount = succ $ successCount s}++-- | Increase the counter for pending examples+increasePendingCount :: FormatM ()+increasePendingCount = modify $ \s -> s {pendingCount = succ $ pendingCount s}++-- | Increase the counter for failed examples+increaseFailCount :: FormatM ()+increaseFailCount = modify $ \s -> s {failCount = succ $ failCount s}++-- | Get the number of successful examples encountered so far.+getSuccessCount :: FormatM Int+getSuccessCount = gets successCount++-- | Get the number of pending examples encountered so far.+getPendingCount :: FormatM Int+getPendingCount = gets pendingCount++-- | Get the number of failed examples encountered so far.+getFailCount :: FormatM Int+getFailCount = gets failCount++-- | Get the total number of examples encountered so far.+getTotalCount :: FormatM Int+getTotalCount = gets totalCount++-- | Append to the list of accumulated failure messages.+addFailMessage :: Maybe Location -> Path -> Either SomeException String -> FormatM ()+addFailMessage loc p m = modify $ \s -> s {failMessages = FailureRecord loc p m : failMessages s}++-- | Get the list of accumulated failure messages.+getFailMessages :: FormatM [FailureRecord]+getFailMessages = reverse `fmap` gets failMessages++data FailureRecord = FailureRecord {+  failureRecordLocation :: Maybe Location+, failureRecordPath     :: Path+, failureRecordMessage  :: Either SomeException String+}++data Formatter = Formatter {++  headerFormatter :: FormatM ()++-- | evaluated before each test group+--+-- The given number indicates the position within the parent group.+, exampleGroupStarted :: [String] -> String -> FormatM ()++, exampleGroupDone    :: FormatM ()++-- | used to notify the progress of the currently evaluated example+--+-- /Note/: This is only called when interactive/color mode.+, exampleProgress     :: Handle -> Path -> Progress -> IO ()++-- | evaluated after each successful example+, exampleSucceeded    :: Path -> FormatM ()++-- | evaluated after each failed example+, exampleFailed       :: Path -> Either SomeException String -> FormatM ()++-- | evaluated after each pending example+, examplePending      :: Path -> Maybe String -> FormatM ()++-- | evaluated after a test run+, failedFormatter     :: FormatM ()++-- | evaluated after `failuresFormatter`+, footerFormatter     :: FormatM ()+}+++-- | Append an empty line to the report.+--+-- Calling this multiple times has the same effect as calling it once.+newParagraph :: FormatM ()+newParagraph = writeLine ""+{-# DEPRECATED newParagraph "use @writeLine \"\"@ instead" #-}++-- | Append some output to the report.+write :: String -> FormatM ()+write s = do+  h <- gets stateHandle+  liftIO $ IO.hPutStr h s++-- | The same as `write`, but adds a newline character.+writeLine :: String -> FormatM ()+writeLine s = write s >> write "\n"++-- | Set output color to red, run given action, and finally restore the default+-- color.+withFailColor :: FormatM a -> FormatM a+withFailColor = withColor (SetColor Foreground Dull Red) "hspec-failure"++-- | Set output color to green, run given action, and finally restore the+-- default color.+withSuccessColor :: FormatM a -> FormatM a+withSuccessColor = withColor (SetColor Foreground Dull Green) "hspec-success"++-- | Set output color to yellow, run given action, and finally restore the+-- default color.+withPendingColor :: FormatM a -> FormatM a+withPendingColor = withColor (SetColor Foreground Dull Yellow) "hspec-pending"++-- | Set output color to cyan, run given action, and finally restore the+-- default color.+withInfoColor :: FormatM a -> FormatM a+withInfoColor = withColor (SetColor Foreground Dull Cyan) "hspec-info"++-- | Set a color, run an action, and finally reset colors.+withColor :: SGR -> String -> FormatM a -> FormatM a+withColor color cls action = do+  r <- gets produceHTML+  (if r then htmlSpan cls else withColor_ color) action++htmlSpan :: String -> FormatM a -> FormatM a+htmlSpan cls action = write ("<span class=\"" ++ cls ++ "\">") *> action <* write "</span>"++withColor_ :: SGR -> FormatM a -> FormatM a+withColor_ color (FormatM action) = do+  useColor <- gets stateUseColor+  h        <- gets stateHandle++  FormatM . StateT $ \st -> do+    bracket_++      -- set color+      (when useColor $ hSetSGR h [color])++      -- reset colors+      (when useColor $ hSetSGR h [Reset])++      -- run action+      (runStateT action st)++-- |+-- @finally_ actionA actionB@ runs @actionA@ and then @actionB@.  @actionB@ is+-- run even when a `UserInterrupt` occurs during @actionA@.+finally_ :: FormatM () -> FormatM () -> FormatM ()+finally_ (FormatM actionA) (FormatM actionB) = FormatM . StateT $ \st -> do+  r <- try (execStateT actionA st)+  case r of+    Left e -> do+      when (e == UserInterrupt) $+        runStateT actionB st >> return ()+      throwIO e+    Right st_ -> do+      runStateT actionB st_++-- | Get the used CPU time since the test run has been started.+getCPUTime :: FormatM (Maybe Double)+getCPUTime = do+  t1  <- liftIO CPUTime.getCPUTime+  mt0 <- gets cpuStartTime+  return $ toSeconds <$> ((-) <$> pure t1 <*> mt0)+  where+    toSeconds x = fromIntegral x / (10.0 ^ (12 :: Integer))++-- | Get the passed real time since the test run has been started.+getRealTime :: FormatM Double+getRealTime = do+  t1 <- liftIO getPOSIXTime+  t0 <- gets startTime+  return (realToFrac $ t1 - t0)

@@ -0,0 +1,74 @@+-- | Stability: provisional+module Test.Hspec.Core.Hooks (+  before+, beforeWith+, beforeAll+, after+, after_+, afterAll+, afterAll_+, around+, around_+, aroundWith+) where++import           Control.Exception (finally)+import           Control.Concurrent.MVar++import           Test.Hspec.Core.Spec++-- | Run a custom action before every spec item.+before :: IO a -> SpecWith a -> Spec+before action = around (action >>=)++-- | Run a custom action before every spec item.+beforeWith :: (b -> IO a) -> SpecWith a -> SpecWith b+beforeWith action = aroundWith $ \e x -> action x >>= e++-- | Run a custom action before the first spec item.+beforeAll :: IO a -> SpecWith a -> Spec+beforeAll action spec = do+  mvar <- runIO (newMVar Nothing)+  let action_ = memoize mvar action+  before action_ spec++memoize :: MVar (Maybe a) -> IO a -> IO a+memoize mvar action = modifyMVar mvar $ \ma -> case ma of+  Just a -> return (ma, a)+  Nothing -> do+    a <- action+    return (Just a, a)++-- | Run a custom action after every spec item.+after :: ActionWith a -> SpecWith a -> SpecWith a+after action = aroundWith $ \e x -> e x `finally` action x++-- | Run a custom action after every spec item.+after_ :: IO () -> Spec -> Spec+after_ action = after $ \() -> action++-- | Run a custom action before and/or after every spec item.+around :: (ActionWith a -> IO ()) -> SpecWith a -> Spec+around action = aroundWith $ \e () -> action e++-- | Run a custom action after the last spec item.+afterAll :: ActionWith a -> SpecWith a -> SpecWith a+afterAll action spec = runIO (runSpecM spec) >>= fromSpecList . return . NodeWithCleanup action++-- | Run a custom action after the last spec item.+afterAll_ :: IO () -> Spec -> Spec+afterAll_ action = afterAll (\() -> action)++-- | Run a custom action before and/or after every spec item.+around_ :: (IO () -> IO ()) -> Spec -> Spec+around_ action = around $ action . ($ ())++-- | Run a custom action before and/or after every spec item.+aroundWith :: (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b+aroundWith action = mapAround (. action)++mapAround :: ((ActionWith b -> IO ()) -> ActionWith a -> IO ()) -> SpecWith a -> SpecWith b+mapAround f = mapSpecItem (untangle f) $ \i@Item{itemExample = e} -> i{itemExample = (. f) . e}++untangle  :: ((ActionWith b -> IO ()) -> ActionWith a -> IO ()) -> ActionWith a -> ActionWith b+untangle f g = \b -> f ($ b) g

@@ -0,0 +1,37 @@+-- | Stability: provisional+module Test.Hspec.Core.QuickCheck (+  modifyMaxSuccess+, modifyMaxDiscardRatio+, modifyMaxSize++) where++import           Test.QuickCheck+import           Test.Hspec.Core.Spec++-- | Use a modified `maxSuccess` for given spec.+modifyMaxSuccess :: (Int -> Int) -> SpecWith a -> SpecWith a+modifyMaxSuccess = modifyArgs . modify+  where+    modify :: (Int -> Int) -> Args -> Args+    modify f args = args {maxSuccess = f (maxSuccess args)}++-- | Use a modified `maxDiscardRatio` for given spec.+modifyMaxDiscardRatio :: (Int -> Int) -> SpecWith a -> SpecWith a+modifyMaxDiscardRatio = modifyArgs . modify+  where+    modify :: (Int -> Int) -> Args -> Args+    modify f args = args {maxDiscardRatio = f (maxDiscardRatio args)}++-- | Use a modified `maxSize` for given spec.+modifyMaxSize :: (Int -> Int) -> SpecWith a -> SpecWith a+modifyMaxSize = modifyArgs . modify+  where+    modify :: (Int -> Int) -> Args -> Args+    modify f args = args {maxSize = f (maxSize args)}++modifyArgs :: (Args -> Args) -> SpecWith a -> SpecWith a+modifyArgs = modifyParams . modify+  where+    modify :: (Args -> Args) -> Params -> Params+    modify f p = p {paramsQuickCheckArgs = f (paramsQuickCheckArgs p)}

@@ -0,0 +1,60 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.QuickCheckUtil where++import           Control.Applicative+import           Data.Int+import           Data.IORef+import           Test.QuickCheck hiding (Result(..))+import           Test.QuickCheck as QC+import           Test.QuickCheck.Property hiding (Result(..))+import           Test.QuickCheck.Gen+import qualified Test.QuickCheck.Property as QCP+import           Test.QuickCheck.IO ()+++#if MIN_VERSION_QuickCheck(2,7,0)+import           Test.QuickCheck.Random+#endif++import           System.Random++import           Test.Hspec.Core.Util++aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property+#if MIN_VERSION_QuickCheck(2,7,0)+aroundProperty action p = MkProperty . MkGen $ \r n -> aroundProp action $ \a -> (unGen . unProperty $ p a) r n+#else+aroundProperty action p = MkGen $ \r n -> aroundProp action $ \a -> (unGen $ p a) r n+#endif++aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop+aroundProp action p = MkProp $ aroundRose action (\a -> unProp $ p a)++aroundRose :: ((a -> IO ()) -> IO ()) -> (a -> Rose QCP.Result) -> Rose QCP.Result+aroundRose action r = ioRose $ do+  ref <- newIORef (return QCP.succeeded)+  action $ \a -> reduceRose (r a) >>= writeIORef ref+  readIORef ref++formatNumbers :: Result -> String+formatNumbers r = "(after " ++ pluralize (numTests r) "test" ++ shrinks ++ ")"+  where+    shrinks+      | 0 < numShrinks r = " and " ++ pluralize (numShrinks r) "shrink"+      | otherwise = ""++newSeed :: IO Int+newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$>+#if MIN_VERSION_QuickCheck(2,7,0)+  newQCGen+#else+  newStdGen+#endif++#if MIN_VERSION_QuickCheck(2,7,0)+mkGen :: Int -> QCGen+mkGen = mkQCGen+#else+mkGen :: Int -> StdGen+mkGen = mkStdGen+#endif

@@ -0,0 +1,174 @@+-- |+-- Stability: provisional+module Test.Hspec.Core.Runner (+-- * Running a spec+  hspec+, hspecWith+, hspecResult+, hspecWithResult++-- * Types+, 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 (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           Control.Monad.IO.Class (liftIO)++import           Test.Hspec.Compat (lookupEnv)+import           Test.Hspec.Core.Util (Path)+import           Test.Hspec.Core.Spec+import           Test.Hspec.Config+import           Test.Hspec.Core.Formatters+import           Test.Hspec.Core.Formatters.Internal+import           Test.Hspec.FailureReport+import           Test.Hspec.Core.QuickCheckUtil++import           Test.Hspec.Core.Runner.Eval++-- | Filter specs by given predicate.+--+-- The predicate takes a list of "describe" labels and a "requirement".+filterSpecs :: Config -> [SpecTree a] -> [SpecTree a]+filterSpecs c = go []+  where+    p :: Path -> Bool+    p = fromMaybe (const True) (configFilterPredicate c)++    go :: [String] -> [SpecTree a] -> [SpecTree a]+    go groups = mapMaybe (goSpec groups)++    goSpecs :: [String] -> [SpecTree a] -> ([SpecTree a] -> b) -> Maybe b+    goSpecs groups specs ctor = case go groups specs of+      [] -> Nothing+      xs -> Just (ctor xs)++    goSpec :: [String] -> SpecTree a -> Maybe (SpecTree a)+    goSpec groups spec = case spec of+      Leaf item -> guard (p (groups, itemRequirement item)) >> return spec+      Node group specs -> goSpecs (groups ++ [group]) specs (Node group)+      NodeWithCleanup action specs -> goSpecs groups specs (NodeWithCleanup action)++applyDryRun :: Config -> [SpecTree ()] -> [SpecTree ()]+applyDryRun c+  | configDryRun c = map (removeCleanup . fmap markSuccess)+  | otherwise = id+  where+    markSuccess :: Item () -> Item ()+    markSuccess item = item {itemExample = evaluateExample Success}++    removeCleanup :: SpecTree () -> SpecTree ()+    removeCleanup spec = case spec of+      Node x xs -> Node x (map removeCleanup xs)+      NodeWithCleanup _ xs -> NodeWithCleanup (\() -> return ()) (map removeCleanup xs)+      leaf@(Leaf _) -> leaf++-- | Run given spec and write a report to `stdout`.+-- Exit with `exitFailure` if at least one spec item fails.+hspec :: Spec -> IO ()+hspec = hspecWith defaultConfig++-- Add a seed to given config if there is none.  That way the same seed is used+-- for all properties.  This helps with --seed and --rerun.+ensureSeed :: Config -> IO Config+ensureSeed c = case configQuickCheckSeed c of+  Nothing -> do+    seed <- newSeed+    return c {configQuickCheckSeed = Just (fromIntegral seed)}+  _       -> return c++-- | Run given spec with custom options.+-- This is similar to `hspec`, but more flexible.+hspecWith :: Config -> Spec -> IO ()+hspecWith conf spec = do+  r <- hspecWithResult conf spec+  unless (summaryFailures r == 0) exitFailure++-- | Run given spec and returns a summary of the test run.+--+-- /Note/: `hspecResult` does not exit with `exitFailure` on failing spec+-- items.  If you need this, you have to check the `Summary` yourself and act+-- accordingly.+hspecResult :: Spec -> IO Summary+hspecResult = hspecWithResult defaultConfig++-- | Run given spec with custom options and returns a summary of the test run.+--+-- /Note/: `hspecWithResult` does not exit with `exitFailure` on failing spec+-- items.  If you need this, you have to check the `Summary` yourself and act+-- accordingly.+hspecWithResult :: Config -> Spec -> IO Summary+hspecWithResult conf spec = do+  prog <- getProgName+  args <- getArgs+  c <- getConfig conf prog args >>= ensureSeed+  withArgs [] {- do not leak command-line arguments to examples -} $ withHandle c $ \h -> do+    let formatter = fromMaybe specdoc (configFormatter c)+        seed = (fromJust . configQuickCheckSeed) c+        qcArgs = configQuickCheckArgs c++    useColor <- doesUseColor h c++    filteredSpec <- filterSpecs c . applyDryRun c <$> runSpecM spec++    withHiddenCursor useColor h $+      runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do+        runFormatter useColor h c formatter filteredSpec `finally_` do+          failedFormatter formatter++        footerFormatter formatter++        -- dump failure report+        xs <- map failureRecordPath <$> getFailMessages+        liftIO $ writeFailureReport FailureReport {+            failureReportSeed = seed+          , failureReportMaxSuccess = QC.maxSuccess qcArgs+          , failureReportMaxSize = QC.maxSize qcArgs+          , failureReportMaxDiscardRatio = QC.maxDiscardRatio qcArgs+          , 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 configOutputFile c of+      Left h -> action h+      Right path -> withFile path WriteMode action++isDumb :: IO Bool+isDumb = maybe False (== "dumb") <$> lookupEnv "TERM"++-- | Summary of a test run.+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)

@@ -0,0 +1,157 @@+module Test.Hspec.Core.Runner.Eval (runFormatter) where++import           Control.Applicative+import           Control.Monad+import qualified Control.Exception as E+import           Control.Concurrent+import           System.IO (Handle)++import           Control.Monad.IO.Class (liftIO)+import           Control.DeepSeq (deepseq)+import           Data.Time.Clock.POSIX++import           Test.Hspec.Core.Util+import           Test.Hspec.Core.Spec+import           Test.Hspec.Config+import           Test.Hspec.Core.Formatters+import           Test.Hspec.Core.Formatters.Internal+import           Test.Hspec.Timer++type EvalTree = Tree (ActionWith ()) (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))++-- | Evaluate all examples of a given spec and produce a report.+runFormatter :: Bool -> Handle -> Config -> Formatter -> [SpecTree ()] -> FormatM ()+runFormatter useColor h c formatter specs = do+  headerFormatter formatter+  chan <- liftIO newChan+  reportProgress <- liftIO mkReportProgress+  run chan reportProgress c formatter (toEvalTree specs)+  where+    mkReportProgress :: IO (Path -> Progress -> IO ())+    mkReportProgress+      | useColor = every 0.05 $ exampleProgress formatter h+      | otherwise = return $ \_ _ -> return ()++    toEvalTree :: [SpecTree ()] -> [EvalTree]+    toEvalTree = map (fmap f)+      where+        f :: Item () -> (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))+        f (Item requirement loc isParallelizable e) = (requirement, loc, parallelize isParallelizable $ e params ($ ()))++    params :: Params+    params = Params (configQuickCheckArgs c) (configSmallCheckDepth c)++-- | Execute given action at most every specified number of seconds.+every :: POSIXTime -> (a -> b -> IO ()) -> IO (a -> b -> IO ())+every seconds action = do+  timer <- newTimer seconds+  return $ \a b -> do+    r <- timer+    when r (action a b)++type FormatResult = Either E.SomeException Result -> FormatM ()++parallelize :: Bool -> (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())+parallelize isParallelizable e+  | isParallelizable = runParallel e+  | otherwise = runSequentially e++runSequentially :: (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())+runSequentially e reportProgress formatResult = return $ do+  result <- liftIO $ evalExample (e reportProgress)+  formatResult result++data Report = ReportProgress Progress | ReportResult (Either E.SomeException Result)++runParallel :: (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())+runParallel e reportProgress formatResult = do+  mvar <- newEmptyMVar+  _ <- forkIO $ do+    let progressCallback = replaceMVar mvar . ReportProgress+    result <- evalExample (e progressCallback)+    replaceMVar mvar (ReportResult result)+  return $ evalReport mvar+  where+    evalReport :: MVar Report -> FormatM ()+    evalReport mvar = do+      r <- liftIO (takeMVar mvar)+      case r of+        ReportProgress p -> do+          liftIO $ reportProgress p+          evalReport mvar+        ReportResult result -> formatResult result++    replaceMVar :: MVar a -> a -> IO ()+    replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p++evalExample :: IO Result -> IO (Either E.SomeException Result)+evalExample e = safeTry $ forceResult <$> e+  where+    forceResult :: Result -> Result+    forceResult r = case r of+      Success   -> r+      Pending m -> m `deepseq` r+      Fail    m -> m `deepseq` r++data Message = Done | Run (FormatM ())++run :: Chan Message -> (Path -> ProgressCallback) -> Config -> Formatter -> [EvalTree] -> FormatM ()+run chan reportProgress_ c formatter specs = do+  liftIO $ do+    forM_ specs (queueSpec [])+    writeChan chan Done+  processMessages (readChan chan) (configFastFail c)+  where+    defer :: FormatM () -> IO ()+    defer = writeChan chan . Run++    runCleanup :: IO () -> Path -> FormatM ()+    runCleanup action path = do+      r <- liftIO $ safeTry action+      either (failed Nothing path . Left) return r++    queueSpec :: [String] -> EvalTree -> IO ()+    queueSpec rGroups (Node group xs) = do+      defer (exampleGroupStarted formatter (reverse rGroups) group)+      forM_ xs (queueSpec (group : rGroups))+      defer (exampleGroupDone formatter)+    queueSpec rGroups (NodeWithCleanup action xs) = do+      forM_ xs (queueSpec rGroups)+      defer (runCleanup (action ()) (reverse rGroups, "afterAll-hook"))+    queueSpec rGroups (Leaf e) =+      queueExample (reverse rGroups) e++    queueExample :: [String] -> (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ())) -> IO ()+    queueExample groups (requirement, loc, e) = e reportProgress formatResult >>= defer+      where+        path :: Path+        path = (groups, requirement)++        reportProgress = reportProgress_ path++        formatResult :: Either E.SomeException Result -> FormatM ()+        formatResult result = do+          case result of+            Right Success -> do+              increaseSuccessCount+              exampleSucceeded formatter path+            Right (Pending reason) -> do+              increasePendingCount+              examplePending formatter path reason+            Right (Fail err) -> failed loc path (Right err)+            Left err         -> failed loc path (Left  err)++    failed loc path err = do+      increaseFailCount+      addFailMessage loc path err+      exampleFailed formatter path err++processMessages :: IO Message -> Bool -> FormatM ()+processMessages getMessage fastFail = go+  where+    go = liftIO getMessage >>= \m -> case m of+      Run action -> do+        action+        fails <- getFailCount+        unless (fastFail && fails /= 0) go+      Done -> return ()

@@ -0,0 +1,70 @@+-- |+-- Stability: unstable+--+-- This module provides access to Hspec's internals.  It is less stable than+-- other parts of the API. For most users @Test.Hspec@ is more suitable!+module Test.Hspec.Core.Spec (++-- * Defining a spec+  describe+, it+, pending+, pendingWith+, parallel++-- * The @SpecM@ monad+, module Test.Hspec.Core.Spec.Monad++-- * A type class for examples+, module Test.Hspec.Core.Example++-- * Internal representation of a spec tree+, module Test.Hspec.Core.Tree+) where++import qualified Control.Exception as E+import           Test.Hspec.Expectations (Expectation)++import           Test.Hspec.Core.Example+import           Test.Hspec.Core.Tree+import           Test.Hspec.Core.Spec.Monad++-- | The @describe@ function combines a list of specs into a larger spec.+describe :: String -> SpecWith a -> SpecWith a+describe label spec = runIO (runSpecM spec) >>= fromSpecList . return . specGroup label++-- | The @it@ function creates a spec item.+--+-- A spec item consists of:+--+-- * a textual description of a desired behavior+--+-- * an example for that behavior+--+-- > describe "absolute" $ do+-- >   it "returns a positive number when given a negative number" $+-- >     absolute (-1) == 1+it :: Example a => String -> a -> SpecWith (Arg a)+it label action = fromSpecList [specItem label action]++-- | `parallel` marks all spec items of the given spec to be safe for parallel+-- evaluation.+parallel :: SpecWith a -> SpecWith a+parallel = mapSpecItem_ $ \item -> item {itemIsParallelizable = True}++-- | `pending` can be used to indicate that an example is /pending/.+--+-- If you want to textually specify a behavior but do not have an example yet,+-- use this:+--+-- > describe "fancyFormatter" $ do+-- >   it "can format text in a way that everyone likes" $+-- >     pending+pending :: Expectation+pending = E.throwIO (Pending Nothing)++-- |+-- `pendingWith` is similar to `pending`, but it takes an additional string+-- argument that can be used to specify the reason for why it's pending.+pendingWith :: String -> Expectation+pendingWith = E.throwIO . Pending . Just

@@ -0,0 +1,65 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Test.Hspec.Core.Spec.Monad (+  Spec+, SpecWith+, SpecM (..)+, runSpecM+, fromSpecList+, runIO++, mapSpecTree+, mapSpecItem+, mapSpecItem_+, modifyParams+) where++import           Control.Applicative+import           Control.Monad.Trans.Writer+import           Control.Monad.IO.Class (liftIO)++import           Test.Hspec.Core.Example+import           Test.Hspec.Core.Tree++type Spec = SpecWith ()++type SpecWith a = SpecM a ()++-- | A writer monad for `SpecTree` forests+newtype SpecM a r = SpecM (WriterT [SpecTree a] IO r)+  deriving (Functor, Applicative, Monad)++-- | Convert a `Spec` to a forest of `SpecTree`s.+runSpecM :: SpecWith a -> IO [SpecTree a]+runSpecM (SpecM specs) = execWriterT specs++-- | Create a `Spec` from a forest of `SpecTree`s.+fromSpecList :: [SpecTree a] -> SpecWith a+fromSpecList = SpecM . tell++-- | Run an IO action while constructing the spec tree.+--+-- `SpecM` is a monad to construct a spec tree, without executing any spec+-- items.  @runIO@ allows you to run IO actions during this construction phase.+-- The IO action is always run when the spec tree is constructed (e.g. even+-- when @--dry-run@ is specified).+-- If you do not need the result of the IO action to construct the spec tree,+-- `Test.Hspec.Core.Hooks.beforeAll` may be more suitable for your use case.+runIO :: IO r -> SpecM a r+runIO = SpecM . liftIO++mapSpecTree :: (SpecTree a -> SpecTree b) -> SpecWith a -> SpecWith b+mapSpecTree f spec = runIO (runSpecM spec) >>= fromSpecList . map f++mapSpecItem :: (ActionWith a -> ActionWith b) -> (Item a -> Item b) -> SpecWith a -> SpecWith b+mapSpecItem g f = mapSpecTree go+  where+    go spec = case spec of+      Node d xs -> Node d (map go xs)+      NodeWithCleanup cleanup xs -> NodeWithCleanup (g cleanup) (map go xs)+      Leaf item -> Leaf (f item)++mapSpecItem_ :: (Item a -> Item a) -> SpecWith a -> SpecWith a+mapSpecItem_ = mapSpecItem id++modifyParams :: (Params -> Params) -> SpecWith a -> SpecWith a+modifyParams f = mapSpecItem_ $ \item -> item {itemExample = \p -> (itemExample item) (f p)}

@@ -0,0 +1,103 @@+{-# LANGUAGE DeriveFunctor #-}+-- |+-- Stability: unstable+module Test.Hspec.Core.Tree (+  SpecTree+, Tree (..)+, Item (..)+, Location (..)+, LocationAccuracy (..)+, specGroup+, specItem+) where++import           Control.Applicative+import           Data.Foldable+import           Data.Traversable+import           Data.Monoid++import           Test.Hspec.Core.Example++-- | Internal tree data structure+data Tree c a =+    Node String [Tree c a]+  | NodeWithCleanup c [Tree c a]+  | Leaf a+  deriving Functor++instance Foldable (Tree c) where -- Note: GHC 7.0.1 fails to derive this instance+  foldMap = go+    where+      go :: Monoid m => (a -> m) -> Tree c a -> m+      go f t = case t of+        Node _ xs -> foldMap (foldMap f) xs+        NodeWithCleanup _ xs -> foldMap (foldMap f) xs+        Leaf x -> f x++instance Traversable (Tree c) where -- Note: GHC 7.0.1 fails to derive this instance+  sequenceA = go+    where+      go :: Applicative f => Tree c (f a) -> f (Tree c a)+      go t = case t of+        Node label xs -> Node label <$> sequenceA (map go xs)+        NodeWithCleanup action xs -> NodeWithCleanup action <$> sequenceA (map go xs)+        Leaf a -> Leaf <$> a++-- | A tree is used to represent a spec internally.  The tree is parametrize+-- over the type of cleanup actions and the type of the actual spec items.+type SpecTree a = Tree (ActionWith a) (Item a)++-- |+-- @Item@ is used to represent spec items internally.  A spec item consists of:+--+-- * a textual description of a desired behavior+-- * an example for that behavior+-- * additional meta information+--+-- Everything that is an instance of the `Example` type class can be used as an+-- example, including QuickCheck properties, Hspec expectations and HUnit+-- assertions.+data Item a = Item {+  -- | Textual description of behavior+  itemRequirement :: String+  -- | Source location of the spec item+, itemLocation :: Maybe Location+  -- | A flag that indicates whether it is safe to evaluate this spec item in+  -- parallel with other spec items+, itemIsParallelizable :: Bool+  -- | Example for behavior+, itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result+}++-- | @Location@ is used to represent source locations.+data Location = Location {+  locationFile :: String+, locationLine :: Int+, locationColumn :: Int+, locationAccuracy :: LocationAccuracy+} deriving (Eq, Show)++-- | A marker for source locations+data LocationAccuracy =+  -- | The source location is accurate+  ExactLocation |+  -- | The source location was determined on a best-effort basis and my be+  -- wrong or inaccurate+  BestEffort+  deriving (Eq, Show)++-- | The @specGroup@ function combines a list of specs into a larger spec.+specGroup :: String -> [SpecTree a] -> SpecTree a+specGroup s = Node msg+  where+    msg+      | null s = "(no description given)"+      | otherwise = s++-- | The @specItem@ function creates a spec item.+specItem :: Example a => String -> a -> SpecTree (Arg a)+specItem s e = Leaf $ Item requirement Nothing False (evaluateExample e)+  where+    requirement+      | null s = "(unspecified behavior)"+      | otherwise = s

@@ -0,0 +1,132 @@+-- | Stability: unstable+module Test.Hspec.Core.Util (+-- * String functions+  pluralize+, strip+, lineBreaksAt++-- * Working with paths+, Path+, formatRequirement+, filterPredicate++-- * Working with exception+, safeTry+, formatException+) where++import           Data.List+import           Data.Char (isSpace)+import           GHC.IO.Exception+import           Control.Exception+import           Control.Concurrent.Async++import           Test.Hspec.Compat (showType)++-- |+-- @pluralize count singular@ pluralizes the given @singular@ word unless given+-- @count@ is 1.+--+-- Examples:+--+-- >>> pluralize 0 "example"+-- "0 examples"+--+-- >>> pluralize 1 "example"+-- "1 example"+--+-- >>> pluralize 2 "example"+-- "2 examples"+pluralize :: Int -> String -> String+pluralize 1 s = "1 " ++ s+pluralize n s = show n ++ " " ++ s ++ "s"++-- | Strip leading and trailing whitespace+strip :: String -> String+strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse++-- |+-- ensure that lines are not longer then given `n`, insert line breaks at word+-- boundaries+lineBreaksAt :: Int -> String -> [String]+lineBreaksAt n input = case words input of+  []   -> []+  x:xs -> go (x, xs)+  where+    go :: (String, [String]) -> [String]+    go c = case c of+      (s, [])   -> [s]+      (s, y:ys) -> let r = s ++ " " ++ y in+        if length r <= n+          then go (r, ys)+          else s : go (y, ys)++-- |+-- A `Path` represents the location of an example within the spec tree.+--+-- It consists of a list of group descriptions and a requirement description.+type Path = ([String], String)++-- |+-- Try to create a proper English sentence from a path by applying some+-- heuristics.+formatRequirement :: Path -> String+formatRequirement (groups, requirement) = groups_ ++ requirement+  where+    groups_ = case break (any isSpace) groups of+      ([], ys) -> join ys+      (xs, ys) -> join (intercalate "." xs : ys)++    join xs = case xs of+      [x] -> x ++ " "+      ys  -> concatMap (++ ", ") ys++-- | A predicate that can be used to filter a spec tree.+filterPredicate :: String -> Path -> Bool+filterPredicate pattern path@(groups, requirement) =+     pattern `isInfixOf` plain+  || pattern `isInfixOf` formatted+  where+    plain = intercalate "/" (groups ++ [requirement])+    formatted = formatRequirement path++-- | The function `formatException` converts an exception to a string.+--+-- This is different from `show`.  The type of the exception is included, e.g.:+--+-- >>> formatException (toException DivideByZero)+-- "ArithException (divide by zero)"+--+-- For `IOException`s the `IOErrorType` is included, as well.+formatException :: SomeException -> String+formatException err@(SomeException e) = case fromException err of+  Just ioe -> showType ioe ++ " of type " ++ showIOErrorType ioe ++ " (" ++ show ioe ++ ")"+  Nothing  -> showType e ++ " (" ++ show e ++ ")"+  where+    showIOErrorType :: IOException -> String+    showIOErrorType ioe = case ioe_type ioe of+      AlreadyExists -> "AlreadyExists"+      NoSuchThing -> "NoSuchThing"+      ResourceBusy -> "ResourceBusy"+      ResourceExhausted -> "ResourceExhausted"+      EOF -> "EOF"+      IllegalOperation -> "IllegalOperation"+      PermissionDenied -> "PermissionDenied"+      UserError -> "UserError"+      UnsatisfiedConstraints -> "UnsatisfiedConstraints"+      SystemError -> "SystemError"+      ProtocolError -> "ProtocolError"+      OtherError -> "OtherError"+      InvalidArgument -> "InvalidArgument"+      InappropriateType -> "InappropriateType"+      HardwareFault -> "HardwareFault"+      UnsupportedOperation -> "UnsupportedOperation"+      TimeExpired -> "TimeExpired"+      ResourceVanished -> "ResourceVanished"+      Interrupted -> "Interrupted"++-- | @safeTry@ evaluates given action and returns its result.  If an exception+-- occurs, the exception is returned instead.  Unlike `try` it is agnostic to+-- asynchronous exceptions.+safeTry :: IO a -> IO (Either SomeException a)+safeTry action = withAsync (action >>= evaluate) waitCatch

@@ -0,0 +1,36 @@+module Test.Hspec.FailureReport (+  FailureReport (..)+, writeFailureReport+, readFailureReport+) where++import           System.IO+import           System.SetEnv+import           Test.Hspec.Compat+import           Test.Hspec.Core.Util (Path, safeTry)++data FailureReport = FailureReport {+  failureReportSeed :: Integer+, failureReportMaxSuccess :: Int+, failureReportMaxSize :: Int+, failureReportMaxDiscardRatio :: Int+, failureReportPaths :: [Path]+} deriving (Eq, Show, Read)++writeFailureReport :: FailureReport -> IO ()+writeFailureReport x = do+  -- on Windows this can throw an exception when the input is too large, hence+  -- we use `safeTry` here+  safeTry (setEnv "HSPEC_FAILURES" $ show x) >>= either onError return+  where+    onError err = do+      hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")")++readFailureReport :: IO (Maybe FailureReport)+readFailureReport = do+  mx <- lookupEnv "HSPEC_FAILURES"+  case mx >>= readMaybe of+    Nothing -> do+      hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!"+      return Nothing+    x -> return x

@@ -0,0 +1,178 @@+module Test.Hspec.Options (+  Config(..)+, ColorMode (..)+, defaultConfig+, filterOr+, parseOptions+) where++import           Control.Applicative+import           Data.List+import           System.IO+import           System.Exit+import           System.Console.GetOpt++import           Test.Hspec.Core.Formatters+import           Test.Hspec.Compat+import           Test.Hspec.Core.Util++data Config = Config {+  configDryRun :: Bool+, configPrintCpuTime :: Bool+, configFastFail :: Bool++-- |+-- A predicate that is used to filter the spec before it is run.  Only examples+-- that satisfy the predicate are run.+, configRerun :: Bool+, configFilterPredicate :: Maybe (Path -> Bool)+, configQuickCheckSeed :: Maybe Integer+, configQuickCheckMaxSuccess :: Maybe Int+, configQuickCheckMaxDiscardRatio :: Maybe Int+, configQuickCheckMaxSize :: Maybe Int+, configSmallCheckDepth :: Int+, configColorMode :: ColorMode+, configFormatter :: Maybe Formatter+, configHtmlOutput :: Bool+, configOutputFile :: Either Handle FilePath+}++defaultConfig :: Config+defaultConfig = Config {+  configDryRun = False+, configPrintCpuTime = False+, configFastFail = False+, configRerun = False+, configFilterPredicate = Nothing+, configQuickCheckSeed = Nothing+, configQuickCheckMaxSuccess = Nothing+, configQuickCheckMaxDiscardRatio = Nothing+, configQuickCheckMaxSize = Nothing+, configSmallCheckDepth = 5+, configColorMode = ColorAuto+, configFormatter = Nothing+, configHtmlOutput = False+, configOutputFile = Left stdout+}++filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool)+filterOr p1_ p2_ = case (p1_, p2_) of+  (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path+  _ -> p1_ <|> p2_++addMatch :: String -> Config -> Config+addMatch s c = c {configFilterPredicate = Just (filterPredicate s) `filterOr` configFilterPredicate c}++setDepth :: Int -> Config -> Config+setDepth n c = c {configSmallCheckDepth = n}++setMaxSuccess :: Int -> Config -> Config+setMaxSuccess n c = c {configQuickCheckMaxSuccess = Just n}++setMaxSize :: Int -> Config -> Config+setMaxSize n c = c {configQuickCheckMaxSize = Just n}++setMaxDiscardRatio :: Int -> Config -> Config+setMaxDiscardRatio n c = c {configQuickCheckMaxDiscardRatio = Just n}++setSeed :: Integer -> Config -> Config+setSeed n c = c {configQuickCheckSeed = Just n}++data ColorMode = ColorAuto | ColorNever | ColorAlways+  deriving (Eq, Show)++formatters :: [(String, Formatter)]+formatters = [+    ("specdoc", specdoc)+  , ("progress", progress)+  , ("failed-examples", failed_examples)+  , ("silent", silent)+  ]++formatHelp :: String+formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters)++type Result = Either NoConfig Config++data NoConfig = Help | InvalidArgument String String++data Arg a = Arg {+  _argumentName   :: String+, _argumentParser :: String -> Maybe a+, _argumentSetter :: a -> Config -> Config+}++mkOption :: [Char] -> String -> Arg a -> String -> OptDescr (Result -> Result)+mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help+  where+    arg :: String -> Result -> Result+    arg input x = x >>= \c -> case parser input of+      Just n -> Right (setter n c)+      Nothing -> Left (InvalidArgument name input)++addLineBreaks :: String -> [String]+addLineBreaks = lineBreaksAt 44++options :: [OptDescr (Result -> Result)]+options = [+    Option   []  ["help"]             (NoArg (const $ Left Help))         (h "display this help and exit")+  , mkOption "m"  "match"             (Arg "PATTERN" return addMatch)     (h "only run examples that match given PATTERN")+  , Option   []  ["color"]            (NoArg setColor)                    (h "colorize the output")+  , Option   []  ["no-color"]         (NoArg setNoColor)                  (h "do not colorize the output")+  , mkOption "f"  "format"            (Arg "FORMATTER" readFormatter setFormatter) formatHelp+  , mkOption "o"  "out"               (Arg "FILE" return setOutputFile)   (h "write output to a file instead of STDOUT")+  , mkOption []   "depth"             (Arg "N" readMaybe setDepth)        (h "maximum depth of generated test values for SmallCheck properties")+  , mkOption "a"  "qc-max-success"    (Arg "N" readMaybe setMaxSuccess)   (h "maximum number of successful tests before a QuickCheck property succeeds")+  , mkOption ""   "qc-max-size"       (Arg "N" readMaybe setMaxSize)      (h "size to use for the biggest test cases")+  , mkOption ""   "qc-max-discard"    (Arg "N" readMaybe setMaxDiscardRatio) (h "maximum number of discarded tests per successful test before giving up")+  , mkOption []   "seed"              (Arg "N" readMaybe setSeed)         (h "used seed for QuickCheck properties")+  , Option   []  ["print-cpu-time"]   (NoArg setPrintCpuTime)             (h "include used CPU time in summary")+  , Option   []  ["dry-run"]          (NoArg setDryRun)                   (h "pretend that everything passed; don't verify anything")+  , Option   []  ["fail-fast"]        (NoArg setFastFail)                 (h "abort on first failure")+  , Option   "r" ["rerun"]            (NoArg  setRerun)                   (h "rerun all examples that failed in the previously test run (only works in GHCi)")+  ]+  where+    h = unlines . addLineBreaks++    readFormatter :: String -> Maybe Formatter+    readFormatter = (`lookup` formatters)++    setFormatter :: Formatter -> Config -> Config+    setFormatter f c = c {configFormatter = Just f}++    setOutputFile :: String -> Config -> Config+    setOutputFile file c = c {configOutputFile = Right file}++    setPrintCpuTime x = x >>= \c -> return c {configPrintCpuTime = True}+    setDryRun       x = x >>= \c -> return c {configDryRun = True}+    setFastFail     x = x >>= \c -> return c {configFastFail = True}+    setRerun        x = x >>= \c -> return c {configRerun = True}+    setNoColor      x = x >>= \c -> return c {configColorMode = ColorNever}+    setColor        x = x >>= \c -> return c {configColorMode = ColorAlways}++undocumentedOptions :: [OptDescr (Result -> Result)]+undocumentedOptions = [+    -- for compatibility with test-framework+    mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default"++    -- undocumented for now, as we probably want to change this to produce a+    -- standalone HTML report in the future+  , Option []  ["html"]                    (NoArg setHtml)                    "produce HTML output"++    -- now a noop+  , Option "v" ["verbose"]                 (NoArg id)                         "do not suppress output to stdout when evaluating examples"+  ]+  where+    setHtml :: Result -> Result+    setHtml x = x >>= \c -> return c {configHtmlOutput = True}++parseOptions :: Config -> String -> [String] -> Either (ExitCode, String) Config+parseOptions c prog args = case getOpt Permute (options ++ undocumentedOptions) args of+    (opts, [], []) -> case foldl' (flip id) (Right c) opts of+        Left Help                         -> Left (ExitSuccess, usageInfo ("Usage: " ++ prog ++ " [OPTION]...\n\nOPTIONS") options)+        Left (InvalidArgument flag value) -> tryHelp ("invalid argument `" ++ value ++ "' for `--" ++ flag ++ "'\n")+        Right x -> Right x+    (_, _, err:_)  -> tryHelp err+    (_, arg:_, _)  -> tryHelp ("unexpected argument `" ++ arg ++ "'\n")+  where+    tryHelp msg = Left (ExitFailure 1, prog ++ ": " ++ msg ++ "Try `" ++ prog ++ " --help' for more information.\n")

@@ -0,0 +1,14 @@+module Test.Hspec.Timer where++import           Data.IORef+import           Data.Time.Clock.POSIX++newTimer :: POSIXTime -> IO (IO Bool)+newTimer delay = do+  ref <- getPOSIXTime >>= newIORef+  return $ do+    t0 <- readIORef ref+    t1 <- getPOSIXTime+    if delay < t1 - t0+      then writeIORef ref t1 >> return True+      else return False

@@ -0,0 +1,89 @@+module Helper (+  module Test.Hspec.Meta+, module Test.QuickCheck+, module Control.Applicative+, module System.IO.Silently+, sleep+, timeout+, defaultParams+, noOpProgressCallback+, captureLines+, normalizeSummary++, ignoreExitCode+, ignoreUserInterrupt+, throwException++, shouldStartWith+, shouldEndWith++, shouldUseArgs+) where++import           Data.List+import           Data.Char+import           Data.IORef+import           Control.Monad+import           Control.Applicative+import           System.Environment (withArgs)+import           System.Exit+import           Control.Concurrent+import qualified Control.Exception as E+import qualified System.Timeout as System+import           Data.Time.Clock.POSIX+import           System.IO.Silently++import           Test.Hspec.Meta+import           Test.QuickCheck hiding (Result(..))++import qualified Test.Hspec.Core.Spec as H+import qualified Test.Hspec.Core.Runner as H+import           Test.Hspec.Core.QuickCheckUtil (mkGen)++throwException :: IO ()+throwException = E.throwIO (E.ErrorCall "foobar")++ignoreExitCode :: IO () -> IO ()+ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return ()++ignoreUserInterrupt :: IO () -> IO ()+ignoreUserInterrupt action = E.catchJust (guard . (== E.UserInterrupt)) action return++captureLines :: IO a -> IO [String]+captureLines = fmap lines . capture_++shouldStartWith :: (Eq a, Show a) => [a] -> [a] -> Expectation+x `shouldStartWith` y = x `shouldSatisfy` isPrefixOf y++shouldEndWith :: (Eq a, Show a) => [a] -> [a] -> Expectation+x `shouldEndWith` y = x `shouldSatisfy` isSuffixOf y++-- replace times in summary with zeroes+normalizeSummary :: [String] -> [String]+normalizeSummary = map f+  where+    f x | "Finished in " `isPrefixOf` x = map g x+        | otherwise = x+    g x | isNumber x = '0'+        | otherwise  = x++defaultParams :: H.Params+defaultParams = H.Params stdArgs {replay = Just (mkGen 23, 0), maxSuccess = 1000} (H.configSmallCheckDepth H.defaultConfig)++noOpProgressCallback :: H.ProgressCallback+noOpProgressCallback _ = return ()++sleep :: POSIXTime -> IO ()+sleep = threadDelay . floor . (* 1000000)++timeout :: POSIXTime -> IO a -> IO (Maybe a)+timeout = System.timeout . floor . (* 1000000)++shouldUseArgs :: [String] -> (Args -> Bool) -> Expectation+shouldUseArgs args p = do+  spy <- newIORef (H.paramsQuickCheckArgs defaultParams)+  let interceptArgs item = item {H.itemExample = \params action progressCallback -> writeIORef spy (H.paramsQuickCheckArgs params) >> H.itemExample item params action progressCallback}+      spec = H.mapSpecItem_ interceptArgs $+        H.it "foo" False+  (silence . ignoreExitCode . withArgs args . H.hspec) spec+  readIORef spy >>= (`shouldSatisfy` p)

@@ -0,0 +1,15 @@+module Mock where++import           Control.Applicative+import           Data.IORef++newtype Mock = Mock (IORef Int)++newMock :: IO Mock+newMock = Mock <$> newIORef 0++mockAction :: Mock -> IO ()+mockAction (Mock ref) = modifyIORef ref succ++mockCounter  :: Mock -> IO Int+mockCounter  (Mock ref) = readIORef ref

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-}

@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Test.Hspec.CompatSpec (main, spec) where++import           Helper+import           System.SetEnv++import           Test.Hspec.Compat+import           Data.Typeable++data SomeType = SomeType+  deriving Typeable++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "showType" $ do+    it "shows unqualified name of type" $ do+      showType SomeType `shouldBe` "SomeType"++  describe "showFullType (currently unused)" $ do+    it "shows fully qualified name of type" $ do+      showFullType SomeType `shouldBe` "Test.Hspec.CompatSpec.SomeType"++  describe "lookupEnv" $ do+    it "returns value of specified environment variable" $ do+      setEnv "FOO" "bar"+      lookupEnv "FOO" `shouldReturn` Just "bar"++    it "returns Nothing if specified environment variable is not set" $ do+      unsetEnv "FOO"+      lookupEnv "FOO" `shouldReturn` Nothing

@@ -0,0 +1,136 @@+{-# LANGUAGE CPP, ScopedTypeVariables, TypeFamilies #-}+module Test.Hspec.Core.ExampleSpec (main, spec) where++import           Helper+import           Mock+import           Data.List+import           Data.IORef++import qualified Test.Hspec.Core.Example as H+import qualified Test.Hspec.Core.Spec as H+import qualified Test.Hspec.Core.Runner as H++main :: IO ()+main = hspec spec++evaluateExample :: (H.Example e,  H.Arg e ~ ()) => e -> IO H.Result+evaluateExample e = H.evaluateExample e defaultParams ($ ()) noOpProgressCallback++evaluateExampleWith :: (H.Example e, H.Arg e ~ ()) => (IO () -> IO ()) -> e -> IO H.Result+evaluateExampleWith action e = H.evaluateExample e defaultParams (action . ($ ())) noOpProgressCallback++spec :: Spec+spec = do+  describe "evaluateExample" $ do+    context "for Bool" $ do+      it "returns Success on True" $ do+        evaluateExample True `shouldReturn` H.Success++      it "returns Fail on False" $ do+        evaluateExample False `shouldReturn` H.Fail ""++      it "propagates exceptions" $ do+        evaluateExample (error "foobar" :: Bool) `shouldThrow` errorCall "foobar"++    context "for Expectation" $ do+      it "returns Success if all expectations hold" $ do+        evaluateExample (23 `shouldBe` (23 :: Int)) `shouldReturn` H.Success++      it "returns Fail if an expectation does not hold" $ do+        evaluateExample (23 `shouldBe` (42 :: Int)) `shouldReturn` H.Fail "expected: 42\n but got: 23"++      it "propagates exceptions" $ do+        evaluateExample (error "foobar" :: Expectation) `shouldThrow` errorCall "foobar"++      it "runs provided action around expectation" $ do+        ref <- newIORef (0 :: Int)+        let action :: IO () -> IO ()+            action e = do+              n <- readIORef ref+              e+              readIORef ref `shouldReturn` succ n+              modifyIORef ref succ+        evaluateExampleWith action (modifyIORef ref succ) `shouldReturn` H.Success+        readIORef ref `shouldReturn` 2++      context "when used with `pending`" $ do+        it "returns Pending" $ do+          evaluateExample (H.pending) `shouldReturn` H.Pending Nothing++      context "when used with `pendingWith`" $ do+        it "includes the optional reason" $ do+          evaluateExample (H.pendingWith "foo") `shouldReturn` H.Pending (Just "foo")++    context "for Property" $ do+      it "returns Success if property holds" $ do+        evaluateExample (property $ \n -> n == (n :: Int)) `shouldReturn` H.Success++      it "returns Fail if property does not hold" $ do+        H.Fail _ <- evaluateExample $ property $ \n -> n /= (n :: Int)+        return ()++      it "shows what falsified it" $ do+        H.Fail r <- evaluateExample $ property $ \ (x :: Int) (y :: Int) -> (x == 0 && y == 1) ==> False+        r `shouldBe` intercalate "\n"  [+            "Falsifiable (after 1 test): "+          , "0"+          , "1"+          ]++      it "runs provided action around each single check of the property" $ do+        ref <- newIORef (0 :: Int)+        let action :: IO () -> IO ()+            action e = do+              n <- readIORef ref+              e+              readIORef ref `shouldReturn` succ n+              modifyIORef ref succ+        H.Success <- evaluateExampleWith action (property $ modifyIORef ref succ)+        readIORef ref `shouldReturn` 2000++      it "pretty-prints exceptions" $ do+        H.Fail r <- evaluateExample $ property (\ (x :: Int) -> (x == 0) ==> (error "foobar" :: Bool))+        r `shouldBe` intercalate "\n" [+#if MIN_VERSION_QuickCheck(2,7,0)+            "uncaught exception: ErrorCall (foobar) (after 1 test)"+#else+            "Exception: 'foobar' (after 1 test): "+#endif+          , "0"+          ]++      context "when used with shouldBe" $ do+        it "shows what falsified it" $ do+          H.Fail r <- evaluateExample $ property $ \ (x :: Int) (y :: Int) -> (x == 0 && y == 1) ==> 23 `shouldBe` (42 :: Int)+          r `shouldBe` intercalate "\n" [+              "Falsifiable (after 1 test): "+            , "expected: 42"+            , " but got: 23"+            , "0"+            , "1"+            ]++      context "when used with `pending`" $ do+        it "returns Pending" $ do+          evaluateExample (property H.pending) `shouldReturn` H.Pending Nothing++      context "when used with `pendingWith`" $ do+        it "includes the optional reason" $ do+          evaluateExample (property $ H.pendingWith "foo") `shouldReturn` H.Pending (Just "foo")++  describe "Expectation" $ do+    context "as a QuickCheck property" $ do+      it "can be quantified" $ do+        e <- newMock+        silence . H.hspec $ do+          H.it "some behavior" $ property $ \xs -> do+            mockAction e+            (reverse . reverse) xs `shouldBe` (xs :: [Int])+        mockCounter e `shouldReturn` 100++      it "can be used with expectations/HUnit assertions" $ do+        silence . H.hspecResult $ do+          H.describe "readIO" $ do+            H.it "is inverse to show" $ property $ \x -> do+              (readIO . show) x `shouldReturn` (x :: Int)+        `shouldReturn` H.Summary 1 0

@@ -0,0 +1,227 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.FormattersSpec (main, spec) where++import           Helper++import qualified Test.Hspec.Core.Spec as H+import qualified Test.Hspec.Core.Runner as H+import qualified Test.Hspec.Core.Formatters as H++#ifndef mingw32_HOST_OS+import           System.Console.ANSI+#endif++main :: IO ()+main = hspec spec++testSpec :: H.Spec+testSpec = do+  H.describe "Example" $ do+    H.it "success"    (H.Success)+    H.it "fail 1"     (H.Fail "fail message")+    H.it "pending"    (H.pendingWith "pending message")+    H.it "fail 2"     (H.Fail "")+    H.it "exceptions" (undefined :: H.Result)+    H.it "fail 3"     (H.Fail "")++spec :: Spec+spec = do+  describe "silent" $ do+    let runSpec = fmap fst . capture . H.hspecWithResult H.defaultConfig {H.configFormatter = Just H.silent}+    it "produces no output" $ do+      runSpec testSpec `shouldReturn` ""++  describe "failed_examples" $ do+    failed_examplesSpec H.failed_examples++  describe "progress" $ do+    let runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormatter = Just H.progress}++    it "produces '..F...FF.F' style output" $ do+      r <- runSpec testSpec+      head r `shouldBe` ".F.FFF"++    context "same as failed_examples" $ do+      failed_examplesSpec H.progress++  describe "specdoc" $ do+    let runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormatter = Just H.specdoc}++    it "displays a header for each thing being described" $ do+      _:x:_ <- runSpec testSpec+      x `shouldBe` "Example"++    it "displays one row for each behavior" $ do+      r <- runSpec $ do+        H.describe "List as a Monoid" $ do+          H.describe "mappend" $ do+            H.it "is associative" True+          H.describe "mempty" $ do+            H.it "is a left identity" True+            H.it "is a right identity" True+        H.describe "Maybe as a Monoid" $ do+          H.describe "mappend" $ do+            H.it "is associative" True+          H.describe "mempty" $ do+            H.it "is a left identity" True+            H.it "is a right identity" True+      normalizeSummary r `shouldBe` [+          ""+        , "List as a Monoid"+        , "  mappend"+        , "    is associative"+        , "  mempty"+        , "    is a left identity"+        , "    is a right identity"+        , "Maybe as a Monoid"+        , "  mappend"+        , "    is associative"+        , "  mempty"+        , "    is a left identity"+        , "    is a right identity"+        , ""+        , "Finished in 0.0000 seconds"+        , "6 examples, 0 failures"+        ]++    it "outputs an empty line at the beginning (even for non-nested specs)" $ do+      r <- runSpec $ do+        H.it "example 1" True+        H.it "example 2" True+      normalizeSummary r `shouldBe` [+          ""+        , "example 1"+        , "example 2"+        , ""+        , "Finished in 0.0000 seconds"+        , "2 examples, 0 failures"+        ]++    it "displays a row for each successfull, failed, or pending example" $ do+      r <- runSpec testSpec+      r `shouldSatisfy` any (== "  fail 1 FAILED [1]")+      r `shouldSatisfy` any (== "  success")++    it "displays a '#' with an additional message for pending examples" $ do+      r <- runSpec testSpec+      r `shouldSatisfy` any (== "     # PENDING: pending message")++    context "with an empty group" $ do+      it "omits that group from the report" $ do+        r <- runSpec $ do+          H.describe "foo" $ do+            H.it "example 1" True+          H.describe "bar" $ do+            return ()+          H.describe "baz" $ do+            H.it "example 2" True++        normalizeSummary r `shouldBe` [+            ""+          , "foo"+          , "  example 1"+          , "baz"+          , "  example 2"+          , ""+          , "Finished in 0.0000 seconds"+          , "2 examples, 0 failures"+          ]++    context "same as failed_examples" $ do+      failed_examplesSpec H.progress++failed_examplesSpec :: H.Formatter -> Spec+failed_examplesSpec formatter = do+  let runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormatter = Just formatter}++  it "summarizes the time it takes to finish" $ do+    r <- runSpec (return ())+    normalizeSummary r `shouldSatisfy` any (== "Finished in 0.0000 seconds")++  context "displays a detailed list of failures" $ do+    it "prints all requirements that are not met" $ do+      r <- runSpec testSpec+      r `shouldSatisfy` any (== "1) Example fail 1")++    it "prints the exception type for requirements that fail due to an uncaught exception" $ do+      r <- runSpec $ do+        H.it "foobar" (undefined :: Bool)+      r `shouldContain` [+          "1) foobar"+        , "uncaught exception: ErrorCall (Prelude.undefined)"+        ]++    it "prints all descriptions when a nested requirement fails" $ do+      r <- runSpec $+        H.describe "foo" $ do+          H.describe "bar" $ do+            H.it "baz" False+      r `shouldSatisfy` any (== "1) foo.bar baz")+++    context "when a failed example has a source location" $ do+      let bestEffortExplanation = "Source locations marked with \"best-effort\" are calculated heuristically and may be incorrect."++      context "when source location is exact" $ do+        it "includes that source locations" $ do+          let loc = H.Location "test/FooSpec.hs" 23 0 H.ExactLocation+              addLoc e = e {H.itemLocation = Just loc}+          r <- runSpec $ H.mapSpecItem_ addLoc $ do+            H.it "foo" False+          r `shouldSatisfy` any (== "# test/FooSpec.hs:23")++        it "does not include 'best-effort' explanation" $ do+          let loc = H.Location "test/FooSpec.hs" 23 0 H.ExactLocation+              addLoc e = e {H.itemLocation = Just loc}+          r <- runSpec $ H.mapSpecItem_ addLoc $ do+            H.it "foo" False+          r `shouldSatisfy` all (/= bestEffortExplanation)++      context "when source location is best-effort" $ do+        it "marks that source location as 'best-effort'" $ do+          let loc = H.Location "test/FooSpec.hs" 23 0 H.BestEffort+              addLoc e = e {H.itemLocation = Just loc}+          r <- runSpec $ H.mapSpecItem_ addLoc $ do+            H.it "foo" False+          r `shouldSatisfy` any (== "# test/FooSpec.hs:23 (best-effort)")++        it "includes 'best-effort' explanation" $ do+          let loc = H.Location "test/FooSpec.hs" 23 0 H.BestEffort+              addLoc e = e {H.itemLocation = Just loc}+          r <- runSpec $ H.mapSpecItem_ addLoc $ do+            H.it "foo" False+          r `shouldSatisfy` any (== bestEffortExplanation)++  it "summarizes the number of examples and failures" $ do+    r <- runSpec testSpec+    r `shouldSatisfy` any (== "6 examples, 4 failures, 1 pending")++  -- Windows has no support for ANSI escape codes.  The Console API is used for+  -- colorized output, hence the following tests do not work on Windows.+#ifndef mingw32_HOST_OS+  it "shows summary in green if there are no failures" $ do+    r <- captureLines $ H.hspecWithResult H.defaultConfig {H.configColorMode = H.ColorAlways} $ do+      H.it "foobar" True+    r `shouldSatisfy` any (== (green ++ "1 example, 0 failures" ++ reset))++  it "shows summary in yellow if there are pending examples" $ do+    r <- captureLines $ H.hspecWithResult H.defaultConfig {H.configColorMode = H.ColorAlways} $ do+      H.it "foobar" H.pending+    r `shouldSatisfy` any (== (yellow ++ "1 example, 0 failures, 1 pending" ++ reset))++  it "shows summary in red if there are failures" $ do+    r <- captureLines $ H.hspecWithResult H.defaultConfig {H.configColorMode = H.ColorAlways} $ do+      H.it "foobar" False+    r `shouldSatisfy` any (== (red ++ "1 example, 1 failure" ++ reset))++  it "shows summary in red if there are both failures and pending examples" $ do+    r <- captureLines $ H.hspecWithResult H.defaultConfig {H.configColorMode = H.ColorAlways} $ do+      H.it "foo" False+      H.it "bar" H.pending+    r `shouldSatisfy` any (== (red ++ "2 examples, 1 failure, 1 pending" ++ reset))+  where+    green  = setSGRCode [SetColor Foreground Dull Green]+    yellow = setSGRCode [SetColor Foreground Dull Yellow]+    red    = setSGRCode [SetColor Foreground Dull Red]+    reset  = setSGRCode [Reset]+#endif

@@ -0,0 +1,230 @@+module Test.Hspec.Core.HooksSpec (main, spec) where++import           Helper+import           Data.IORef++import qualified Test.Hspec.Core.Spec as H+import qualified Test.Hspec.Core.Runner as H++import qualified Test.Hspec.Core.Hooks as H++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "before" $ do+    it "runs an action before every spec item" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+      silence $ H.hspec $ H.before (append "before") $ do+        H.it "foo" $ do+          append "foo"+        H.it "bar" $ do+          append "bar"+      readIORef ref `shouldReturn` [+          "before"+        , "foo"+        , "before"+        , "bar"+        ]++    context "when used multiple times" $ do+      it "is evaluated outside in" $ do+        ref <- newIORef ([] :: [String])+        let append n = modifyIORef ref (++ return n)+        silence $ H.hspec $ H.before (append "before outer") $  H.before (append "before inner") $ do+          H.it "foo" $ do+            append "foo"+        readIORef ref `shouldReturn` [+            "before outer"+          , "before inner"+          , "foo"+          ]++    context "when used with an action that returns a value" $ do+      it "passes that value to the spec item" $ do+        property $ \n -> do+          silence $ H.hspec $ H.before (return n) $ do+            H.it "foo" $ \m -> do+              m `shouldBe` (n :: Int)++    context "when used with a QuickCheck property" $ do+      it "runs action before every check of the property" $ do+        ref <- newIORef ([] :: [String])+        let append n = modifyIORef ref (++ return n)+        silence $ H.hspec $ H.before (append "before") $ do+          H.it "foo" $ property $ append "foo"+        readIORef ref `shouldReturn` (take 200 . cycle) ["before", "foo"]++  describe "beforeWith" $ do+    it "runs an action before every spec item" $ do+      let action :: Int -> IO String+          action n = return (show n)+      property $ \n -> do+        silence $ H.hspec $ H.before (return n) $ H.beforeWith action $ do+          H.it "foo" $ (`shouldBe` show n)++  describe "beforeAll" $ do+    it "runs an action before the first spec item" $ do+      ref <- newIORef []+      let append n = modifyIORef ref (++ return n)+      silence $ H.hspec $ H.beforeAll (append "beforeAll") $ do+        H.it "foo" $ do+          append "foo"+        H.it "bar" $ do+          append "bar"+      readIORef ref `shouldReturn` [+          "beforeAll"+        , "foo"+        , "bar"+        ]++    context "when used with an empty list of examples" $ do+      it "does not run specified action" $ do+        ref <- newIORef []+        let append n = modifyIORef ref (++ return n)+        silence $ H.hspec $ H.beforeAll (append "beforeAll") $ do+          return ()+        readIORef ref `shouldReturn` []++    context "when used with an action that returns a value" $ do+      it "passes that value to the spec item" $ do+        property $ \n -> do+          silence $ H.hspec $ H.beforeAll (return n) $ do+            H.it "foo" $ \m -> do+              m `shouldBe` (n :: Int)++  describe "after" $ do+    it "must be used with a before action" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+      silence $ H.hspec $ H.before (return "from before") $ H.after append $ do+        H.it "foo" $ \_ -> do+          append "foo"+      readIORef ref `shouldReturn` [+          "foo"+        , "from before"+        ]++  describe "after_" $ do+    it "runs an action after every spec item" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+      silence $ H.hspec $ H.after_ (append "after") $ do+        H.it "foo" $ do+          append "foo"+        H.it "bar" $ do+          append "bar"+      readIORef ref `shouldReturn` [+          "foo"+        , "after"+        , "bar"+        , "after"+        ]++    it "guarantees that action is run" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+      silence . ignoreExitCode $ H.hspec $ H.after_ (append "after") $ do+        H.it "foo" $ do+          ioError $ userError "foo" :: IO ()+          append "foo"+      readIORef ref `shouldReturn` ["after"]++    context "when used multiple times" $ do+      it "is evaluated inside out" $ do+        ref <- newIORef ([] :: [String])+        let append n = modifyIORef ref (++ return n)+        silence $ H.hspec $ H.after_ (append "after outer") $  H.after_ (append "after inner") $ do+          H.it "foo" $ do+            append "foo"+        readIORef ref `shouldReturn` [+            "foo"+          , "after inner"+          , "after outer"+          ]++  describe "afterAll_" $ do+    it "runs an action after the last spec item" $ do+      ref <- newIORef []+      let append n = modifyIORef ref (++ return n)+      silence $ H.hspec $ H.afterAll_ (append "afterAll") $ do+        H.it "foo" $ do+          append "foo"+        H.it "bar" $ do+          append "bar"+      readIORef ref `shouldReturn` [+          "foo"+        , "bar"+        , "afterAll"+        ]++    context "when used with an empty list of examples" $ do+      it "does not run specified action" $ do+        ref <- newIORef []+        let append n = modifyIORef ref (++ return n)+        silence $ H.hspec $ H.afterAll_ (append "afterAll") $ do+          return ()+        readIORef ref `shouldReturn` []++    context "when action throws an exception" $ do+      it "reports a failure" $ do+        r <- runSpec $ do+          H.afterAll_ throwException $ do+            H.it "foo" True+        r `shouldSatisfy` any (== "afterAll-hook FAILED [1]")++  describe "around" $ do+    it "wraps every spec item with an action" $ do+      property $ \n -> do+        silence $ H.hspec $ H.around ($ n) $ do+          H.it "foo" $ \m -> do+            m `shouldBe` (n :: Int)++  describe "around_" $ do+    it "wraps every spec item with an action" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+          action e = append "before" >> e >> append "after"+      silence $ H.hspec $ H.around_ action $ do+        H.it "foo" $ do+          append "foo"+        H.it "bar" $ do+          append "bar"+      readIORef ref `shouldReturn` [+          "before"+        , "foo"+        , "after"+        , "before"+        , "bar"+        , "after"+        ]++    context "when used multiple times" $ do+      it "is evaluated outside in" $ do+        ref <- newIORef ([] :: [String])+        let append n = modifyIORef ref (++ return n)+            actionOuter e = append "before outer" >> e >> append "after outer"+            actionInner e = append "before inner" >> e >> append "after inner"+        silence $ H.hspec $ H.around_ actionOuter $ H.around_ actionInner $ do+          H.it "foo" $ do+            append "foo"+        readIORef ref `shouldReturn` [+            "before outer"+          , "before inner"+          , "foo"+          , "after inner"+          , "after outer"+          ]++  describe "aroundWith" $ do+    it "wraps every spec item with an action" $ do+      let action :: H.ActionWith String -> H.ActionWith Int+          action e n = e (show n)+      property $ \n -> do+        silence $ H.hspec $ H.before (return n) $ H.aroundWith action $ do+          H.it "foo" $ (`shouldBe` show n)+  where+    runSpec :: H.Spec -> IO [String]+    runSpec = captureLines . H.hspecResult

@@ -0,0 +1,31 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+module Test.Hspec.Core.QuickCheckUtilSpec (main, spec) where++import           Helper++import           Test.QuickCheck+import           Test.Hspec.Core.QuickCheckUtil++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "formatNumbers" $ do+    it "includes number of tests" $ do+      formatNumbers (failure 1 0) `shouldBe` "(after 1 test)"++    it "pluralizes number of tests" $ do+      formatNumbers (failure 3 0) `shouldBe` "(after 3 tests)"++    it "includes number of shrinks" $ do+      formatNumbers (failure 3 1) `shouldBe` "(after 3 tests and 1 shrink)"++    it "pluralizes number of shrinks" $ do+      formatNumbers (failure 3 3) `shouldBe` "(after 3 tests and 3 shrinks)"+  where+    failure tests shrinks = Failure {+      numTests = tests+    , numShrinks = shrinks+    }

@@ -0,0 +1,399 @@+module Test.Hspec.Core.RunnerSpec (main, spec) where++import           Helper+import           System.IO (stderr)+import           Control.Monad+import           System.Environment (withArgs, withProgName, getArgs)+import           System.Exit+import           Control.Concurrent+import qualified Control.Exception as E+import           Mock+import           System.SetEnv+import           Test.Hspec.Compat++import           Test.Hspec.FailureReport (FailureReport(..))+import qualified Test.Hspec.Core.Spec as H+import qualified Test.Hspec.Core.Runner as H+import qualified Test.Hspec.Core.Formatters as H (silent)+import qualified Test.Hspec.Core.QuickCheck as H++import qualified Test.QuickCheck as QC+import qualified Test.Hspec.Core.Hooks as H++main :: IO ()+main = hspec spec++quickCheckOptions :: [([Char], Args -> Int)]+quickCheckOptions = [("--qc-max-success", QC.maxSuccess), ("--qc-max-size", QC.maxSize), ("--qc-max-discard", QC.maxDiscardRatio)]++runPropFoo :: [String] -> IO String+runPropFoo args = unlines . normalizeSummary . lines <$> do+  capture_ . ignoreExitCode . withArgs args . H.hspec .  H.modifyMaxSuccess (const 1000000) $ do+    H.it "foo" $ do+      property (/= (23 :: Int))++spec :: Spec+spec = do+  describe "hspec" $ do+    it "runs a spec" $ do+      silence . H.hspec $ do+        H.it "foobar" True+      `shouldReturn` ()++    it "exits with exitFailure if not all examples pass" $ do+      silence . H.hspec $ do+        H.it "foobar" False+      `shouldThrow` (== ExitFailure 1)++    it "allows output to stdout" $ do+      r <- captureLines . H.hspec $ do+        H.it "foobar" $ do+          putStrLn "baz"+      r `shouldSatisfy` elem "baz"++    it "prints an error message on unrecognized command-line options" $ do+      withProgName "myspec" . withArgs ["--foo"] $ do+        hSilence [stderr] (H.hspec $ pure ()) `shouldThrow` (== ExitFailure 1)+        fst `fmap` hCapture [stderr] (ignoreExitCode (H.hspec $ pure ())) `shouldReturn` unlines [+            "myspec: unrecognized option `--foo'"+          , "Try `myspec --help' for more information."+          ]++    it "stores a failure report in the environment" $ do+      silence . ignoreExitCode . withArgs ["--seed", "23"] . H.hspec $ do+        H.describe "foo" $ do+          H.describe "bar" $ do+            H.it "example 1" True+            H.it "example 2" False+        H.describe "baz" $ do+          H.it "example 3" False+      lookupEnv "HSPEC_FAILURES" `shouldReturn` (Just . show) FailureReport {+          failureReportSeed = 23+        , failureReportMaxSuccess = 100+        , failureReportMaxSize = 100+        , failureReportMaxDiscardRatio = 10+        , failureReportPaths = [+            (["foo", "bar"], "example 2")+          , (["baz"], "example 3")+          ]+        }++    describe "with --rerun" $ do+      let runSpec = (captureLines . ignoreExitCode . H.hspec) $ do+            H.it "example 1" True+            H.it "example 2" False+            H.it "example 3" False+            H.it "example 4" True+            H.it "example 5" False++      it "reruns examples that previously failed" $ do+        r0 <- runSpec+        r0 `shouldSatisfy` elem "5 examples, 3 failures"++        r1 <- withArgs ["--rerun"] runSpec+        r1 `shouldSatisfy` elem "3 examples, 3 failures"++      it "reuses the same seed" $ do+        r <- runPropFoo ["--seed", "42"]+        runPropFoo ["-r"] `shouldReturn` r++      forM_ quickCheckOptions $ \(flag, accessor) -> do+        it ("reuses same " ++ flag) $ do+          [flag, "23"] `shouldUseArgs` ((== 23) . accessor)+          ["--rerun"] `shouldUseArgs` ((== 23) . accessor)++      context "when there is no failure report in the environment" $ do+        it "runs everything" $ do+          unsetEnv "HSPEC_FAILURES"+          r <- hSilence [stderr] $ withArgs ["-r"] runSpec+          r `shouldSatisfy` elem "5 examples, 3 failures"++        it "prints a warning to stderr" $ do+          unsetEnv "HSPEC_FAILURES"+          r <- hCapture_ [stderr] $ withArgs ["-r"] runSpec+          r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n"++      context "when parsing of failure report fails" $ do+        it "runs everything" $ do+          setEnv "HSPEC_FAILURES" "some invalid report"+          r <- hSilence [stderr] $ withArgs ["-r"] runSpec+          r `shouldSatisfy` elem "5 examples, 3 failures"++        it "prints a warning to stderr" $ do+          setEnv "HSPEC_FAILURES" "some invalid report"+          r <- hCapture_ [stderr] $ withArgs ["-r"] runSpec+          r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n"+++    it "does not leak command-line flags to examples" $ do+      silence . withArgs ["--verbose"] $ do+        H.hspec $ do+          H.it "foobar" $ do+            getArgs `shouldReturn` []+        `shouldReturn` ()++    context "when interrupted with ctrl-c" $ do+      it "prints summary immediately" $ do+        mvar <- newEmptyMVar+        sync <- newEmptyMVar+        threadId <- forkIO $ do+          r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do+            H.it "foo" False+            H.it "bar" $ do+              putMVar sync ()+              threadDelay 1000000+            H.it "baz" True+          putMVar mvar r+        takeMVar sync+        throwTo threadId E.UserInterrupt+        r <- takeMVar mvar+        normalizeSummary r `shouldBe` [+            ""+          , "foo FAILED [1]"+          , ""+          , "1) foo"+          , ""+          , "Randomized with seed 23"+          , ""+          ]++      it "throws UserInterrupt" $ do+        mvar <- newEmptyMVar+        sync <- newEmptyMVar+        threadId <- forkIO $ do+          silence . H.hspec $ do+            H.it "foo" $ do+              putMVar sync ()+              threadDelay 1000000+          `E.catch` putMVar mvar+        takeMVar sync+        throwTo threadId E.UserInterrupt+        takeMVar mvar `shouldReturn` E.UserInterrupt++    context "with --help" $ do+      let printHelp = withProgName "spec" . withArgs ["--help"] . H.hspec $ pure ()+      it "prints help" $ do+        r <- (captureLines . ignoreExitCode) printHelp+        r `shouldStartWith` ["Usage: spec [OPTION]..."]+        silence printHelp `shouldThrow` (== ExitSuccess)++      it "constrains lines to 80 characters" $ do+        r <- (captureLines . ignoreExitCode) printHelp+        r `shouldSatisfy` all ((<= 80) . length)+        r `shouldSatisfy` any ((78 <=) . length)++    context "with --dry-run" $ do+      let withDryRun = captureLines . withArgs ["--dry-run"] . H.hspec+      it "produces a report" $ do+        r <- withDryRun $ do+          H.it "foo" True+          H.it "bar" True+        normalizeSummary r `shouldBe` [+            ""+          , "foo"+          , "bar"+          , ""+          , "Finished in 0.0000 seconds"+          , "2 examples, 0 failures"+          ]++      it "does not verify anything" $ do+        e <- newMock+        _ <- withDryRun $ do+          H.it "foo" (mockAction e)+          H.it "bar" False+        mockCounter e `shouldReturn` 0++      it "ignores afterAll-hooks" $ do+        ref <- newIORef False+        _ <- withDryRun $ do+          H.afterAll_ (writeIORef ref True) $ do+            H.it "bar" True+        readIORef ref `shouldReturn` False++    context "with --fail-fast" $ do+      it "stops after first failure" $ do+        r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do+          H.it "foo" True+          H.it "bar" False+          H.it "baz" False+        normalizeSummary r `shouldBe` [+            ""+          , "foo"+          , "bar FAILED [1]"+          , ""+          , "1) bar"+          , ""+          , "Randomized with seed 23"+          , ""+          , "Finished in 0.0000 seconds"+          , "2 examples, 1 failure"+          ]++      it "works for nested specs" $ do+        r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do+          H.describe "foo" $ do+            H.it "bar" False+            H.it "baz" True+        normalizeSummary r `shouldBe` [+            ""+          , "foo"+          , "  bar FAILED [1]"+          , ""+          , "1) foo bar"+          , ""+          , "Randomized with seed 23"+          , ""+          , "Finished in 0.0000 seconds"+          , "1 example, 1 failure"+          ]++    context "with --match" $ do+      it "only runs examples that match a given pattern" $ do+        e1 <- newMock+        e2 <- newMock+        e3 <- newMock+        silence . withArgs ["-m", "/bar/example"] . H.hspec $ do+          H.describe "foo" $ do+            H.describe "bar" $ do+              H.it "example 1" $ mockAction e1+              H.it "example 2" $ mockAction e2+            H.describe "baz" $ do+              H.it "example 3" $ mockAction e3+        (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 1, 0)++      it "can be given multiple times" $ do+        e1 <- newMock+        e2 <- newMock+        e3 <- newMock+        silence . withArgs ["-m", "foo", "-m", "baz"] . H.hspec $ do+          H.describe "foo" $ do+            H.it "example 1" $ mockAction e1+          H.describe "bar" $ do+            H.it "example 2" $ mockAction e2+          H.describe "baz" $ do+            H.it "example 3" $ mockAction e3+        (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 0, 1)++    context "with --format" $ do+      it "uses specified formatter" $ do+        r <- capture_ . ignoreExitCode . withArgs ["--format", "progress"] . H.hspec $ do+          H.it "foo" True+          H.it "bar" True+          H.it "baz" False+          H.it "qux" True+        r `shouldContain` "..F."++      context "when given an invalid argument" $ do+        it "prints an error message to stderr" $ do+          r <- hCapture_ [stderr] . ignoreExitCode . withArgs ["--format", "foo"] . H.hspec $ do+            H.it "foo" True+          r `shouldContain` "invalid argument `foo' for `--format'"++    context "with --qc-max-success" $ do+      it "tries QuickCheck properties specified number of times" $ do+        m <- newMock+        silence . withArgs ["--qc-max-success", "23"] . H.hspec $ do+          H.it "foo" $ property $ do+            mockAction m+        mockCounter m `shouldReturn` 23++      context "when run with --rerun" $ do+        it "takes precedence" $ do+          ["--qc-max-success", "23"] `shouldUseArgs` ((== 23) . QC.maxSuccess)+          ["--rerun", "--qc-max-success", "42"] `shouldUseArgs` ((== 42) . QC.maxSuccess)++    context "with --qc-max-size" $ do+      it "passes specified size to QuickCheck properties" $ do+        ["--qc-max-size", "23"] `shouldUseArgs` ((== 23) . QC.maxSize)++    context "with --qc-max-discard" $ do+      it "uses specified discard ratio to QuickCheck properties" $ do+        ["--qc-max-discard", "23"] `shouldUseArgs` ((== 23) . QC.maxDiscardRatio)++    context "with --seed" $ do+      it "uses specified seed" $ do+        r <- runPropFoo ["--seed", "42"]+        runPropFoo ["--seed", "42"] `shouldReturn` r++      context "when run with --rerun" $ do+        it "takes precedence" $ do+          r <- runPropFoo ["--seed", "23"]+          _ <- runPropFoo ["--seed", "42"]+          runPropFoo ["--rerun", "--seed", "23"] `shouldReturn` r++      context "when given an invalid argument" $ do+        let run = withArgs ["--seed", "foo"] . H.hspec $ do+                    H.it "foo" True+        it "prints an error message to stderr" $ do+          r <- hCapture_ [stderr] (ignoreExitCode run)+          r `shouldContain` "invalid argument `foo' for `--seed'"++        it "exits with exitFailure" $ do+          hSilence [stderr] run `shouldThrow` (== ExitFailure 1)++    context "with --print-cpu-time" $ do+      it "includes used CPU time in summary" $ do+        r <- capture_ $ withArgs ["--print-cpu-time"] (H.hspec $ pure ())+        (normalizeSummary . lines) r `shouldContain` ["Finished in 0.0000 seconds, used 0.0000 seconds of CPU time"]++    context "with --html" $ do+      it "produces HTML output" $ do+        r <- capture_ . withArgs ["--html"] . H.hspec $ do+          H.it "foo" True+        r `shouldContain` "</span>"++      it "marks successful examples with CSS class hspec-success" $ do+        r <- capture_ . withArgs ["--html"] . H.hspec $ do+          H.it "foo" True+        r `shouldContain` "<span class=\"hspec-success\">foo\n</span>"++      it "marks pending examples with CSS class hspec-pending" $ do+        r <- capture_ . withArgs ["--html"] . H.hspec $ do+          H.it "foo" H.pending+        r `shouldContain` "<span class=\"hspec-pending\">foo"++      it "marks failed examples with CSS class hspec-failure" $ do+        r <- capture_ . ignoreExitCode . withArgs ["--html"] . H.hspec $ do+          H.it "foo" False+        r `shouldContain` "<span class=\"hspec-failure\">foo"++  describe "hspecResult" $ do+    it "returns a summary of the test run" $ do+      silence . H.hspecResult $ do+        H.it "foo" True+        H.it "foo" False+        H.it "foo" False+        H.it "foo" True+        H.it "foo" True+      `shouldReturn` H.Summary 5 2++    it "treats uncaught exceptions as failure" $ do+      silence . H.hspecResult  $ do+        H.it "foobar" throwException+      `shouldReturn` H.Summary 1 1++    it "uses the specdoc formatter by default" $ do+      _:r:_ <- captureLines . H.hspecResult $ do+        H.describe "Foo.Bar" $ do+          H.it "some example" True+      r `shouldBe` "Foo.Bar"++    it "can use a custom formatter" $ do+      r <- capture_ . H.hspecWithResult H.defaultConfig {H.configFormatter = Just H.silent} $ do+        H.describe "Foo.Bar" $ do+          H.it "some example" True+      r `shouldBe` ""++    it "does not let escape error thunks from failure messages" $ do+      r <- silence . H.hspecResult $ do+        H.it "some example" (H.Fail $ "foobar" ++ undefined)+      r `shouldBe` H.Summary 1 1++    it "runs specs in parallel" $ do+      let n = 10+          t = 0.01+          dt = t * (fromIntegral n / 2)+      r <- timeout dt . silence . H.hspecResult . H.parallel $ do+        replicateM_ n (H.it "foo" $ sleep t)+      r `shouldBe` Just (H.Summary n 0)

@@ -0,0 +1,69 @@+module Test.Hspec.Core.SpecSpec (main, spec) where++import           Helper++import           Test.Hspec.Core.Spec (Item(..), Result(..))+import qualified Test.Hspec.Core.Runner as H+import           Test.Hspec.Core.Spec (Tree(..), runSpecM)++import qualified Test.Hspec.Core.Spec as H++main :: IO ()+main = hspec spec++runSpec :: H.Spec -> IO [String]+runSpec = captureLines . H.hspecResult++spec :: Spec+spec = do+  describe "describe" $ do+    it "can be nested" $ do+      [Node foo [Node bar [Leaf _]]] <- runSpecM $ do+        H.describe "foo" $ do+          H.describe "bar" $ do+            H.it "baz" True+      (foo, bar) `shouldBe` ("foo", "bar")++    context "when no description is given" $ do+      it "uses a default description" $ do+        [Node d _] <- runSpecM (H.describe "" (pure ()))+        d `shouldBe` "(no description given)"++  describe "it" $ do+    it "takes a description of a desired behavior" $ do+      [Leaf item] <- runSpecM (H.it "whatever" True)+      itemRequirement item `shouldBe` "whatever"++    it "takes an example of that behavior" $ do+      [Leaf item] <- runSpecM (H.it "whatever" True)+      itemExample item defaultParams ($ ()) noOpProgressCallback `shouldReturn` Success++    context "when no description is given" $ do+      it "uses a default description" $ do+        [Leaf item] <- runSpecM (H.it "" True)+        itemRequirement item `shouldBe` "(unspecified behavior)"++  describe "pending" $ do+    it "specifies a pending example" $ do+      r <- runSpec $ do+        H.it "foo" H.pending+      r `shouldSatisfy` any (== "     # PENDING: No reason given")++  describe "pendingWith" $ do+    it "specifies a pending example with a reason for why it's pending" $ do+      r <- runSpec $ do+        H.it "foo" $ do+          H.pendingWith "for some reason"+      r `shouldSatisfy` any (== "     # PENDING: for some reason")++  describe "parallel" $ do+    it "marks examples for parallel execution" $ do+      [Leaf item] <- runSpecM . H.parallel $ H.it "whatever" True+      itemIsParallelizable item `shouldBe` True++    it "is applied recursively" $ do+      [Node _ [Node _ [Leaf item]]] <- runSpecM . H.parallel $ do+        H.describe "foo" $ do+          H.describe "bar" $ do+            H.it "baz" True+      itemIsParallelizable item `shouldBe` True

@@ -0,0 +1,103 @@+module Test.Hspec.Core.UtilSpec (main, spec) where++import           Helper+import           Control.Concurrent+import qualified Control.Exception as E++import           Test.Hspec.Core.Util++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "pluralize" $ do+    it "returns singular when used with 1" $ do+      pluralize 1 "thing" `shouldBe` "1 thing"++    it "returns plural when used with number greater 1" $ do+      pluralize 2 "thing" `shouldBe` "2 things"++    it "returns plural when used with 0" $ do+      pluralize 0 "thing" `shouldBe` "0 things"++  describe "formatException" $ do+    it "converts exception to string" $ do+      formatException (E.toException E.DivideByZero) `shouldBe` "ArithException (divide by zero)"++    context "when used with an IOException" $ do+      it "includes the IOErrorType" $ do+        Left e <- E.try (readFile "foo")+        formatException e `shouldBe` "IOException of type NoSuchThing (foo: openFile: does not exist (No such file or directory))"++  describe "lineBreaksAt" $ do+    it "inserts line breaks at word boundaries" $ do+      lineBreaksAt 20 "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod"+      `shouldBe` [+          "Lorem ipsum dolor"+        , "sit amet,"+        , "consectetur"+        , "adipisicing elit,"+        , "sed do eiusmod"+        ]++  describe "safeTry" $ do+    it "returns Right on success" $ do+      Right e <- safeTry (return 23 :: IO Int)+      e `shouldBe` 23++    it "returns Left on exception" $ do+      Left e <- safeTry throwException+      show e `shouldBe` "foobar"++    it "evaluates result to weak head normal form" $ do+      Left e <- safeTry (return undefined)+      show e `shouldBe` "Prelude.undefined"++    it "does not catch asynchronous exceptions" $ do+      mvar <- newEmptyMVar+      sync <- newEmptyMVar+      threadId <- forkIO $ do+        safeTry (putMVar sync () >> threadDelay 1000000) >> return ()+        `E.catch` putMVar mvar+      takeMVar sync+      throwTo threadId E.UserInterrupt+      readMVar mvar `shouldReturn` E.UserInterrupt++  describe "filterPredicate" $ do+    it "tries to match a pattern against a path" $ do+      let p = filterPredicate "foo/bar/example 1"+      p (["foo", "bar"], "example 1") `shouldBe` True+      p (["foo", "bar"], "example 2") `shouldBe` False++    it "is ambiguous" $ do+      let p = filterPredicate "foo/bar/baz"+      p (["foo", "bar"], "baz") `shouldBe` True+      p (["foo"], "bar/baz") `shouldBe` True++    it "succeeds on a partial match" $ do+      let p = filterPredicate "bar/baz"+      p (["foo", "bar", "baz"], "example 1") `shouldBe` True++    it "succeeds with a pattern that matches the message give in the failure list" $ do+      let p = filterPredicate "ModuleA.ModuleB.foo does something"+      p (["ModuleA", "ModuleB", "foo"], "does something") `shouldBe` True++  describe "formatRequirement" $ do+    it "creates a sentence from a subject and a requirement" $ do+      formatRequirement (["reverse"], "reverses a list") `shouldBe` "reverse reverses a list"++    it "creates a sentence from a subject and a requirement when the subject consits of multiple words" $ do+      formatRequirement (["The reverse function"], "reverses a list") `shouldBe` "The reverse function reverses a list"++    it "returns the requirement if no subject is given" $ do+      formatRequirement ([], "reverses a list") `shouldBe` "reverses a list"++    it "inserts context separated by commas" $ do+      formatRequirement (["reverse", "when applied twice"], "reverses a list") `shouldBe` "reverse, when applied twice, reverses a list"++    it "joins components of a subject with a dot" $ do+      formatRequirement (["Data", "List", "reverse"], "reverses a list") `shouldBe` "Data.List.reverse reverses a list"++    it "properly handles context after a subject that consists of several components" $ do+      formatRequirement (["Data", "List", "reverse", "when applied twice"], "reverses a list") `shouldBe` "Data.List.reverse, when applied twice, reverses a list"

@@ -0,0 +1,39 @@+module Test.Hspec.FailureReportSpec (main, spec) where++import           Helper++import           System.IO+import           Test.Hspec.FailureReport+import           GHC.Paths (ghc)+import           System.Process+import           System.Exit++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "writeFailureReport" $ do+    it "prints a warning on unexpected exceptions" $ do+      r <- hCapture_ [stderr] $ writeFailureReport (error "some error")+      r `shouldBe` "WARNING: Could not write environment variable HSPEC_FAILURES (some error)\n"++  -- GHCi needs to keep the environment on :reload, so that we can store+  -- failures there.  Otherwise --rerun would not be very useful.  So we add a+  -- test for that.+  describe "GHCi" $ do+    it "keeps environment variables on :reload" $ do+      let flags = ["-v0", "--interactive", "-ignore-dot-ghci"]+      (Just hIn, Just hOut, Nothing, processHandle) <- createProcess $ (proc ghc flags) {+          std_in = CreatePipe+        , std_out = CreatePipe+        }+      hPutStrLn hIn "import System.SetEnv"+      hPutStrLn hIn "setEnv \"FOO\" \"bar\""+      hPutStrLn hIn ":reload"+      hPutStrLn hIn "import System.Environment"+      hPutStrLn hIn "getEnv \"FOO\""+      hClose hIn+      r <- hGetContents hOut+      length r `seq` r `shouldBe` "\"bar\"\n"+      waitForProcess processHandle `shouldReturn` ExitSuccess

@@ -0,0 +1,44 @@+module Test.Hspec.OptionsSpec (main, spec) where++import           Helper+import           System.Exit++import           Test.Hspec.Options hiding (parseOptions)+import qualified Test.Hspec.Options as Options++main :: IO ()+main = hspec spec++fromLeft :: Either a b -> a+fromLeft (Left a) = a+fromLeft _ = error "fromLeft: No left value!"++spec :: Spec+spec = do+  describe "parseOptions" $ do++    let parseOptions = Options.parseOptions defaultConfig "my-spec"++    it "sets configColorMode to ColorAuto" $ do+      configColorMode <$> parseOptions [] `shouldBe` Right ColorAuto++    context "with --no-color" $ do+      it "sets configColorMode to ColorNever" $ do+        configColorMode <$> parseOptions ["--no-color"] `shouldBe` Right ColorNever++    context "with --color" $ do+      it "sets configColorMode to ColorAlways" $ do+        configColorMode <$> parseOptions ["--color"] `shouldBe` Right ColorAlways++    context "with --out" $ do+      it "sets configOutputFile" $ do+        either (const Nothing) Just . configOutputFile <$> parseOptions ["--out", "foo"] `shouldBe` Right (Just "foo")++    context "with --qc-max-success" $ do+      context "when given an invalid argument" $ do+        it "returns an error message" $ do+          fromLeft (parseOptions ["--qc-max-success", "foo"]) `shouldBe` (ExitFailure 1, "my-spec: invalid argument `foo' for `--qc-max-success'\nTry `my-spec --help' for more information.\n")++    context "with --depth" $ do+      it "sets depth parameter for SmallCheck" $ do+        configSmallCheckDepth <$> parseOptions ["--depth", "23"] `shouldBe` Right 23

@@ -0,0 +1,29 @@+module Test.Hspec.TimerSpec (main, spec) where++import           Helper++import           Test.Hspec.Timer++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "timer action returned by newTimer" $ do++    let dt = 0.01++    it "returns False" $ do+      timer <- newTimer dt+      timer `shouldReturn` False++    context "after specified time" $ do+      it "returns True" $ do+        timer <- newTimer dt+        sleep dt+        timer `shouldReturn` True+        timer `shouldReturn` False+        sleep dt+        sleep dt+        timer `shouldReturn` True+        timer `shouldReturn` False