packages feed

hspec 1.11.4 → 1.12.0

raw patch · 23 files changed

+694/−394 lines, 23 filesdep +stringbuilderdep ~hspec-meta

Dependencies added: stringbuilder

Dependency ranges changed: hspec-meta

Files

hspec-discover/src/Run.hs view
@@ -5,6 +5,7 @@   run  -- exported for testing+, Spec(..) , importList , fileToSpec , findSpecs@@ -29,7 +30,10 @@ instance IsString ShowS where   fromString = showString -type Spec = String+data Spec = Spec {+  specFile :: FilePath+, specModule :: String+} deriving (Eq, Show)  run :: [String] -> IO () run args_ = do@@ -49,16 +53,17 @@  mkSpecModule :: FilePath -> Config -> [Spec] -> String mkSpecModule src c nodes =-  ( "{-# LINE 1 " . shows src . " #-}"+  ( "{-# LINE 1 " . shows src . " #-}\n"+  . showString "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}\n"   . showString ("module " ++ module_ ++" where\n")   . importList nodes-  . maybe driver (driverWithFormatter (null nodes)) (configFormatter c)+  . showString "import Test.Hspec.Discover\n"+  . maybe driver driverWithFormatter (configFormatter c)   . formatSpecs nodes   ) "\n"   where     driver =-        showString "import Test.Hspec\n"-      . case configNoMain c of+        case configNoMain c of           False ->               showString "main :: IO ()\n"             . showString "main = hspec $ "@@ -73,11 +78,9 @@         toUpper m:ms  -driverWithFormatter :: Bool -> String -> ShowS-driverWithFormatter isEmpty f =-    (if isEmpty then id else "import Test.Hspec\n")-  . showString "import Test.Hspec.Runner\n"-  . showString "import qualified " . showString (moduleName f) . showString "\n"+driverWithFormatter :: String -> ShowS+driverWithFormatter f =+    showString "import qualified " . showString (moduleName f) . showString "\n"   . showString "main :: IO ()\n"   . showString "main = hspecWithFormatter " . showString f . showString " $ " @@ -89,7 +92,7 @@ importList = foldr (.) "" . map f   where     f :: Spec -> ShowS-    f name = "import qualified " . showString name . "Spec\n"+    f spec = "import qualified " . showString (specModule spec) . "Spec\n"  -- | Combine a list of strings with (>>). sequenceS :: [ShowS] -> ShowS@@ -103,19 +106,18 @@  -- | Convert a spec to code. formatSpec :: Spec -> ShowS-formatSpec name = "describe " . shows name . " " . showString name . "Spec.spec"+formatSpec (Spec file name) = "postProcessSpec " . shows file . " (describe " . shows name . " " . showString name . "Spec.spec)"  findSpecs :: FilePath -> IO [Spec] findSpecs src = do   let (dir, file) = splitFileName src-  mapMaybe fileToSpec . filter (/= file) <$> getFilesRecursive dir+  mapMaybe (fileToSpec dir) . filter (/= file) <$> getFilesRecursive dir -fileToSpec :: FilePath -> Maybe String-fileToSpec f = intercalate "." . reverse <$> case reverse $ splitDirectories f of+fileToSpec :: FilePath -> FilePath -> Maybe Spec+fileToSpec dir file = case reverse $ splitDirectories file of   x:xs -> case stripSuffix "Spec.hs" x <|> stripSuffix "Spec.lhs" x of-    Nothing -> Nothing-    Just "" -> Nothing-    Just ys -> Just (ys : xs)+    Just name | (not . null) name -> Just . Spec (dir </> file) $ (intercalate "." . reverse) (name : xs)+    _ -> Nothing   _ -> Nothing   where     stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
hspec-discover/test/RunSpec.hs view
@@ -8,7 +8,8 @@ import           System.FilePath import           Data.List (intercalate, sort) -import           Run+import           Run hiding (Spec)+import qualified Run  main :: IO () main = hspec spec@@ -27,20 +28,28 @@     it "generates test driver" $ withTempFile $ \f -> do       run ["hspec-discover/test-data/nested-spec/Spec.hs", "", f]       readFile f `shouldReturn` unlines [-          "{-# LINE 1 \"hspec-discover/test-data/nested-spec/Spec.hs\" #-}module Main where"+          "{-# LINE 1 \"hspec-discover/test-data/nested-spec/Spec.hs\" #-}"+        , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}"+        , "module Main where"         , "import qualified Foo.Bar.BazSpec"         , "import qualified Foo.BarSpec"         , "import qualified FooSpec"-        , "import Test.Hspec"+        , "import Test.Hspec.Discover"         , "main :: IO ()"-        , "main = hspec $ describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec >> describe \"Foo.Bar\" Foo.BarSpec.spec >> describe \"Foo\" FooSpec.spec"+        , "main = hspec $" ++ unwords [+              " postProcessSpec \"hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs\" (describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec)"+          , ">> postProcessSpec \"hspec-discover/test-data/nested-spec/Foo/BarSpec.hs\" (describe \"Foo.Bar\" Foo.BarSpec.spec)"+          , ">> postProcessSpec \"hspec-discover/test-data/nested-spec/FooSpec.hs\" (describe \"Foo\" FooSpec.spec)"+          ]         ]      it "generates test driver for an empty directory" $ withTempFile $ \f -> do       run ["hspec-discover/test-data/empty-dir/Spec.hs", "", f]       readFile f `shouldReturn` unlines [-          "{-# LINE 1 \"hspec-discover/test-data/empty-dir/Spec.hs\" #-}module Main where"-        , "import Test.Hspec"+          "{-# LINE 1 \"hspec-discover/test-data/empty-dir/Spec.hs\" #-}"+        , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}"+        , "module Main where"+        , "import Test.Hspec.Discover"         , "main :: IO ()"         , "main = hspec $ return ()"         ]@@ -56,34 +65,34 @@    describe "fileToSpec" $ do     it "converts path to spec name" $ do-      fileToSpec "FooSpec.hs" `shouldBe` Just "Foo"+      fileToSpec "" "FooSpec.hs" `shouldBe` Just (spec_ "FooSpec.hs" "Foo")      it "rejects spec with empty name" $ do-      fileToSpec "Spec.hs" `shouldBe` Nothing+      fileToSpec "" "Spec.hs" `shouldBe` Nothing      it "works for lhs files" $ do-      fileToSpec "FooSpec.lhs" `shouldBe` Just "Foo"+      fileToSpec "" "FooSpec.lhs" `shouldBe` Just (spec_ "FooSpec.lhs" "Foo")      it "returns Nothing for invalid spec name" $ do-      fileToSpec "foo" `shouldBe` Nothing+      fileToSpec "" "foo" `shouldBe` Nothing      context "when path has directory component" $ do       it "converts path to spec name" $ do-        fileToSpec ("Foo" </> "Bar" </> "BazSpec.hs") `shouldBe` Just "Foo.Bar.Baz"+        let file = "Foo" </> "Bar" </> "BazSpec.hs"+        fileToSpec "" file `shouldBe` Just (spec_ file "Foo.Bar.Baz")        it "rejects spec with empty name" $ do-        fileToSpec ("Foo" </> "Bar" </> "Spec.hs") `shouldBe` Nothing+        fileToSpec "" ("Foo" </> "Bar" </> "Spec.hs") `shouldBe` Nothing    describe "findSpecs" $ do     it "finds specs" $ do-      findSpecs "hspec-discover/test-data/nested-spec/Spec.hs" `shouldReturn` ["Foo.Bar.Baz","Foo.Bar","Foo"]+      let dir = "hspec-discover/test-data/nested-spec"+      findSpecs (dir </> "Spec.hs") `shouldReturn` [spec_ (dir </> "Foo/Bar/BazSpec.hs") "Foo.Bar.Baz", spec_ (dir </> "Foo/BarSpec.hs") "Foo.Bar", spec_ (dir </> "FooSpec.hs") "Foo"]    describe "driverWithFormatter" $ do     it "generates a test driver that uses a custom formatter" $ do-      driverWithFormatter False "Some.Module.formatter" "" `shouldBe` intercalate "\n" [-          "import Test.Hspec"-        , "import Test.Hspec.Runner"-        , "import qualified Some.Module"+      driverWithFormatter "Some.Module.formatter" "" `shouldBe` intercalate "\n" [+          "import qualified Some.Module"         , "main :: IO ()"         , "main = hspecWithFormatter Some.Module.formatter $ "         ]@@ -94,7 +103,9 @@    describe "importList" $ do     it "generates imports for a list of specs" $ do-      importList ["Foo", "Bar"] "" `shouldBe` unlines [+      importList [spec_ "FooSpec.hs" "Foo", spec_ "BarSpec.hs" "Bar"] "" `shouldBe` unlines [           "import qualified FooSpec"         , "import qualified BarSpec"         ]+  where+    spec_ = Run.Spec
hspec.cabal view
@@ -1,5 +1,5 @@ name:             hspec-version:          1.11.4+version:          1.12.0 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2014 Simon Hengel,@@ -66,6 +66,7 @@       Test.Hspec.Formatters       Test.Hspec.HUnit       Test.Hspec.QuickCheck+      Test.Hspec.Discover   other-modules:       Test.Hspec.Util       Test.Hspec.Compat@@ -104,10 +105,12 @@   other-modules:       Mock       Helper+      HelperSpec       Test.HspecSpec       Test.Hspec.CompatSpec       Test.Hspec.Core.QuickCheckUtilSpec       Test.Hspec.Core.TypeSpec+      Test.Hspec.DiscoverSpec       Test.Hspec.FailureReportSpec       Test.Hspec.FormattersSpec       Test.Hspec.HUnitSpec@@ -134,8 +137,10 @@     , hspec-expectations     , async -    , hspec-meta == 1.11.4+    , hspec-meta == 1.12.0     , process+    , directory+    , stringbuilder     , ghc-paths  test-suite example
src/Test/Hspec.hs view
@@ -25,6 +25,7 @@ , before , beforeAll , after+, afterAll , around , parallel , runIO@@ -44,7 +45,7 @@  -- | Combine a list of specs into a larger spec. describe :: String -> Spec -> Spec-describe label action = fromSpecList [Core.describe label [BuildSpecs $ runSpecM action]]+describe label spec = runIO (runSpecM spec) >>= fromSpecList . return . Core.describe label  -- | An alias for `describe`. context :: String -> Spec -> Spec@@ -83,7 +84,7 @@ example :: Expectation -> Expectation example = id --- | Run examples of given spec in parallel.+-- | Run spec items of given `Spec` in parallel. parallel :: Spec -> Spec parallel = mapSpecItem $ \item -> item {itemIsParallelizable = True} @@ -91,14 +92,12 @@ before :: IO () -> Spec -> Spec before action = around (action >>) --- | Run a custom action before all spec items.+-- | Run a custom action before the first spec item. beforeAll :: IO () -> Spec -> Spec-beforeAll action = fromSpecList . return . BuildSpecs . go-  where-    go spec = do-      mvar <- newMVar Nothing-      let action_ = memoize mvar action-      runSpecM $ before action_ 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@@ -110,6 +109,10 @@ -- | Run a custom action after every spec item. after :: IO () -> Spec -> Spec after action = around (`finally` action)++-- | Run a custom action after the last spec item.+afterAll :: IO () -> Spec -> Spec+afterAll action spec = runIO (runSpecM spec) >>= fromSpecList . return . SpecWithCleanup action  -- | Run a custom action before and/or after every spec item. around :: (IO () -> IO ()) -> Spec -> Spec
src/Test/Hspec/Config.hs view
@@ -1,5 +1,6 @@ module Test.Hspec.Config (   Config (..)+, ColorMode(..) , defaultConfig , getConfig , configAddFilter@@ -7,55 +8,15 @@ ) where  import           Control.Applicative-import           Data.List-import           Data.Maybe import           System.IO import           System.Exit import qualified Test.QuickCheck as QC-import           Test.Hspec.Formatters  import           Test.Hspec.Util import           Test.Hspec.Options import           Test.Hspec.FailureReport import           Test.Hspec.Core.QuickCheckUtil (mkGen) -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.-, configFilterPredicate :: Maybe (Path -> Bool)-, configQuickCheckSeed :: Maybe Integer-, configQuickCheckMaxSuccess :: Maybe Int-, configQuickCheckMaxDiscardRatio :: Maybe Int-, configQuickCheckMaxSize :: Maybe Int-, configSmallCheckDepth :: Int-, configColorMode       :: ColorMode-, configFormatter       :: Formatter-, configHtmlOutput      :: Bool-, configHandle          :: Either Handle FilePath-}--defaultConfig :: Config-defaultConfig = Config {-  configDryRun = False-, configPrintCpuTime = False-, configFastFail = False-, configFilterPredicate = Nothing-, configQuickCheckSeed = Nothing-, configQuickCheckMaxSuccess = Nothing-, configQuickCheckMaxDiscardRatio = Nothing-, configQuickCheckMaxSize = Nothing-, configSmallCheckDepth = 5-, configColorMode = ColorAuto-, configFormatter = specdoc-, configHtmlOutput = False-, configHandle = Left stdout-}- -- | Add a filter predicate to config.  If there is already a filter predicate, -- then combine them with `||`. configAddFilter :: (Path -> Bool) -> Config -> Config@@ -63,37 +24,22 @@     configFilterPredicate = Just p1 `filterOr` configFilterPredicate c   } -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_--mkConfig :: Maybe FailureReport -> Options -> Config-mkConfig mFailureReport opts = Config {-    configDryRun          = optionsDryRun opts-  , configPrintCpuTime    = optionsPrintCpuTime opts-  , configFastFail        = optionsFastFail opts-  , configFilterPredicate = matchFilter `filterOr` rerunFilter+mkConfig :: Maybe FailureReport -> Config -> Config+mkConfig mFailureReport opts = opts {+    configFilterPredicate = matchFilter `filterOr` rerunFilter   , configQuickCheckSeed = mSeed   , configQuickCheckMaxSuccess = mMaxSuccess   , configQuickCheckMaxDiscardRatio = mMaxDiscardRatio   , configQuickCheckMaxSize = mMaxSize-  , configSmallCheckDepth = fromMaybe (configSmallCheckDepth defaultConfig) (optionsDepth opts)-  , configColorMode       = optionsColorMode opts-  , configFormatter       = optionsFormatter opts-  , configHtmlOutput      = optionsHtmlOutput opts-  , configHandle          = maybe (configHandle defaultConfig) Right (optionsOutputFile opts)   }   where -    mSeed = optionsSeed opts <|> (failureReportSeed <$> mFailureReport)-    mMaxSuccess = optionsMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport)-    mMaxSize = optionsMaxSize opts <|> (failureReportMaxSize <$> mFailureReport)-    mMaxDiscardRatio = optionsMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport)+    mSeed = configQuickCheckSeed opts <|> (failureReportSeed <$> mFailureReport)+    mMaxSuccess = configQuickCheckMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport)+    mMaxSize = configQuickCheckMaxSize opts <|> (failureReportMaxSize <$> mFailureReport)+    mMaxDiscardRatio = configQuickCheckMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport) -    matchFilter = case optionsMatch opts of-      [] -> Nothing-      xs -> Just $ foldl1' (\p0 p1 path -> p0 path || p1 path) (map filterPredicate xs)+    matchFilter = configFilterPredicate opts      rerunFilter = flip elem . failureReportPaths <$> mFailureReport @@ -118,12 +64,12 @@     setSeed :: Integer -> QC.Args -> QC.Args     setSeed n args = args {QC.replay = Just (mkGen (fromIntegral n), 0)} -getConfig :: Options -> String -> [String] -> IO Config+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 optionsRerun opts then readFailureReport else return Nothing+      r <- if configRerun opts then readFailureReport else return Nothing       return (mkConfig r opts)  exitWithMessage :: ExitCode -> String -> IO a
src/Test/Hspec/Core.hs view
@@ -19,7 +19,10 @@  -- * Internal representation of a spec tree , SpecTree (..)+, mapSpecTree , Item (..)+, Location (..)+, LocationAccuracy(..) , mapSpecItem , modifyParams , describe
src/Test/Hspec/Core/Type.hs view
@@ -5,8 +5,11 @@ , runSpecM , fromSpecList , SpecTree (..)+, mapSpecTree , Item (..) , mapSpecItem+, Location (..)+, LocationAccuracy(..) , Example (..) , Result (..) , Params (..)@@ -89,23 +92,38 @@ -- | Internal representation of a spec. data SpecTree =     SpecGroup String [SpecTree]-  | BuildSpecs (IO [SpecTree])-  | SpecItem String Item+  | SpecWithCleanup (IO ()) [SpecTree]+  | SpecItem Item  data Item = Item {-  itemIsParallelizable :: Bool+  itemRequirement :: String+, itemLocation :: Maybe Location+, itemIsParallelizable :: Bool , itemExample :: Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result } +mapSpecTree :: (SpecTree -> SpecTree) -> Spec -> Spec+mapSpecTree f spec = runIO (runSpecM spec) >>= fromSpecList . map f+ mapSpecItem :: (Item -> Item) -> Spec -> Spec-mapSpecItem f = fromSpecList . return . BuildSpecs . fmap (map go) . runSpecM+mapSpecItem f = mapSpecTree go   where     go :: SpecTree -> SpecTree     go spec = case spec of-      SpecItem r item -> SpecItem r (f item)-      BuildSpecs es -> BuildSpecs (map go <$> es)-      SpecGroup d es -> SpecGroup d (map go es)+      SpecGroup d xs -> SpecGroup d (map go xs)+      SpecWithCleanup cleanup xs -> SpecWithCleanup cleanup (map go xs)+      SpecItem item -> SpecItem (f item) +data LocationAccuracy = ExactLocation | BestEffort+  deriving (Eq, Show)++data Location = Location {+  locationFile :: String+, locationLine :: Int+, locationColumn :: Int+, locationAccuracy :: LocationAccuracy+} deriving (Eq, Show)+ -- | The @describe@ function combines a list of specs into a larger spec. describe :: String -> [SpecTree] -> SpecTree describe s = SpecGroup msg@@ -116,9 +134,9 @@  -- | Create a spec item. it :: Example a => String -> a -> SpecTree-it s e = SpecItem msg $ Item False (evaluateExample e)+it s e = SpecItem $ Item requirement Nothing False (evaluateExample e)   where-    msg+    requirement       | null s = "(unspecified behavior)"       | otherwise = s
+ src/Test/Hspec/Discover.hs view
@@ -0,0 +1,82 @@+module Test.Hspec.Discover {-# WARNING+  "This module is used by @hspec-discover@.  It is not part of the public API and may change at any time."+  #-} (Spec, hspec, hspecWithFormatter, postProcessSpec, describe) where++import           Control.Applicative+import           Data.Maybe+import           Data.List+import           Data.Traversable hiding (mapM)+import           Control.Monad.Trans.State++import           Test.Hspec+import           Test.Hspec.Core.Type hiding (describe)+import           Test.Hspec.Runner+import           Test.Hspec.Runner.Tree+import           Test.Hspec.Formatters+import           Test.Hspec.Util++hspecWithFormatter :: IsFormatter a => a -> Spec -> IO ()+hspecWithFormatter formatter spec = do+  f <- toFormatter formatter+  hspecWith defaultConfig {configFormatter = Just f} spec++postProcessSpec :: FilePath -> Spec -> Spec+postProcessSpec = locationHeuristicFromFile++locationHeuristicFromFile :: FilePath -> Spec -> Spec+locationHeuristicFromFile file spec = do+  mInput <- either (const Nothing) Just <$> (runIO . safeTry . readFile) file+  let lookupLoc = maybe (\_ _ _ -> Nothing) (lookupLocation file)  mInput+  runIO (toTree spec) >>= fromTree . addLoctions lookupLoc++addLoctions :: (Int -> Int -> String -> Maybe Location) -> [Tree Item] -> [Tree Item]+addLoctions lookupLoc = map (fmap f) . enumerate+  where+    f :: ((Int, Int), Item) -> Item+    f ((n, total), item) = item {itemLocation = itemLocation item <|> lookupLoc n total (itemRequirement item)}++type EnumerateM = State [(String, Int)]++enumerate :: [Tree Item] -> [Tree ((Int, Int), Item)]+enumerate tree = (mapM (traverse addPosition) tree >>= mapM (traverse addTotal)) `evalState` []+  where+    addPosition :: Item -> EnumerateM (Int, Item)+    addPosition item = (,) <$> getOccurrence (itemRequirement item) <*> pure item++    addTotal :: (Int, Item) -> EnumerateM ((Int, Int), Item)+    addTotal (n, item) = do+      total <- getTotal (itemRequirement item)+      return ((n, total), item)++    getTotal :: String -> EnumerateM Int+    getTotal requirement = do+      gets $ fromMaybe err . lookup requirement+      where+        err = error ("Test.Hspec.Discover.getTotal: No entry for requirement " ++ show requirement ++ "!")++    getOccurrence :: String -> EnumerateM Int+    getOccurrence requirement = do+      xs <- get+      let n = maybe 1 succ (lookup requirement xs)+      put ((requirement, n) : filter ((/= requirement) . fst) xs)+      return n++lookupLocation :: FilePath -> String -> Int -> Int -> String -> Maybe Location+lookupLocation file input n total requirement = loc+  where+    loc :: Maybe Location+    loc = Location file <$> line <*> pure 0 <*> pure BestEffort++    line :: Maybe Int+    line = case occurrences of+      xs | length xs == total -> Just (xs !! pred n)+      _ -> Nothing++    occurrences :: [Int]+    occurrences = map fst (filter p inputLines)+      where+        p :: (Int, String) -> Bool+        p = isInfixOf (show requirement) . snd++    inputLines :: [(Int, String)]+    inputLines = zip [1..] (lines input)
src/Test/Hspec/Formatters.hs view
@@ -41,6 +41,7 @@ , newParagraph  -- ** Dealing with colors+, withInfoColor , withSuccessColor , withPendingColor , withFailColor@@ -61,8 +62,10 @@  import           Data.Maybe import           Test.Hspec.Util+import           Test.Hspec.Core.Type (Location(..), LocationAccuracy(..)) import           Text.Printf-import           Control.Monad (unless, forM_)+import           Control.Monad (when, unless)+import           Data.Foldable (forM_) import           Control.Applicative import           System.IO (hPutStr, hFlush) @@ -91,6 +94,7 @@   , writeLine   , newParagraph +  , withInfoColor   , withSuccessColor   , withPendingColor   , withFailColor@@ -108,7 +112,7 @@ silent :: Formatter silent = Formatter {   headerFormatter     = return ()-, exampleGroupStarted = \_ _ _ -> return ()+, exampleGroupStarted = \_ _ -> return () , exampleGroupDone    = return () , exampleProgress     = \_ _ _ -> return () , exampleSucceeded    = \_ -> return ()@@ -125,17 +129,9 @@   headerFormatter = do     writeLine "" -, exampleGroupStarted = \n nesting name -> do--    -- separate groups with an empty line-    unless (n == 0) $ do-      newParagraph-+, exampleGroupStarted = \nesting name -> do     writeLine (indentationFor nesting ++ name) -, exampleGroupDone = do-    newParagraph- , exampleProgress = \h _ p -> do     hPutStr h (formatProgress p)     hFlush h@@ -178,26 +174,45 @@  defaultFailedFormatter :: FormatM () defaultFailedFormatter = do-  newParagraph+  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 path reason) = do+    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
src/Test/Hspec/Formatters/Internal.hs view
@@ -21,6 +21,7 @@ , writeLine , newParagraph +, withInfoColor , withSuccessColor , withPendingColor , withFailColor@@ -36,7 +37,7 @@  import qualified System.IO as IO import           System.IO (Handle)-import           Control.Monad (when, unless)+import           Control.Monad import           Control.Applicative import           Control.Exception (SomeException, AsyncException(..), bracket_, try, throwIO) import           System.Console.ANSI@@ -47,7 +48,7 @@  import           Test.Hspec.Util (Path) import           Test.Hspec.Compat-import           Test.Hspec.Core.Type (Progress)+import           Test.Hspec.Core.Type (Progress, Location)  -- | A lifted version of `Control.Monad.Trans.State.gets` gets :: (FormatterState -> a) -> FormatM a@@ -63,7 +64,6 @@   stateHandle     :: Handle , stateUseColor   :: Bool , produceHTML     :: Bool-, lastIsEmptyLine :: Bool    -- True, if last line was empty , successCount    :: Int , pendingCount    :: Int , failCount       :: Int@@ -90,7 +90,7 @@ 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_ False 0 0 0 [] seed cpuTime time)+  st <- newIORef (FormatterState handle useColor produceHTML_ 0 0 0 [] seed cpuTime time)   evalStateT action st  -- | Increase the counter for successful examples@@ -122,15 +122,16 @@ getTotalCount = gets totalCount  -- | Append to the list of accumulated failure messages.-addFailMessage :: Path -> Either SomeException String -> FormatM ()-addFailMessage p m = modify $ \s -> s {failMessages = FailureRecord p m : failMessages s}+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 {-  failureRecordPath     :: Path+  failureRecordLocation :: Maybe Location+, failureRecordPath     :: Path , failureRecordMessage  :: Either SomeException String } @@ -141,7 +142,7 @@ -- | evaluated before each test group -- -- The given number indicates the position within the parent group.-, exampleGroupStarted :: Int -> [String] -> String -> FormatM ()+, exampleGroupStarted :: [String] -> String -> FormatM ()  , exampleGroupDone    :: FormatM () @@ -171,21 +172,14 @@ -- -- Calling this multiple times has the same effect as calling it once. newParagraph :: FormatM ()-newParagraph = do-  f <- gets lastIsEmptyLine-  unless f $ do-    writeLine ""-    setLastIsEmptyLine True--setLastIsEmptyLine :: Bool -> FormatM ()-setLastIsEmptyLine f = modify $ \s -> s {lastIsEmptyLine = f}+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-  setLastIsEmptyLine False  -- | The same as `write`, but adds a newline character. writeLine :: String -> FormatM ()@@ -205,6 +199,11 @@ -- 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
src/Test/Hspec/Options.hs view
@@ -1,14 +1,14 @@ module Test.Hspec.Options (-  Options (..)+  Config(..) , ColorMode (..)-, defaultOptions+, defaultConfig+, filterOr , parseOptions---- exported to silence warnings-, Arg (..) ) where +import           Control.Applicative import           Data.List+import           System.IO import           System.Exit import           System.Console.GetOpt @@ -16,47 +16,71 @@ import           Test.Hspec.Compat import           Test.Hspec.Util -data Options = Options {-  optionsDryRun       :: Bool-, optionsPrintCpuTime :: Bool-, optionsRerun        :: Bool-, optionsFastFail     :: Bool-, optionsMatch        :: [String]-, optionsMaxSuccess   :: Maybe Int-, optionsDepth        :: Maybe Int-, optionsSeed         :: Maybe Integer-, optionsMaxSize      :: Maybe Int-, optionsMaxDiscardRatio :: Maybe Int-, optionsColorMode    :: ColorMode-, optionsFormatter    :: Formatter-, optionsHtmlOutput   :: Bool-, optionsOutputFile   :: Maybe FilePath+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 } -addMatch :: String -> Options -> Options-addMatch s c = c {optionsMatch = s : optionsMatch c}+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+} -setDepth :: Int -> Options -> Options-setDepth n c = c {optionsDepth = Just n}+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_ -setMaxSuccess :: Int -> Options -> Options-setMaxSuccess n c = c {optionsMaxSuccess = Just n}+addMatch :: String -> Config -> Config+addMatch s c = c {configFilterPredicate = Just (filterPredicate s) `filterOr` configFilterPredicate c} -setMaxSize :: Int -> Options -> Options-setMaxSize n c = c {optionsMaxSize = Just n}+setDepth :: Int -> Config -> Config+setDepth n c = c {configSmallCheckDepth = n} -setMaxDiscardRatio :: Int -> Options -> Options-setMaxDiscardRatio n c = c {optionsMaxDiscardRatio = Just n}+setMaxSuccess :: Int -> Config -> Config+setMaxSuccess n c = c {configQuickCheckMaxSuccess = Just n} -setSeed :: Integer -> Options -> Options-setSeed n c = c {optionsSeed = 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) -defaultOptions :: Options-defaultOptions = Options False False False False [] Nothing Nothing Nothing Nothing Nothing ColorAuto specdoc False Nothing- formatters :: [(String, Formatter)] formatters = [     ("specdoc", specdoc)@@ -68,14 +92,14 @@ formatHelp :: String formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters) -type Result = Either NoConfig Options+type Result = Either NoConfig Config  data NoConfig = Help | InvalidArgument String String  data Arg a = Arg {-  argumentName   :: String-, argumentParser :: String -> Maybe a-, argumentSetter :: a -> Options -> Options+  _argumentName   :: String+, _argumentParser :: String -> Maybe a+, _argumentSetter :: a -> Config -> Config }  mkOption :: [Char] -> String -> Arg a -> String -> OptDescr (Result -> Result)@@ -113,18 +137,18 @@     readFormatter :: String -> Maybe Formatter     readFormatter = (`lookup` formatters) -    setFormatter :: Formatter -> Options -> Options-    setFormatter f c = c {optionsFormatter = f}+    setFormatter :: Formatter -> Config -> Config+    setFormatter f c = c {configFormatter = Just f} -    setOutputFile :: String -> Options -> Options-    setOutputFile file c = c {optionsOutputFile = Just file}+    setOutputFile :: String -> Config -> Config+    setOutputFile file c = c {configOutputFile = Right file} -    setPrintCpuTime x = x >>= \c -> return c {optionsPrintCpuTime = True}-    setDryRun       x = x >>= \c -> return c {optionsDryRun       = True}-    setFastFail     x = x >>= \c -> return c {optionsFastFail     = True}-    setRerun        x = x >>= \c -> return c {optionsRerun = True}-    setNoColor      x = x >>= \c -> return c {optionsColorMode = ColorNever}-    setColor        x = x >>= \c -> return c {optionsColorMode = ColorAlways}+    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 = [@@ -140,9 +164,9 @@   ]   where     setHtml :: Result -> Result-    setHtml x = x >>= \c -> return c {optionsHtmlOutput = True}+    setHtml x = x >>= \c -> return c {configHtmlOutput = True} -parseOptions :: Options -> String -> [String] -> Either (ExitCode, String) Options+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)
src/Test/Hspec/Runner.hs view
@@ -3,8 +3,9 @@ module Test.Hspec.Runner ( -- * Running a spec   hspec-, hspecResult , hspecWith+, hspecResult+, hspecWithResult  -- * Types , Summary (..)@@ -13,9 +14,6 @@ , Path , defaultConfig , configAddFilter---- * Internals-, hspecWithFormatter ) where  import           Control.Monad@@ -40,35 +38,50 @@ import           Test.Hspec.FailureReport import           Test.Hspec.Core.QuickCheckUtil -import           Test.Hspec.Options (Options(..), ColorMode(..), defaultOptions) import           Test.Hspec.Runner.Tree import           Test.Hspec.Runner.Eval  -- | Filter specs by given predicate. -- -- The predicate takes a list of "describe" labels and a "requirement".-filterSpecs :: (Path -> Bool) -> [Tree a] -> [Tree a]-filterSpecs p = goSpecs []+filterSpecs :: Config -> [Tree Item] -> [Tree Item]+filterSpecs c = go []   where-    goSpecs groups = mapMaybe (goSpec groups)+    p :: Path -> Bool+    p = fromMaybe (const True) (configFilterPredicate c) +    go :: [String] -> [Tree Item] -> [Tree Item]+    go groups = mapMaybe (goSpec groups)++    goSpecs :: [String] -> [Tree Item] -> ([Tree Item] -> a) -> Maybe a+    goSpecs groups specs ctor = case go groups specs of+      [] -> Nothing+      xs -> Just (ctor xs)++    goSpec :: [String] -> Tree Item -> Maybe (Tree Item)     goSpec groups spec = case spec of-      Leaf requirement _ -> guard (p (groups, requirement)) >> return spec-      Node group specs -> case goSpecs (groups ++ [group]) specs of-        [] -> Nothing-        xs -> Just (Node group xs)+      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 -> [Tree Item] -> [Tree Item]+applyDryRun c+  | configDryRun c = map (removeCleanup . fmap markSuccess)+  | otherwise = id+  where+    markSuccess :: Item -> Item+    markSuccess item = item {itemExample = evaluateExample Success}++    removeCleanup :: Tree Item -> Tree Item+    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 = hspecWithOptions defaultOptions---- | This function is used by @hspec-discover@.  It is not part of the public--- API and may change at any time.-hspecWithFormatter :: IsFormatter a => a -> Spec -> IO ()-hspecWithFormatter formatter spec = do-  f <- toFormatter formatter-  hspecWithOptions defaultOptions {optionsFormatter = f} spec+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.@@ -81,14 +94,10 @@  -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible.-hspecWithOptions :: Options -> Spec -> IO ()-hspecWithOptions opts spec = do-  prog <- getProgName-  args <- getArgs-  c <- getConfig opts prog args-  withArgs [] {- do not leak command-line arguments to examples -} $ do-    r <- hspecWith c spec-    unless (summaryFailures r == 0) exitFailure+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. --@@ -96,44 +105,45 @@ -- items.  If you need this, you have to check the `Summary` yourself and act -- accordingly. hspecResult :: Spec -> IO Summary-hspecResult = hspecWith defaultConfig+hspecResult = hspecWithResult defaultConfig  -- | Run given spec with custom options and returns a summary of the test run. ----- /Note/: `hspecWith` does not exit with `exitFailure` on failing spec+-- /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.-hspecWith :: Config -> Spec -> IO Summary-hspecWith c_ spec_ = withHandle c_ $ \h -> do-  c <- ensureSeed c_-  let formatter = configFormatter c-      seed = (fromJust . configQuickCheckSeed) c-      qcArgs = configQuickCheckArgs c-      spec-        | configDryRun c = mapSpecItem markSuccess spec_-        | otherwise      = spec_+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 <- maybe id filterSpecs (configFilterPredicate c) <$> toTree spec+    useColor <- doesUseColor h c -  withHiddenCursor useColor h $-    runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do-      runFormatter useColor h c formatter filteredSpec `finally_` do-        failedFormatter formatter+    filteredSpec <- filterSpecs c . applyDryRun c <$> toTree spec -      footerFormatter formatter+    withHiddenCursor useColor h $+      runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do+        runFormatter useColor h c formatter filteredSpec `finally_` do+          failedFormatter 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-        }+        footerFormatter formatter -      Summary <$> getTotalCount <*> getFailCount+        -- 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@@ -147,15 +157,12 @@       ColorAlways -> return True      withHandle :: Config -> (Handle -> IO a) -> IO a-    withHandle c action = case configHandle c of+    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"--markSuccess :: Item -> Item-markSuccess item = item {itemExample = evaluateExample Success}  -- | Summary of a test run. data Summary = Summary {
src/Test/Hspec/Runner/Eval.hs view
@@ -18,33 +18,29 @@ import           Test.Hspec.Timer import           Data.Time.Clock.POSIX -type EvalTree = Tree (ProgressCallback -> FormatResult -> IO (FormatM ()))+type EvalTree = Tree (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))  -- | Evaluate all examples of a given spec and produce a report. runFormatter :: Bool -> Handle -> Config -> Formatter -> [Tree Item] -> FormatM ()-runFormatter useColor h c formatter specs_ = do+runFormatter useColor h c formatter specs = do   headerFormatter formatter   chan <- liftIO newChan   reportProgress <- liftIO mkReportProgress-  run chan reportProgress c formatter specs+  run chan reportProgress c formatter (toEvalTree specs)   where     mkReportProgress :: IO (Path -> Progress -> IO ())     mkReportProgress       | useColor = every 0.05 $ exampleProgress formatter h       | otherwise = return $ \_ _ -> return () -    specs = map (fmap (parallelize . fmap (applyNoOpAround . applyParams) . unwrapItem)) specs_--    unwrapItem :: Item -> (Bool, Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result)-    unwrapItem (Item isParallelizable e) = (isParallelizable, e)--    applyParams :: (Params -> a) -> a-    applyParams = ($ params)+    toEvalTree :: [Tree Item] -> [EvalTree]+    toEvalTree = map (fmap f)       where-        params = Params (configQuickCheckArgs c) (configSmallCheckDepth c)+        f :: Item -> (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))+        f (Item requirement loc isParallelizable e) = (requirement, loc, parallelize isParallelizable $ e params id) -    applyNoOpAround :: ((IO () -> IO ()) -> b) -> b-    applyNoOpAround = ($ id)+    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 ())@@ -56,8 +52,8 @@  type FormatResult = Either E.SomeException Result -> FormatM () -parallelize :: (Bool, ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())-parallelize (isParallelizable, e)+parallelize :: Bool -> (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())+parallelize isParallelizable e   | isParallelizable = runParallel e   | otherwise = runSequentially e @@ -86,8 +82,8 @@           evalReport mvar         ReportResult result -> formatResult result -replaceMVar :: MVar a -> a -> IO ()-replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p+    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@@ -97,24 +93,35 @@ run :: Chan Message -> (Path -> ProgressCallback) -> Config -> Formatter -> [EvalTree] -> FormatM () run chan reportProgress_ c formatter specs = do   liftIO $ do-    forM_ (zip [0..] specs) (queueSpec [])+    forM_ specs (queueSpec [])     writeChan chan Done   processMessages (readChan chan) (configFastFail c)   where     defer :: FormatM () -> IO ()     defer = writeChan chan . Run -    queueSpec :: [String] -> (Int, EvalTree) -> IO ()-    queueSpec rGroups (n, Node group xs) = do-      defer (exampleGroupStarted formatter n (reverse rGroups) group)-      forM_ (zip [0..] xs) (queueSpec (group : rGroups))+    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 (_, Leaf requirement e) =-      queueExample (reverse rGroups, requirement) e+    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 :: Path -> (ProgressCallback -> FormatResult -> IO (FormatM ())) -> IO ()-    queueExample path e = e reportProgress formatResult >>= defer+    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 ()@@ -126,13 +133,13 @@             Right (Pending reason) -> do               increasePendingCount               examplePending formatter path reason-            Right (Fail err) -> failed (Right err)-            Left err         -> failed (Left  err)-          where-            failed err = do-              increaseFailCount-              addFailMessage path err-              exampleFailed formatter path err+            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
src/Test/Hspec/Runner/Tree.hs view
@@ -1,18 +1,31 @@-{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} module Test.Hspec.Runner.Tree where  import           Control.Applicative+import           Data.Foldable (Foldable)+import           Data.Traversable (Traversable) import           Test.Hspec.Core.Type  data Tree a   = Node !String [Tree a]-  | Leaf !String a-  deriving (Eq, Show, Functor)+  | NodeWithCleanup (IO ()) [Tree a]+  | Leaf a+  deriving (Functor, Foldable, Traversable)  toTree :: Spec -> IO [Tree Item]-toTree spec = concat <$> (runSpecM spec >>= mapM go)+toTree spec = map f <$> runSpecM spec   where+    f :: SpecTree -> Tree Item+    f x = case x of+      SpecGroup label xs -> Node label (map f xs)+      SpecWithCleanup cleanup xs -> NodeWithCleanup cleanup (map f xs)+      SpecItem item -> Leaf item++fromTree :: [Tree Item] -> Spec+fromTree = fromSpecList . map go+  where+    go :: Tree Item -> SpecTree     go x = case x of-      SpecGroup label xs -> return . Node label . concat <$> mapM go xs-      BuildSpecs xs -> concat <$> (xs >>= mapM go)-      SpecItem r item -> return [Leaf r item]+      Node label xs -> SpecGroup label (map go xs)+      NodeWithCleanup action xs -> SpecWithCleanup action (map go xs)+      Leaf item -> SpecItem item
test/Helper.hs view
@@ -12,11 +12,14 @@  , ignoreExitCode , ignoreUserInterrupt+, throwException  , shouldStartWith , shouldEndWith  , shouldUseArgs++, withFileContent ) where  import           Data.List@@ -29,6 +32,8 @@ import           Control.Concurrent import qualified Control.Exception as E import qualified System.Timeout as System+import           System.IO+import           System.Directory import           Data.Time.Clock.POSIX import           System.IO.Silently @@ -40,6 +45,9 @@ import qualified Test.Hspec.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 () @@ -84,3 +92,11 @@         H.it "foo" False   (silence . ignoreExitCode . withArgs args . H.hspec) spec   readIORef spy >>= (`shouldSatisfy` p)++withFileContent :: String -> (FilePath -> IO a) -> IO a+withFileContent input action = do+  dir <- getTemporaryDirectory+  (file, h) <- openTempFile dir "temp"+  hPutStr h input+  hClose h+  action file `E.finally` removeFile file
+ test/HelperSpec.hs view
@@ -0,0 +1,18 @@+module HelperSpec (main, spec) where++import           Helper+import           System.IO.Error (isDoesNotExistError)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "withFileContent" $ do+    it "creates a file with specified content and runs specified action" $ do+      withFileContent "foo" $ \file -> do+        readFile file `shouldReturn` "foo"++    it "removes file after action has been run" $ do+      file <- withFileContent "foo" return+      readFile file `shouldThrow` isDoesNotExistError
+ test/Test/Hspec/DiscoverSpec.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}+module Test.Hspec.DiscoverSpec (main, spec) where++import           Helper+import           Data.String+import           Data.String.Builder++import qualified Test.Hspec as H (it)+import           Test.Hspec.Core (Item(..), Location(..), LocationAccuracy(..))+import           Test.Hspec.Runner.Tree+import qualified Test.Hspec.Discover as H++infix 1 `shouldHaveLocation`++shouldHaveLocation :: Item -> (String, Int) -> Expectation+item `shouldHaveLocation` (src, line) = itemLocation item `shouldBe` Just (Location src line 0 BestEffort)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "postProcessSpec" $ do+    it "adds heuristic source locations" $ do+      let c = build $ do+            ""+            strlit "foo"+            ""+            strlit "bar"+            ""+            strlit "baz"+      withFileContent c $ \src -> do+        [Leaf item1, Leaf item2, Leaf item3] <- toTree . H.postProcessSpec src $ do+          H.it "foo" True+          H.it "bar" True+          H.it "baz" True+        item1 `shouldHaveLocation` (src, 2)+        item2 `shouldHaveLocation` (src, 4)+        item3 `shouldHaveLocation` (src, 6)++    context "when same requirement is used multiple times" $ do+      it "assigns locations sequentially" $ do+        let c = build $ do+              strlit "foo"+              strlit "foo"+              strlit "foo"+        withFileContent c $ \src -> do+          [Leaf item1, Leaf item2, Leaf item3] <- toTree . H.postProcessSpec src $ do+            H.it "foo" True+            H.it "foo" True+            H.it "foo" True+          item1 `shouldHaveLocation` (src, 1)+          item2 `shouldHaveLocation` (src, 2)+          item3 `shouldHaveLocation` (src, 3)++      context "when a requirement occurs more often in the spec tree than in the source file" $ do+        it "assigns Nothing" $ do+          let c = build $ do+                strlit "foo"+                strlit "foo"+          withFileContent c $ \src -> do+            [Leaf item1, Leaf item2, Leaf item3] <- toTree . H.postProcessSpec src $ do+              H.it "foo" True+              H.it "foo" True+              H.it "foo" True+            itemLocation item1 `shouldBe` Nothing+            itemLocation item2 `shouldBe` Nothing+            itemLocation item3 `shouldBe` Nothing+  where+    strlit :: String -> Builder+    strlit = fromString . show
test/Test/Hspec/FormattersSpec.hs view
@@ -4,7 +4,7 @@ import           Helper  import qualified Test.Hspec as H-import qualified Test.Hspec.Core as H (Result(..))+import qualified Test.Hspec.Core as H (Result(..), Location(..), LocationAccuracy(..), Item(..), mapSpecItem) import qualified Test.Hspec.Runner as H import qualified Test.Hspec.Formatters as H @@ -28,7 +28,7 @@ spec :: Spec spec = do   describe "silent" $ do-    let runSpec = fmap fst . capture . H.hspecWith H.defaultConfig {H.configFormatter = H.silent}+    let runSpec = fmap fst . capture . H.hspecWithResult H.defaultConfig {H.configFormatter = Just H.silent}     it "produces no output" $ do       runSpec testSpec `shouldReturn` "" @@ -36,7 +36,7 @@     failed_examplesSpec H.failed_examples    describe "progress" $ do-    let runSpec = captureLines . H.hspecWith H.defaultConfig {H.configFormatter = H.progress}+    let runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormatter = Just H.progress}      it "produces '..F...FF.F' style output" $ do       r <- runSpec testSpec@@ -46,7 +46,7 @@       failed_examplesSpec H.progress    describe "specdoc" $ do-    let runSpec = captureLines . H.hspecWith H.defaultConfig {H.configFormatter = H.specdoc}+    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@@ -71,15 +71,12 @@         , "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"@@ -88,50 +85,6 @@         , "6 examples, 0 failures"         ] -    it "prints an empty line before each group" $ do-      r <- runSpec $ do-        H.describe "foo" $ do-          H.it "example 1" True-          H.it "example 2" True-          H.describe "bar" $ do-            H.it "example 3" True-            H.it "example 4" True-      normalizeSummary r `shouldBe` [-          ""-        , "foo"-        , "  - example 1"-        , "  - example 2"-        , ""-        , "  bar"-        , "    - example 3"-        , "    - example 4"-        , ""-        , "Finished in 0.0000 seconds"-        , "4 examples, 0 failures"-        ]--    it "prints an empty line after each group" $ do-      r <- runSpec $ do-        H.describe "foo" $ do-          H.describe "bar" $ do-            H.it "example 1" True-            H.it "example 2" True-          H.it "example 3" True-          H.it "example 4" True-      normalizeSummary r `shouldBe` [-          ""-        , "foo"-        , "  bar"-        , "    - example 1"-        , "    - example 2"-        , ""-        , "  - example 3"-        , "  - example 4"-        , ""-        , "Finished in 0.0000 seconds"-        , "4 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@@ -154,12 +107,33 @@       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.hspecWith H.defaultConfig {H.configFormatter = formatter}+  let runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormatter = Just formatter}    it "summarizes the time it takes to finish" $ do     r <- runSpec (return ())@@ -185,6 +159,40 @@             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")@@ -193,22 +201,22 @@   -- 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.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ 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.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ 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.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ 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.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ 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))
test/Test/Hspec/HUnitSpec.hs view
@@ -1,7 +1,9 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.HUnitSpec (main, spec) where  import           Helper hiding (example) +import           Test.Hspec.Core (Item(..)) import           Test.Hspec.Runner.Tree import           Test.Hspec.HUnit import           Test.HUnit@@ -9,32 +11,35 @@ main :: IO () main = hspec spec -shouldYield :: Test -> [Tree ()] -> Expectation-a `shouldYield` b = map (() <$) <$> toTree (fromHUnitTest a) `shouldReturn` b+shouldYield :: Test -> [Tree String] -> Expectation+a `shouldYield` b = map (Blind . fmap itemRequirement) <$> toTree (fromHUnitTest a) `shouldReturn` map Blind b +instance Eq a => Eq (Tree a) where+  x == y = case (x, y) of+    (Node s1 xs, Node s2 ys) -> s1 == s2 && xs == ys+    (Leaf x1, Leaf x2) -> x1 == x2+    _ -> False+ spec :: Spec spec = do   describe "fromHUnitTest" $ do     let e = TestCase $ pure ()      it "works for a TestCase" $ do-      e `shouldYield` [example "<unlabeled>"]+      e `shouldYield` [Leaf "<unlabeled>"]      it "works for a labeled TestCase" $ do       TestLabel "foo" e-        `shouldYield` [example "foo"]+        `shouldYield` [Leaf "foo"]      it "works for a TestCase with nested labels" $ do       (TestLabel "foo" . TestLabel "bar") e-        `shouldYield` [Node "foo" [example "bar"]]+        `shouldYield` [Node "foo" [Leaf "bar"]]      it "works for a flat TestList" $ do       TestList [e, e, e]-        `shouldYield` [example "<unlabeled>", example "<unlabeled>", example "<unlabeled>"]+        `shouldYield` [Leaf "<unlabeled>", Leaf "<unlabeled>", Leaf "<unlabeled>"]      it "works for a nested TestList" $ do       (TestLabel "foo" . TestLabel "bar" . TestList) [TestLabel "one" e, TestLabel "two" e, TestLabel "three" e]-        `shouldYield` [Node "foo" [Node "bar" [example "one", example "two", example "three"]]]-  where-    example :: String -> Tree ()-    example r = Leaf r ()+        `shouldYield` [Node "foo" [Node "bar" [Leaf "one", Leaf "two", Leaf "three"]]]
test/Test/Hspec/OptionsSpec.hs view
@@ -17,22 +17,22 @@ spec = do   describe "parseOptions" $ do -    let parseOptions = Options.parseOptions defaultOptions "my-spec"+    let parseOptions = Options.parseOptions defaultConfig "my-spec" -    it "sets optionsColorMode to ColorAuto" $ do-      optionsColorMode <$> parseOptions [] `shouldBe` Right ColorAuto+    it "sets configColorMode to ColorAuto" $ do+      configColorMode <$> parseOptions [] `shouldBe` Right ColorAuto      context "with --no-color" $ do-      it "sets optionsColorMode to ColorNever" $ do-        optionsColorMode <$> parseOptions ["--no-color"] `shouldBe` Right ColorNever+      it "sets configColorMode to ColorNever" $ do+        configColorMode <$> parseOptions ["--no-color"] `shouldBe` Right ColorNever      context "with --color" $ do-      it "sets optionsColorMode to ColorAlways" $ do-        optionsColorMode <$> parseOptions ["--color"] `shouldBe` Right ColorAlways+      it "sets configColorMode to ColorAlways" $ do+        configColorMode <$> parseOptions ["--color"] `shouldBe` Right ColorAlways      context "with --out" $ do-      it "sets optionsOutputFile" $ do-        optionsOutputFile <$> parseOptions ["--out", "foo"] `shouldBe` Right (Just "foo")+      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@@ -41,4 +41,4 @@      context "with --depth" $ do       it "sets depth parameter for SmallCheck" $ do-        optionsDepth <$> parseOptions ["--depth", "23"] `shouldBe` Right (Just 23)+        configSmallCheckDepth <$> parseOptions ["--depth", "23"] `shouldBe` Right 23
test/Test/Hspec/RunnerSpec.hs view
@@ -183,8 +183,9 @@         r `shouldSatisfy` any ((78 <=) . length)      context "with --dry-run" $ do+      let withDryRun = captureLines . withArgs ["--dry-run"] . H.hspec       it "produces a report" $ do-        r <- captureLines . withArgs ["--dry-run"] . H.hspec $ do+        r <- withDryRun $ do           H.it "foo" True           H.it "bar" True         normalizeSummary r `shouldBe` [@@ -198,11 +199,18 @@        it "does not verify anything" $ do         e <- newMock-        _ <- captureLines . withArgs ["--dry-run"] . H.hspec $ do+        _ <- 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@@ -362,7 +370,7 @@      it "treats uncaught exceptions as failure" $ do       silence . H.hspecResult  $ do-        H.it "foobar" (E.throwIO (E.ErrorCall "foobar") >> pure ())+        H.it "foobar" throwException       `shouldReturn` H.Summary 1 1      it "uses the specdoc formatter by default" $ do@@ -372,7 +380,7 @@       r `shouldBe` "Foo.Bar"      it "can use a custom formatter" $ do-      r <- capture_ . H.hspecWith H.defaultConfig {H.configFormatter = H.silent} $ 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` ""
test/Test/Hspec/UtilSpec.hs view
@@ -45,8 +45,8 @@       e `shouldBe` 23      it "returns Left on exception" $ do-      Left e <- safeTry (E.throwIO E.DivideByZero :: IO Int)-      show e `shouldBe` "divide by zero"+      Left e <- safeTry throwException+      show e `shouldBe` "foobar"      it "evaluates result to weak head normal form" $ do       Left e <- safeTry (return undefined)
test/Test/HspecSpec.hs view
@@ -44,11 +44,11 @@       length r `shouldBe` 3      it "can be nested" $ do-      [Node foo [Node bar [Leaf baz _]]] <- toTree $ do+      [Node foo [Node bar [Leaf _]]] <- toTree $ do         H.describe "foo" $ do           H.describe "bar" $ do             H.it "baz" True-      (foo, bar, baz) `shouldBe` ("foo", "bar", "baz")+      (foo, bar) `shouldBe` ("foo", "bar")      context "when no description is given" $ do       it "uses a default description" $ do@@ -57,17 +57,17 @@    describe "it" $ do     it "takes a description of a desired behavior" $ do-      [Leaf requirement _] <- toTree (H.it "whatever" True)-      requirement `shouldBe` "whatever"+      [Leaf item] <- toTree (H.it "whatever" True)+      itemRequirement item `shouldBe` "whatever"      it "takes an example of that behavior" $ do-      [Leaf _ item] <- toTree (H.it "whatever" True)+      [Leaf item] <- toTree (H.it "whatever" True)       itemExample item defaultParams id noOpProgressCallback `shouldReturn` Success      context "when no description is given" $ do       it "uses a default description" $ do-        [Leaf requirement _] <- toTree (H.it "" True)-        requirement `shouldBe` "(unspecified behavior)"+        [Leaf item] <- toTree (H.it "" True)+        itemRequirement item `shouldBe` "(unspecified behavior)"    describe "example" $ do     it "fixes the type of an expectation" $ do@@ -78,11 +78,11 @@    describe "parallel" $ do     it "marks examples for parallel execution" $ do-      [Leaf _ item] <- toTree . H.parallel $ H.it "whatever" True+      [Leaf item] <- toTree . H.parallel $ H.it "whatever" True       itemIsParallelizable item `shouldBe` True      it "is applied recursively" $ do-      [Node _ [Node _ [Leaf _ item]]] <- toTree . H.parallel $ do+      [Node _ [Node _ [Leaf item]]] <- toTree . H.parallel $ do         H.describe "foo" $ do           H.describe "bar" $ do             H.it "baz" True@@ -113,7 +113,7 @@    describe "beforeAll" $ do     it "runs an action before the first spec item" $ do-      ref <- newIORef ([] :: [String])+      ref <- newIORef []       let append n = modifyIORef ref (++ return n)       silence $ H.hspec $ H.beforeAll (append "beforeAll") $ do         H.it "foo" $ do@@ -126,6 +126,14 @@         , "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` []+   describe "after" $ do     it "runs an action after each spec item" $ do       mock <- newMock@@ -142,6 +150,36 @@         H.it "foo" $ do           ioError $ userError "foo" :: IO ()       mockCounter mock `shouldReturn` 1++  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 each spec item with an action" $ do