hspec-core 2.5.9 → 2.6.0

raw patch · 10 files changed

+105/−21 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hspec-core.cabal +2/−2
• src/Test/Hspec/Core/Formatters.hs +7/−1
• src/Test/Hspec/Core/Formatters/Internal.hs +1/−0
• src/Test/Hspec/Core/Formatters/Monad.hs +9/−0
• src/Test/Hspec/Core/Runner.hs +12/−10
• src/Test/Hspec/Core/Spec.hs +35/−0
• src/Test/Hspec/Core/Spec/Monad.hs +1/−6
• src/Test/Hspec/Core/Tree.hs +18/−2
• test/Test/Hspec/Core/FormattersSpec.hs +1/−0
• test/Test/Hspec/Core/SpecSpec.hs +19/−0

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2087cd0eed0044b84e5ce82bceae9d7b2dfae467b554bef674a8815445f7dd5b+-- hash: fef917dc0cb43c6da4719fb2d080d28e01d8bc888b679a3fa1c61559f02d9848  name:             hspec-core-version:          2.5.9+version:          2.6.0 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2018 Simon Hengel,

@@ -48,6 +48,7 @@ , withPendingColor , withFailColor +, useDiff , extraChunk , missingChunk @@ -94,6 +95,7 @@   , withPendingColor   , withFailColor +  , useDiff   , extraChunk   , missingChunk   )@@ -209,7 +211,11 @@         ExpectedButGot preface expected actual -> do           mapM_ indent preface -          let chunks = diff expected actual+          b <- useDiff+          let+            chunks+              | b = diff expected actual+              | otherwise = [First expected, Second actual]            withFailColor $ write (indentation ++ "expected: ")           forM_ chunks $ \chunk -> case chunk of

@@ -68,6 +68,7 @@ , environmentWithSuccessColor = withSuccessColor , environmentWithPendingColor = withPendingColor , environmentWithInfoColor = withInfoColor+, environmentUseDiff = gets (formatConfigUseDiff . stateConfig) , environmentExtraChunk = extraChunk , environmentMissingChunk = missingChunk , environmentLiftIO = liftIO

@@ -30,6 +30,7 @@ , withPendingColor , withFailColor +, useDiff , extraChunk , missingChunk @@ -97,6 +98,7 @@   | forall a. WithSuccessColor (FormatM a) (a -> next)   | forall a. WithPendingColor (FormatM a) (a -> next)   | forall a. WithInfoColor (FormatM a) (a -> next)+  | UseDiff (Bool -> next)   | ExtraChunk String next   | MissingChunk String next   | forall a. LiftIO (IO a) (a -> next)@@ -115,6 +117,7 @@     WithSuccessColor action next -> WithSuccessColor action (fmap f next)     WithPendingColor action next -> WithPendingColor action (fmap f next)     WithInfoColor action next -> WithInfoColor action (fmap f next)+    UseDiff next -> UseDiff (fmap f next)     ExtraChunk s next -> ExtraChunk s (f next)     MissingChunk s next -> MissingChunk s (f next)     LiftIO action next -> LiftIO action (fmap f next)@@ -137,6 +140,7 @@ , environmentWithSuccessColor :: forall a. m a -> m a , environmentWithPendingColor :: forall a. m a -> m a , environmentWithInfoColor :: forall a. m a -> m a+, environmentUseDiff :: m Bool , environmentExtraChunk :: String -> m () , environmentMissingChunk :: String -> m () , environmentLiftIO :: forall a. IO a -> m a@@ -161,6 +165,7 @@         WithSuccessColor inner next -> environmentWithSuccessColor (go inner) >>= go . next         WithPendingColor inner next -> environmentWithPendingColor (go inner) >>= go . next         WithInfoColor inner next -> environmentWithInfoColor (go inner) >>= go . next+        UseDiff next -> environmentUseDiff >>= go . next         ExtraChunk s next -> environmentExtraChunk s >> go next         MissingChunk s next -> environmentMissingChunk s >> go next         LiftIO inner next -> environmentLiftIO inner >>= go . next@@ -227,6 +232,10 @@ -- default color. withInfoColor :: FormatM a -> FormatM a withInfoColor s = liftF (WithInfoColor s id)++-- | Return `True` if the user requested colorized diffs, `False` otherwise.+useDiff :: FormatM Bool+useDiff = liftF (UseDiff id)  -- | Output given chunk in red. extraChunk :: String -> FormatM ()

@@ -47,24 +47,24 @@ -- | Filter specs by given predicate. -- -- The predicate takes a list of "describe" labels and a "requirement".-filterSpecs :: Config -> [SpecTree a] -> [SpecTree a]+filterSpecs :: Config -> [EvalTree] -> [EvalTree] filterSpecs c = go []   where     p :: Path -> Bool     p path = (fromMaybe (const True) (configFilterPredicate c) path) &&                not (fromMaybe (const False) (configSkipPredicate c) path) -    go :: [String] -> [SpecTree a] -> [SpecTree a]+    go :: [String] -> [EvalTree] -> [EvalTree]     go groups = mapMaybe (goSpec groups) -    goSpecs :: [String] -> [SpecTree a] -> ([SpecTree a] -> b) -> Maybe b+    goSpecs :: [String] -> [EvalTree] -> ([EvalTree] -> b) -> Maybe b     goSpecs groups specs ctor = case go groups specs of       [] -> Nothing       xs -> Just (ctor xs) -    goSpec :: [String] -> SpecTree a -> Maybe (SpecTree a)+    goSpec :: [String] -> EvalTree -> Maybe (EvalTree)     goSpec groups spec = case spec of-      Leaf item -> guard (p (groups, itemRequirement item)) >> return spec+      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) @@ -159,7 +159,7 @@      let params = Params (configQuickCheckArgs config) (configSmallCheckDepth config) -    filteredSpec <- map (toEvalTree params) . filterSpecs config . applyDryRun config <$> runSpecM spec+    filteredSpec <- filterSpecs config . mapMaybe (toEvalTree params) . applyDryRun config <$> runSpecM (focus spec)      (total, failures) <- withHiddenCursor useColor h $ do       let@@ -181,13 +181,15 @@     dumpFailureReport config seed qcArgs failures     return (Summary total (length failures)) -toEvalTree :: Params -> SpecTree () -> EvalTree+toEvalTree :: Params -> SpecTree () -> Maybe EvalTree toEvalTree params = go   where+    go :: Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem)     go t = case t of-      Node s xs -> Node s (map go xs)-      NodeWithCleanup c xs -> NodeWithCleanup (c ()) (map go xs)-      Leaf (Item requirement loc isParallelizable e)  -> Leaf (EvalItem requirement loc (fromMaybe False isParallelizable) (e params $ ($ ())))+      Node s xs -> Just $ Node s (mapMaybe go xs)+      NodeWithCleanup c xs -> Just $ NodeWithCleanup (c ()) (mapMaybe go xs)+      Leaf (Item requirement loc isParallelizable isFocused e) ->+        guard isFocused >> return (Leaf (EvalItem requirement loc (fromMaybe False isParallelizable) (e params $ ($ ()))))  dumpFailureReport :: Config -> Integer -> QC.Args -> [Path] -> IO () dumpFailureReport config seed qcArgs xs = do

@@ -18,6 +18,13 @@ , xspecify , xdescribe , xcontext++, focus+, fit+, fspecify+, fdescribe+, fcontext+ , parallel , sequential @@ -91,6 +98,34 @@ -- | @xspecify@ is an alias for `xit`. xspecify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) xspecify = xit++-- | `focus` focuses all spec items of the given spec.+--+-- Applying `focus` to a spec with focused spec items has no effect.+focus :: SpecWith a -> SpecWith a+focus spec = do+  xs <- runIO (runSpecM spec)+  let+    ys+      | any (any itemIsFocused) xs = xs+      | otherwise = map (bimapTree id (\ item -> item {itemIsFocused = True})) xs+  fromSpecList ys++-- | @fit@ is an alias for @fmap focus . it@+fit :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)+fit = fmap focus . it++-- | @fspecify@ is an alias for `fit`.+fspecify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)+fspecify = fit++-- | @fdescribe@ is an alias for @fmap focus . describe@+fdescribe :: HasCallStack => String -> SpecWith a -> SpecWith a+fdescribe = fmap focus . describe++-- | @fcontext@ is an alias for `fdescribe`.+fcontext :: HasCallStack => String -> SpecWith a -> SpecWith a+fcontext = fdescribe  -- | `parallel` marks all spec items of the given spec to be safe for parallel -- evaluation.

@@ -53,12 +53,7 @@ mapSpecTree f (SpecM specs) = SpecM (mapWriterT (fmap (second (map f))) specs)  mapSpecItem :: (ActionWith a -> ActionWith b) -> (Item a -> Item b) -> SpecWith a -> SpecWith b-mapSpecItem g f = mapSpecTree go-  where-    go spec = case spec of-      Node d xs -> Node d (map go xs)-      NodeWithCleanup cleanup xs -> NodeWithCleanup (g cleanup) (map go xs)-      Leaf item -> Leaf (f item)+mapSpecItem g f = mapSpecTree (bimapTree g f)  mapSpecItem_ :: (Item a -> Item a) -> SpecWith a -> SpecWith a mapSpecItem_ = mapSpecItem id

@@ -12,6 +12,7 @@ , Item (..) , specGroup , specItem+, bimapTree , location ) where @@ -28,12 +29,20 @@     Node String [Tree c a]   | NodeWithCleanup c [Tree c a]   | Leaf a-  deriving (Functor, Foldable, Traversable)+  deriving (Show, Eq, Functor, Foldable, Traversable)  -- | A tree is used to represent a spec internally.  The tree is parametrize -- over the type of cleanup actions and the type of the actual spec items. type SpecTree a = Tree (ActionWith a) (Item a) +bimapTree :: (a -> b) -> (c -> d) -> Tree a c -> Tree b d+bimapTree g f = go+  where+    go spec = case spec of+      Node d xs -> Node d (map go xs)+      NodeWithCleanup cleanup xs -> NodeWithCleanup (g cleanup) (map go xs)+      Leaf item -> Leaf (f item)+ -- | -- @Item@ is used to represent spec items internally.  A spec item consists of: --@@ -45,13 +54,20 @@ -- example, including QuickCheck properties, Hspec expectations and HUnit -- assertions. data Item a = Item {+   -- | Textual description of behavior   itemRequirement :: String+   -- | Source location of the spec item , itemLocation :: Maybe Location+   -- | A flag that indicates whether it is safe to evaluate this spec item in   -- parallel with other spec items , itemIsParallelizable :: Maybe Bool++  -- | A flag that indicates whether this spec item is focused.+, itemIsFocused :: Bool+   -- | Example for behavior , itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result }@@ -67,7 +83,7 @@  -- | The @specItem@ function creates a spec item. specItem :: (HasCallStack, Example a) => String -> a -> SpecTree (Arg a)-specItem s e = Leaf $ Item requirement location Nothing (safeEvaluateExample e)+specItem s e = Leaf $ Item requirement location Nothing False (safeEvaluateExample e)   where     requirement :: HasCallStack => String     requirement

@@ -73,6 +73,7 @@ , environmentWithSuccessColor = \action -> let (a, r) = runWriter action in tell (colorize Succeeded r) >> return a , environmentWithPendingColor = \action -> let (a, r) = runWriter action in tell (colorize Pending r) >> return a , environmentWithInfoColor = \action -> let (a, r) = runWriter action in tell (colorize Info r) >> return a+, environmentUseDiff = return True , environmentExtraChunk = tell . return . Extra , environmentMissingChunk = tell . return . Missing , environmentLiftIO = undefined

@@ -10,6 +10,9 @@  import qualified Test.Hspec.Core.Spec as H +ignoreCleanup :: Tree c a -> Tree () a+ignoreCleanup = H.bimapTree (const ()) id+ runSpec :: H.Spec -> IO [String] runSpec = captureLines . H.hspecResult @@ -85,6 +88,22 @@         H.it "foo" $ do           H.pendingWith "for some reason"       r `shouldSatisfy` any (== "  # PENDING: for some reason")++  describe "focus" $ do+    it "focuses spec items" $ do+      items <- runSpecM $ 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]++    context "when applied to a spec with focused spec items" $ do+      it "has no effect" $ do+        items <- runSpecM $ 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]    describe "parallel" $ do     it "marks examples for parallel execution" $ do