packages feed

hspec-core 2.7.6 → 2.7.7

raw patch · 13 files changed

+290/−106 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Test.Hspec.Core.Hooks: aroundAll_ :: (IO () -> IO ()) -> SpecWith a -> SpecWith a
+ Test.Hspec.Core.Spec: filterForestWithLabels :: ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
+ Test.Hspec.Core.Spec: filterTreeWithLabels :: ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)
+ Test.Hspec.Core.Spec: pruneForest :: [Tree c a] -> [Tree c a]
+ Test.Hspec.Core.Spec: pruneTree :: Tree c a -> Maybe (Tree c a)
+ Test.Hspec.Core.Spec: safeEvaluate :: IO Result -> IO Result

Files

hspec-core.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:             hspec-core-version:          2.7.6+version:          2.7.7 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2021 Simon Hengel,
src/Test/Hspec/Core/Compat.hs view
@@ -20,6 +20,8 @@ , atomicWriteIORef #endif , interruptible++, guarded ) where  import           Control.Applicative@@ -58,6 +60,9 @@   , sequence   , sequence_   , sum+#if !MIN_VERSION_base(4,6,0)+  , catch+#endif   )  import           Data.Typeable (Typeable, typeOf, typeRepTyCon)@@ -139,3 +144,6 @@     MaskedInterruptible   -> unsafeUnmask act     MaskedUninterruptible -> act #endif++guarded :: Alternative m => (a -> Bool) -> a -> m a+guarded p a = if p a then pure a else empty
src/Test/Hspec/Core/Example.hs view
@@ -4,6 +4,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}++-- NOTE: re-exported from Test.Hspec.Core.Spec module Test.Hspec.Core.Example (   Example (..) , Params (..)@@ -15,6 +17,7 @@ , ResultStatus (..) , Location (..) , FailureReason (..)+, safeEvaluate , safeEvaluateExample ) where @@ -88,13 +91,7 @@ instance Exception ResultStatus  safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result-safeEvaluateExample example params around progress = do-  r <- safeTry $ forceResult <$> evaluateExample example params around progress-  return $ case r of-    Left e | Just result <- fromException e -> Result "" result-    Left e | Just hunit <- fromException e -> Result "" $ hunitFailureToResult Nothing hunit-    Left e -> Result "" $ Failure Nothing $ Error Nothing e-    Right result -> result+safeEvaluateExample example params around progress = safeEvaluate $ forceResult <$> evaluateExample example params around progress   where     forceResult :: Result -> Result     forceResult r@(Result info status) = info `deepseq` (forceResultStatus status) `seq` r@@ -104,6 +101,15 @@       Success -> r       Pending _ m -> m `deepseq` r       Failure _ m -> m `deepseq` r++safeEvaluate :: IO Result -> IO Result+safeEvaluate action = do+  r <- safeTry $ action+  return $ case r of+    Left e | Just result <- fromException e -> Result "" result+    Left e | Just hunit <- fromException e -> Result "" $ hunitFailureToResult Nothing hunit+    Left e -> Result "" $ Failure Nothing $ Error Nothing e+    Right result -> result  instance Example Result where   type Arg Result = ()
src/Test/Hspec/Core/Format.hs view
@@ -20,12 +20,13 @@ , itemDuration :: Seconds , itemInfo :: String , itemResult :: Result-}+} deriving Show  data Result =     Success   | Pending (Maybe String)   | Failure FailureReason+  deriving Show  data Format m = Format {   formatRun :: forall a. m a -> IO a
src/Test/Hspec/Core/Hooks.hs view
@@ -13,10 +13,15 @@ , around , around_ , aroundWith+, aroundAll_ ) where -import           Control.Exception (SomeException, finally, throwIO, try)+import           Prelude ()+import           Test.Hspec.Core.Compat++import           Control.Exception (SomeException, finally, throwIO, try, catch) import           Control.Concurrent.MVar+import           Control.Concurrent.Async  import           Test.Hspec.Core.Example import           Test.Hspec.Core.Tree@@ -98,3 +103,33 @@ modifyAroundAction :: (ActionWith a -> ActionWith b) -> Item a -> Item b modifyAroundAction action item@Item{itemExample = e} =   item{ itemExample = \params aroundAction -> e params (aroundAction . action) }++-- | Wrap an action around the given spec.+aroundAll_ :: (IO () -> IO ()) -> SpecWith a -> SpecWith a+aroundAll_ action spec = do+  startCleanup <- runIO newEmptyMVar+  workerRef <- runIO newEmptyMVar+  let+    acquire :: IO ()+    acquire = do+      acquireDone <- newEmptyMVar+      worker <- async $ do+        action $ do+          signal acquireDone+          waitFor startCleanup+      putMVar workerRef worker+      unwrapExceptionsFromLinkedThread $ do+        link worker+        waitFor acquireDone+    cleanup :: IO ()+    cleanup = signal startCleanup >> takeMVar workerRef >>= wait+  beforeAll_ acquire $ afterAll_ cleanup spec+  where+    signal :: MVar () -> IO ()+    signal = flip putMVar ()++    waitFor :: MVar () -> IO ()+    waitFor = takeMVar++    unwrapExceptionsFromLinkedThread :: IO a -> IO a+    unwrapExceptionsFromLinkedThread = (`catch` \ (ExceptionInLinkedThread _ e) -> throwIO e)
src/Test/Hspec/Core/Runner.hs view
@@ -28,6 +28,7 @@  #ifdef TEST , rerunAll+, specToEvalForest #endif ) where @@ -57,26 +58,19 @@  import           Test.Hspec.Core.Runner.Eval -filterSpecs :: Config -> [EvalTree] -> [EvalTree]-filterSpecs c = go []+applyFilterPredicates :: Config -> [EvalTree] -> [EvalTree]+applyFilterPredicates c = filterForestWithLabels p   where-    p :: Path -> Bool-    p path = (fromMaybe (const True) (configFilterPredicate c) path) &&-               not (fromMaybe (const False) (configSkipPredicate c) path)--    go :: [String] -> [EvalTree] -> [EvalTree]-    go groups = mapMaybe (goSpec groups)+    include :: Path -> Bool+    include = fromMaybe (const True) (configFilterPredicate c) -    goSpecs :: [String] -> [EvalTree] -> ([EvalTree] -> b) -> Maybe b-    goSpecs groups specs ctor = case go groups specs of-      [] -> Nothing-      xs -> Just (ctor xs)+    skip :: Path -> Bool+    skip = fromMaybe (const False) (configSkipPredicate c) -    goSpec :: [String] -> EvalTree -> Maybe (EvalTree)-    goSpec groups spec = case spec of-      Leaf item -> guard (p (groups, evalItemDescription item)) >> return spec-      Node group specs -> goSpecs (groups ++ [group]) specs (Node group)-      NodeWithCleanup action specs -> goSpecs groups specs (NodeWithCleanup action)+    p :: [String] -> EvalItem -> Bool+    p groups item = include path && not (skip path)+      where+        path = (groups, evalItemDescription item)  applyDryRun :: Config -> [EvalTree] -> [EvalTree] applyDryRun c@@ -203,6 +197,7 @@  runSpec_ :: Config -> Spec -> IO Summary runSpec_ config spec = do+  filteredSpec <- specToEvalForest config spec   withHandle config $ \h -> do     let formatter = fromMaybe specdoc (configFormatter config)         seed = (fromJust . configQuickCheckSeed) config@@ -214,16 +209,7 @@      useColor <- doesUseColor h config -    let-      focusedSpec = focusSpec config (failFocusedItems config spec)-      params = Params (configQuickCheckArgs config) (configSmallCheckDepth config)-      randomize-        | configRandomize config = randomizeForest seed-        | otherwise = id--    filteredSpec <- randomize . filterSpecs config . applyDryRun config . toEvalForest params <$> runSpecM focusedSpec--    (total, failures) <- withHiddenCursor useColor h $ do+    results <- withHiddenCursor useColor h $ do       let         formatConfig = FormatConfig {           formatConfigHandle = h@@ -240,8 +226,25 @@         }       runFormatter evalConfig filteredSpec -    dumpFailureReport config seed qcArgs failures-    return (Summary total (length failures))+    let failures = filter resultItemIsFailure results++    dumpFailureReport config seed qcArgs (map fst failures)++    return Summary {+      summaryExamples = length results+    , summaryFailures = length failures+    }++specToEvalForest :: Config -> Spec -> IO [EvalTree]+specToEvalForest config spec = do+  let+    seed = (fromJust . configQuickCheckSeed) config+    focusedSpec = focusSpec config (failFocusedItems config spec)+    params = Params (configQuickCheckArgs config) (configSmallCheckDepth config)+    randomize+      | configRandomize config = randomizeForest seed+      | otherwise = id+  randomize . pruneForest . applyFilterPredicates config . applyDryRun config . toEvalForest params <$> runSpecM focusedSpec  toEvalForest :: Params -> [SpecTree ()] -> [EvalTree] toEvalForest params = bimapForest withUnit toEvalItem . filterForest itemIsFocused
src/Test/Hspec/Core/Runner/Eval.hs view
@@ -14,6 +14,7 @@ , EvalTree , EvalItem(..) , runFormatter+, resultItemIsFailure #ifdef TEST , runSequentially #endif@@ -40,6 +41,7 @@ import qualified Test.Hspec.Core.Format as Format import           Test.Hspec.Core.Clock import           Test.Hspec.Core.Example.Location+import           Test.Hspec.Core.Example (safeEvaluate)  -- for compatibility with GHC < 7.10.1 type Monad m = (Functor m, Applicative m, M.Monad m)@@ -53,31 +55,20 @@  data State m = State {   stateConfig :: EvalConfig m-, stateSuccessCount :: Int-, statePendingCount :: Int-, stateFailures :: [Path]+, stateResults :: [(Path, Format.Item)] }  type EvalM m = StateT (State m) m -increaseSuccessCount :: Monad m => EvalM m ()-increaseSuccessCount = modify $ \state -> state {stateSuccessCount = stateSuccessCount state + 1}--increasePendingCount :: Monad m => EvalM m ()-increasePendingCount = modify $ \state -> state {statePendingCount = statePendingCount state + 1}--addFailure :: Monad m => Path -> EvalM m ()-addFailure path = modify $ \state -> state {stateFailures = path : stateFailures state}+addResult :: Monad m => Path -> Format.Item -> EvalM m ()+addResult path item = modify $ \ state -> state {stateResults = (path, item) : stateResults state}  getFormat :: Monad m => (Format m -> a) -> EvalM m a getFormat format = gets (format . evalConfigFormat . stateConfig)  reportItem :: Monad m => Path -> Format.Item -> EvalM m () reportItem path item = do-  case Format.itemResult item of-    Format.Success {} -> increaseSuccessCount-    Format.Pending {} -> increasePendingCount-    Format.Failure {} -> addFailure path+  addResult path item   format <- getFormat formatItem   lift (format path item) @@ -113,10 +104,10 @@ type EvalTree = Tree (IO ()) EvalItem  runEvalM :: Monad m => EvalConfig m -> EvalM m () -> m (State m)-runEvalM config action = execStateT action (State config 0 0 [])+runEvalM config action = execStateT action (State config [])  -- | Evaluate all examples of a given spec and produce a report.-runFormatter :: forall m. MonadIO m => EvalConfig m -> [EvalTree] -> IO (Int, [Path])+runFormatter :: forall m. MonadIO m => EvalConfig m -> [EvalTree] -> IO ([(Path, Format.Item)]) runFormatter config specs = do   let     start = parallelizeTree (evalConfigConcurrentJobs config) specs@@ -126,10 +117,7 @@       state <- formatRun format $ do         runEvalM config $           run $ map (fmap (fmap (. reportProgress timer) . snd)) runningSpecs-      let-        failures = stateFailures state-        total = stateSuccessCount state + statePendingCount state + length failures-      return (total, reverse failures)+      return (reverse $ stateResults state)   where     format = evalConfigFormat config @@ -223,8 +211,10 @@      runCleanup :: [String] -> IO () -> EvalM m ()     runCleanup groups action = do-      (dt, r) <- liftIO $ measure $ safeTry action-      either (\ e -> reportItem path . failureItem (extractLocation e) dt "" . Error Nothing $ e) return r+      r <- liftIO $ measure $ safeEvaluate (action >> return (Result "" Success))+      case r of+        (_, Result "" Success) -> return ()+        _ -> reportResult path Nothing r       where         path = (groups, "afterAll-hook") @@ -260,9 +250,18 @@ sequenceActions :: Monad m => Bool -> [EvalM m ()] -> EvalM m () sequenceActions fastFail = go   where+    go :: Monad m => [EvalM m ()] -> EvalM m ()     go [] = return ()     go (action : actions) = do-      () <- action-      hasFailures <- (not . null) <$> gets stateFailures+      action+      hasFailures <- any resultItemIsFailure <$> gets stateResults       let stopNow = fastFail && hasFailures       unless stopNow (go actions)++resultItemIsFailure :: (Path, Format.Item) -> Bool+resultItemIsFailure = isFailure . Format.itemResult . snd+  where+    isFailure r = case r of+      Format.Success{} -> False+      Format.Pending{} -> False+      Format.Failure{} -> True
src/Test/Hspec/Core/Spec/Monad.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- NOTE: re-exported from Test.Hspec.Core.Spec module Test.Hspec.Core.Spec.Monad (   Spec , SpecWith@@ -49,11 +51,11 @@ runIO :: IO r -> SpecM a r runIO = SpecM . liftIO -mapSpecTree :: (SpecTree a -> SpecTree b) -> SpecM a r -> SpecM b r-mapSpecTree f (SpecM specs) = SpecM (mapWriterT (fmap (second (map f))) specs)+mapSpecForest :: ([SpecTree a] -> [SpecTree b]) -> SpecM a r -> SpecM b r+mapSpecForest f (SpecM specs) = SpecM (mapWriterT (fmap (second f)) specs)  mapSpecItem :: (ActionWith a -> ActionWith b) -> (Item a -> Item b) -> SpecWith a -> SpecWith b-mapSpecItem g f = mapSpecTree (bimapTree g f)+mapSpecItem g f = mapSpecForest (bimapForest g f)  mapSpecItem_ :: (Item a -> Item a) -> SpecWith a -> SpecWith a mapSpecItem_ = mapSpecItem id
src/Test/Hspec/Core/Tree.hs view
@@ -4,8 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} --- |--- Stability: unstable+-- NOTE: re-exported from Test.Hspec.Core.Spec module Test.Hspec.Core.Tree (   SpecTree , Tree (..)@@ -16,6 +15,10 @@ , bimapForest , filterTree , filterForest+, filterTreeWithLabels+, filterForestWithLabels+, pruneTree+, pruneForest , location ) where @@ -49,14 +52,37 @@       NodeWithCleanup cleanup xs -> NodeWithCleanup (g cleanup) (map go xs)       Leaf item -> Leaf (f item) +filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)+filterTree = filterTreeWithLabels . const+ filterForest :: (a -> Bool) -> [Tree c a] -> [Tree c a]-filterForest = mapMaybe . filterTree+filterForest = filterForestWithLabels . const -filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)-filterTree p t = case t of-  Node s xs -> Just $ Node s (filterForest p xs)-  NodeWithCleanup c xs -> Just $ NodeWithCleanup c (filterForest p xs)-  leaf@(Leaf a) -> guard (p a) >> return leaf+filterTreeWithLabels :: ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)+filterTreeWithLabels = filterTree_ []++filterForestWithLabels :: ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]+filterForestWithLabels = filterForest_ []++filterForest_ :: [String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]+filterForest_ groups = mapMaybe . filterTree_ groups++filterTree_ :: [String] -> ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)+filterTree_ groups p tree = case tree of+  Node group xs -> Just $ Node group $ filterForest_ (groups ++ [group]) p xs+  NodeWithCleanup action xs -> Just $ NodeWithCleanup action $ filterForest_ groups p xs+  Leaf item -> Leaf <$> guarded (p groups) item++pruneForest :: [Tree c a] -> [Tree c a]+pruneForest = mapMaybe pruneTree++pruneTree :: Tree c a -> Maybe (Tree c a)+pruneTree node = case node of+  Node group xs -> Node group <$> prune xs+  NodeWithCleanup action xs -> NodeWithCleanup action <$> prune xs+  Leaf{} -> Just node+  where+    prune = guarded (not . null) . pruneForest  -- | -- @Item@ is used to represent spec items internally.  A spec item consists of:
test/Helper.hs view
@@ -41,14 +41,17 @@ import           System.Directory import           System.IO.Temp -import           Test.Hspec.Meta hiding (hspec, hspecResult)+import           Test.Hspec.Meta hiding (hspec, hspecResult, pending, pendingWith) import           Test.QuickCheck hiding (Result(..))+import qualified Test.HUnit.Lang as HUnit  import qualified Test.Hspec.Core.Spec as H import qualified Test.Hspec.Core.Runner as H import           Test.Hspec.Core.QuickCheckUtil (mkGen) import           Test.Hspec.Core.Clock-import           Test.Hspec.Core.Example(Result(..), ResultStatus(..), FailureReason(..))+import           Test.Hspec.Core.Example (Result(..), ResultStatus(..), FailureReason(..))+import           Test.Hspec.Core.Util+import qualified Test.Hspec.Core.Format as Format  #if !MIN_VERSION_base(4,7,0) deriving instance Eq ErrorCall@@ -58,11 +61,14 @@ exceptionEq a b   | Just ea <- E.fromException a, Just eb <- E.fromException b = ea == (eb :: E.ErrorCall)   | Just ea <- E.fromException a, Just eb <- E.fromException b = ea == (eb :: E.ArithException)-  | otherwise = undefined+  | otherwise = throw (HUnit.HUnitFailure Nothing $ HUnit.ExpectedButGot Nothing (formatException b) (formatException a))  deriving instance Eq FailureReason deriving instance Eq ResultStatus deriving instance Eq Result++deriving instance Eq Format.Result+deriving instance Eq Format.Item  instance Eq SomeException where   (==) = exceptionEq
test/Test/Hspec/Core/HooksSpec.hs view
@@ -1,18 +1,41 @@ {-# LANGUAGE ScopedTypeVariables #-} module Test.Hspec.Core.HooksSpec (spec) where -import           Control.Exception-import           Helper import           Prelude ()+import           Helper+import           Mock +import           Control.Exception+ import qualified Test.Hspec.Core.Runner as H import qualified Test.Hspec.Core.Spec as H+import           Test.Hspec.Core.Format+import           Test.Hspec.Core.Runner.Eval  import qualified Test.Hspec.Core.Hooks as H  runSilent :: H.Spec -> IO () runSilent = silence . H.hspec +evalSpec :: H.Spec -> IO [([String], Item)]+evalSpec = fmap normalize . (H.specToEvalForest H.defaultConfig >=> runFormatter config)+  where+    config = EvalConfig {+      evalConfigFormat = format+    , evalConfigConcurrentJobs = 1+    , evalConfigFastFail = False+    }+    format = Format {+      formatRun = id+    , formatGroupStarted = \ _ -> return ()+    , formatGroupDone = \ _ -> return ()+    , formatProgress = \ _ _ -> return ()+    , formatItem = \ _ _ -> return ()+    }+    normalize = map $ \ (path, item) -> (pathToList path, normalizeItem item)+    normalizeItem item = item {itemLocation = Nothing, itemDuration = 0}+    pathToList (xs, x) = xs ++ [x]+ mkAppend :: IO (String -> IO (), IO [String]) mkAppend = do   ref <- newIORef ([] :: [String])@@ -294,16 +317,18 @@      context "when used with an empty list of examples" $ do       it "does not run specified action" $ do-        (rec, retrieve) <- mkAppend-        runSilent $ H.before (rec "before" >> return "from before") $ H.afterAll rec $ do+        evalSpec $ H.before undefined $ H.afterAll undefined $ do           return ()-        retrieve `shouldReturn` []+        `shouldReturn` []      context "when action throws an exception" $ do       it "reports a failure" $ do-        r <- runSpec $ H.before (return "from before") $ H.afterAll (\_ -> throwException) $ do+        evalSpec $ H.before (return "from before") $ H.afterAll (\_ -> throwException) $ do           H.it "foo" $ \a -> a `shouldBe` "from before"-        r `shouldSatisfy` any (== "afterAll-hook FAILED [1]")+        `shouldReturn` [+          item ["foo"] Success+        , item ["afterAll-hook"] divideByZero+        ]    describe "afterAll_" $ do     it "runs an action after the last spec item" $ do@@ -341,13 +366,35 @@           return ()         retrieve `shouldReturn` [] +    context "when action is pending" $ do+      it "reports pending" $ do+        evalSpec $ do+          H.afterAll_ H.pending $ do+            H.it "foo" True+        `shouldReturn` [+          item ["foo"] Success+        , item ["afterAll-hook"] (Pending Nothing)+        ]+     context "when action throws an exception" $ do       it "reports a failure" $ do-        r <- runSpec $ do+        evalSpec $ do           H.afterAll_ throwException $ do             H.it "foo" True-        r `shouldSatisfy` any (== "afterAll-hook FAILED [1]")+        `shouldReturn` [+          item ["foo"] Success+        , item ["afterAll-hook"] divideByZero+        ] +    context "when action is successful" $ do+      it "does not report anythig" $ do+        evalSpec $ do+          H.afterAll_ (return ()) $ do+            H.it "foo" True+        `shouldReturn` [+          item ["foo"] Success+        ]+   describe "around" $ do     it "wraps every spec item with an action" $ do       (rec, retrieve) <- mkAppend@@ -406,6 +453,59 @@       runSilent $ H.before (return 23) $ H.aroundWith action $ do         H.it "foo" rec       retrieve `shouldReturn` ["23"]++  describe "aroundAll_" $ do+    it "wraps an action around a spec" $ do+      (rec, retrieve) <- mkAppend+      let action inner = rec "before" *> inner <* rec "after"+      _ <- evalSpec $ H.aroundAll_ action $ do+        H.it "foo" $ rec "foo"+        H.it "bar" $ rec "bar"+      retrieve `shouldReturn` [+          "before"+        , "foo"+        , "bar"+        , "after"+        ]++    it "does not memoize subject" $ do+      mock <- newMock+      let action :: IO Int+          action = mockAction mock >> mockCounter mock++      (rec, retrieve) <- mkAppend+      _ <- evalSpec $ H.before action $ H.aroundAll_ id $ do+        H.it "foo" $ rec . show+        H.it "bar" $ rec . show+        H.it "baz" $ rec . show+      retrieve `shouldReturn` [+          "1"+        , "2"+        , "3"+        ]+      mockCounter mock `shouldReturn` 4++    it "reports exceptions in acquire-part" $ do+      evalSpec $ do+        H.aroundAll_ (throwException <*) $ do+          H.it "foo" True+      `shouldReturn` [+        item ["foo"] divideByZero+      , item ["afterAll-hook"] (Pending (Just "exception in beforeAll-hook (see previous failure)"))+      ]++    it "reports exceptions in cleanup-part" $ do+      evalSpec $ do+        H.aroundAll_ (<* throwException) $ do+          H.it "foo" True+      `shouldReturn` [+        item ["foo"] Success+      , item ["afterAll-hook"] divideByZero+      ]+   where-    runSpec :: H.Spec -> IO [String]-    runSpec = captureLines . H.hspecResult+    divideByZero :: Result+    divideByZero = Failure (Error Nothing $ toException DivideByZero)++    item :: [String] -> Result -> ([String], Item)+    item path result = (path, Item Nothing 0 "" result)
test/Test/Hspec/Core/SpecSpec.hs view
@@ -10,8 +10,8 @@  import qualified Test.Hspec.Core.Spec as H -ignoreCleanup :: Tree c a -> Tree () a-ignoreCleanup = H.bimapTree (const ()) id+extract :: (Item () -> a) -> H.Spec -> IO [Tree () a]+extract f = fmap (H.bimapForest (const ()) f) . runSpecM  runSpec :: H.Spec -> IO [String] runSpec = captureLines . H.hspecResult@@ -91,37 +91,35 @@    describe "focus" $ do     it "focuses spec items" $ do-      items <- runSpecM $ H.focus $ do+      items <- extract itemIsFocused $ H.focus $ do         H.it "is focused and will run" True         H.it "is also focused and will also run" True-      map (ignoreCleanup . fmap itemIsFocused) items-        `shouldBe` [Leaf True, Leaf True]+      items `shouldBe` [Leaf True, Leaf True]      context "when applied to a spec with focused spec items" $ do       it "has no effect" $ do-        items <- runSpecM $ H.focus $ do+        items <- extract itemIsFocused $ H.focus $ do           H.focus $ H.it "is focused and will run" True           H.it "is not focused and will not run" True-        map (ignoreCleanup . fmap itemIsFocused) items-          `shouldBe` [Leaf True, Leaf False]+        items `shouldBe` [Leaf True, Leaf False]    describe "parallel" $ do     it "marks examples for parallel execution" $ do-      [Leaf item] <- runSpecM . H.parallel $ H.it "whatever" H.pending-      itemIsParallelizable item `shouldBe` Just True+      items <- extract itemIsParallelizable . H.parallel $ H.it "whatever" H.pending+      items `shouldBe` [Leaf $ Just True]      it "is applied recursively" $ do-      [Node _ [Node _ [Leaf item]]] <- runSpecM . H.parallel $ do+      items <- extract itemIsParallelizable . H.parallel $ do         H.describe "foo" $ do           H.describe "bar" $ do             H.it "baz" H.pending-      itemIsParallelizable item `shouldBe` Just True+      items `shouldBe` [Node "foo" [Node "bar" [Leaf $ Just True]]]    describe "sequential" $ do     it "marks examples for sequential execution" $ do-      [Leaf item] <- runSpecM . H.sequential $ H.it "whatever" H.pending-      itemIsParallelizable item `shouldBe` Just False+      items <- extract itemIsParallelizable . H.sequential $ H.it "whatever" H.pending+      items `shouldBe` [Leaf $ Just False]      it "takes precedence over a later `parallel`" $ do-      [Leaf item] <- runSpecM . H.parallel . H.sequential $ H.it "whatever" H.pending-      itemIsParallelizable item `shouldBe` Just False+      items <- extract itemIsParallelizable . H.parallel . H.sequential $ H.it "whatever" H.pending+      items `shouldBe` [Leaf $ Just False]
version.yaml view
@@ -1,1 +1,1 @@-&version 2.7.6+&version 2.7.7