hspec-core 2.9.1 → 2.9.2

raw patch · 18 files changed

+200/−36 lines, 18 filesdep ~basedep ~hspec-metaPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, hspec-meta

API changes (from Hackage documentation)

Files

• help.txt +1/−0
• hspec-core.cabal +2/−2
• src/Test/Hspec/Core/Config/Definition.hs +6/−0
• src/Test/Hspec/Core/Format.hs +1/−0
• src/Test/Hspec/Core/Formatters/Diff.hs +34/−4
• src/Test/Hspec/Core/Formatters/Internal.hs +5/−0
• src/Test/Hspec/Core/Formatters/V1.hs +2/−2
• src/Test/Hspec/Core/Formatters/V2.hs +70/−19
• src/Test/Hspec/Core/Runner.hs +1/−0
• src/Test/Hspec/Core/Util.hs +1/−1
• test/GetOpt/Declarative/EnvironmentSpec.hs +1/−0
• test/Test/Hspec/Core/Config/OptionsSpec.hs +1/−0
• test/Test/Hspec/Core/Example/LocationSpec.hs +2/−1
• test/Test/Hspec/Core/Formatters/DiffSpec.hs +30/−4
• test/Test/Hspec/Core/Formatters/V2Spec.hs +35/−1
• test/Test/Hspec/Core/QuickCheckUtilSpec.hs +1/−0
• vendor/Text/Show/Unicode.hs +6/−1
• version.yaml +1/−1

@@ -32,6 +32,7 @@                 --[no-]color            colorize the output                 --[no-]unicode          output unicode                 --[no-]diff             show colorized diffs+                --[no-]pretty           try to pretty-print diff values                 --[no-]times            report times for individual spec items                 --print-cpu-time        include used CPU time in summary   -p[N]         --print-slow-items[=N]  print the N slowest spec items (default:

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:             hspec-core-version:          2.9.1+version:          2.9.2 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2021 Simon Hengel,@@ -114,7 +114,7 @@     , directory     , filepath     , hspec-expectations ==0.8.2.*-    , hspec-meta ==2.7.8+    , hspec-meta ==2.9.0.1     , process     , quickcheck-io >=0.2.0     , random

@@ -62,6 +62,7 @@ , configColorMode :: ColorMode , configUnicodeMode :: UnicodeMode , configDiff :: Bool+, configPrettyPrint :: Bool , configTimes :: Bool , configAvailableFormatters :: [(String, FormatConfig -> IO Format)] , configFormat :: Maybe (FormatConfig -> IO Format)@@ -94,6 +95,7 @@ , configColorMode = ColorAuto , configUnicodeMode = UnicodeAuto , configDiff = True+, configPrettyPrint = True , configTimes = False , configAvailableFormatters = map (fmap V2.formatterToFormat) [     ("checks", V2.checks)@@ -132,6 +134,7 @@   , mkFlag "color" setColor "colorize the output"   , mkFlag "unicode" setUnicode "output unicode"   , mkFlag "diff" setDiff "show colorized diffs"+  , mkFlag "pretty" setPretty "try to pretty-print diff values"   , mkFlag "times" setTimes "report times for individual spec items"   , mkOptionNoArg "print-cpu-time" Nothing setPrintCpuTime "include used CPU time in summary"   , printSlowItemsOption@@ -160,6 +163,9 @@      setDiff :: Bool -> Config -> Config     setDiff v config = config {configDiff = v}++    setPretty :: Bool -> Config -> Config+    setPretty v config = config {configPrettyPrint = v}      setTimes :: Bool -> Config -> Config     setTimes v config = config {configTimes = v}

@@ -59,6 +59,7 @@   formatConfigUseColor :: Bool , formatConfigOutputUnicode :: Bool , formatConfigUseDiff :: Bool+, formatConfigPrettyPrint :: Bool , formatConfigPrintTimes :: Bool , formatConfigHtmlOutput :: Bool , formatConfigPrintCpuTime :: Bool

@@ -2,25 +2,55 @@ {-# LANGUAGE ViewPatterns #-} module Test.Hspec.Core.Formatters.Diff (   Diff (..)+, recover , diff #ifdef TEST+, recoverString , partition , breakList #endif ) where  import           Prelude ()-import           Test.Hspec.Core.Compat+import           Control.Arrow+import           Test.Hspec.Core.Compat hiding (First)  import           Data.Char-import           Data.Algorithm.Diff+import qualified Data.Algorithm.Diff as Diff+import           Text.Show.Unicode (urecover) -diff :: String -> String -> [Diff String]-diff expected actual = map (fmap concat) $ getGroupedDiff (partition expected) (partition actual)+data Diff = First String | Second String | Both String+  deriving (Eq, Show) +recover :: Bool -> String -> String -> (String, String)+recover unicode expected actual = case (recoverString unicode expected, recoverString unicode actual) of+  (Just expected_, Just actual_) -> (expected_, actual_)+  _ -> (rec expected, rec actual)+  where+    rec = if unicode then urecover else id++recoverString :: Bool -> String -> Maybe String+recoverString unicode input = case readMaybe input of+  Just r | shouldParseBack r -> Just r+  _ -> Nothing+  where+    shouldParseBack = (&&) <$> all isSafe <*> isMultiLine+    isMultiLine = lines >>> length >>> (> 1)+    isSafe c = (unicode || isAscii c) && (not $ isControl c) || c == '\n'++diff :: String -> String -> [Diff]+diff expected actual = map (toDiff . fmap concat) $ Diff.getGroupedDiff (partition expected) (partition actual)++toDiff :: Diff.Diff String -> Diff+toDiff d = case d of+  Diff.First xs -> First xs+  Diff.Second xs -> Second xs+  Diff.Both xs _ -> Both xs+ partition :: String -> [String] partition = filter (not . null) . mergeBackslashes . breakList isAlphaNum   where+    mergeBackslashes :: [String] -> [String]     mergeBackslashes xs = case xs of       ['\\'] : (splitEscape -> Just (escape, ys)) : zs -> ("\\" ++ escape) : ys : mergeBackslashes zs       z : zs -> z : mergeBackslashes zs

@@ -35,6 +35,7 @@ , outputUnicode  , useDiff+, prettyPrint , extraChunk , missingChunk @@ -105,6 +106,10 @@ -- | Return `True` if the user requested colorized diffs, `False` otherwise. useDiff :: FormatM Bool useDiff = getConfig formatConfigUseDiff++-- | Return `True` if the user requested pretty diffs, `False` otherwise.+prettyPrint :: FormatM Bool+prettyPrint = getConfig formatConfigPrettyPrint  -- | Return `True` if the user requested unicode output, `False` otherwise. outputUnicode :: FormatM Bool

@@ -304,14 +304,14 @@             writeDiff chunks extra missing = do               withFailColor $ write (indentation ++ "expected: ")               forM_ chunks $ \ chunk -> case chunk of-                Both a _ -> indented write a+                Both a -> indented write a                 First a -> indented extra a                 Second _ -> return ()               writeLine ""                withFailColor $ write (indentation ++ " but got: ")               forM_ chunks $ \ chunk -> case chunk of-                Both a _ -> indented write a+                Both a -> indented write a                 First _ -> return ()                 Second a -> indented missing a               writeLine ""

@@ -58,23 +58,31 @@ , outputUnicode  , useDiff+, prettyPrint , extraChunk , missingChunk  -- ** Helpers , formatLocation , formatException++#ifdef TEST+, Chunk(..)+, ColorChunk(..)+, indentChunks+#endif ) where  import           Prelude () import           Test.Hspec.Core.Compat hiding (First) +import           Data.Char import           Data.Maybe import           Test.Hspec.Core.Util import           Test.Hspec.Core.Clock import           Test.Hspec.Core.Spec (Location(..)) import           Text.Printf-import           Text.Show.Unicode (ushow, urecover)+import           Text.Show.Unicode (ushow) import           Control.Monad.IO.Class import           Control.Exception @@ -117,6 +125,7 @@   , outputUnicode    , useDiff+  , prettyPrint   , extraChunk   , missingChunk   )@@ -265,10 +274,11 @@         NoReason -> return ()         Reason err -> withFailColor $ indent err         ExpectedButGot preface expected_ actual_ -> do+          pretty <- prettyPrint           let-            recover = if unicode then urecover else id-            expected = recover expected_-            actual = recover actual_+            (expected, actual)+              | pretty = recover unicode expected_ actual_+              | otherwise = (expected_, actual_)            mapM_ indent preface @@ -286,24 +296,19 @@             Nothing -> do               writeDiff [First expected, Second actual] write write           where-            indented output text = case break (== '\n') text of-              (xs, "") -> output xs-              (xs, _ : ys) -> output (xs ++ "\n") >> write (indentation ++ "          ") >> indented output ys-             writeDiff chunks extra missing = do-              withFailColor $ write (indentation ++ "expected: ")-              forM_ chunks $ \ chunk -> case chunk of-                Both a _ -> indented write a-                First a -> indented extra a-                Second _ -> return ()-              writeLine ""+              writeChunks "expected: " (expectedChunks chunks) extra+              writeChunks " but got: " (actualChunks chunks) missing -              withFailColor $ write (indentation ++ " but got: ")-              forM_ chunks $ \ chunk -> case chunk of-                Both a _ -> indented write a-                First _ -> return ()-                Second a -> indented missing a+            writeChunks :: String -> [Chunk] -> (String -> FormatM ()) -> FormatM ()+            writeChunks pre chunks colorize = do+              withFailColor $ write (indentation ++ pre)+              forM_ (indentChunks indentation_ chunks) $ \ chunk -> case chunk of+                PlainChunk a -> write a+                ColorChunk a -> colorize a               writeLine ""+              where+                indentation_ = indentation ++ replicate (length pre) ' '          Error _ e -> withFailColor . indent $ (("uncaught exception: " ++) . formatException) e @@ -316,6 +321,52 @@         indent message = do           forM_ (lines message) $ \line -> do             writeLine (indentation ++ line)++data Chunk = Original String | Modified String+  deriving (Eq, Show)++expectedChunks :: [Diff] -> [Chunk]+expectedChunks = mapMaybe $ \ chunk -> case chunk of+  Both a -> Just $ Original a+  First a -> Just $ Modified a+  Second _ -> Nothing++actualChunks :: [Diff] -> [Chunk]+actualChunks = mapMaybe $ \ chunk -> case chunk of+  Both a -> Just $ Original a+  First _ -> Nothing+  Second a -> Just $ Modified a++data ColorChunk = PlainChunk String | ColorChunk String+  deriving (Eq, Show)++indentChunks :: String -> [Chunk] -> [ColorChunk]+indentChunks indentation = concatMap $ \ chunk -> case chunk of+  Original y -> [indentOriginal indentation y]+  Modified y -> indentModified indentation y++indentOriginal :: String -> String -> ColorChunk+indentOriginal indentation = PlainChunk . go+  where+    go text = case break (== '\n') text of+      (xs, _ : ys) -> xs ++ "\n" ++ indentation ++ go ys+      (xs, "") -> xs++indentModified :: String -> String -> [ColorChunk]+indentModified indentation = go+  where+    go text = case text of+      "\n" -> [PlainChunk "\n", ColorChunk indentation]+      '\n' : ys@('\n' : _) -> PlainChunk "\n" : ColorChunk indentation : go ys+      _ -> case break (== '\n') text of+        (xs, _ : ys) -> segment xs ++ PlainChunk ('\n' : indentation) : go ys+        (xs, "") -> segment xs++    segment xs = case span isSpace $ reverse xs of+      ("", "") -> []+      ("", _) -> [ColorChunk xs]+      (_, "") -> [ColorChunk xs]+      (ys, zs) -> [ColorChunk (reverse zs), ColorChunk (reverse ys)]  defaultFooter :: FormatM () defaultFooter = do

@@ -223,6 +223,7 @@         formatConfigUseColor = useColor       , formatConfigOutputUnicode = outputUnicode       , formatConfigUseDiff = configDiff config+      , formatConfigPrettyPrint = configPrettyPrint config       , formatConfigPrintTimes = configTimes config       , formatConfigHtmlOutput = configHtmlOutput config       , formatConfigPrintCpuTime = configPrintCpuTime config

@@ -11,7 +11,7 @@ , formatRequirement , filterPredicate --- * Working with exception+-- * Working with exceptions , safeTry , formatException ) where

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} module GetOpt.Declarative.EnvironmentSpec (spec) where  import           Prelude ()

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} module Test.Hspec.Core.Config.OptionsSpec (spec) where  import           Prelude ()

@@ -3,6 +3,7 @@ {-# OPTIONS_GHC -fno-warn-missing-fields #-} {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} {-# OPTIONS_GHC -O0 #-} module Test.Hspec.Core.Example.LocationSpec (spec) where @@ -92,7 +93,7 @@     context "with NoMethodError" $ do       it "extracts Location" $ do         Left e <- try $ someMethod ()-        extractLocation e `shouldBe` Just (Location __FILE__ 20 10)+        extractLocation e `shouldBe` Just (Location __FILE__ 21 10)      context "with AssertionFailed" $ do       it "extracts Location" $ do

@@ -2,18 +2,44 @@ module Test.Hspec.Core.Formatters.DiffSpec (spec) where  import           Prelude ()-import           Test.Hspec.Core.Compat--import           Helper+import           Helper hiding (First) import           Data.Char -import           Test.Hspec.Core.Formatters.Diff+import           Test.Hspec.Core.Formatters.Diff as Diff  dropQuotes :: String -> String dropQuotes = init . tail  spec :: Spec spec = do+  describe "recover" $ do+    context "with single-line string literals" $ do+      context "with --unicode" $ do+        it "recovers unicode" $ do+          recover True (show "foo\955bar") (show "foo-bar") `shouldBe` ("\"foo\955bar\"", "\"foo-bar\"")++      context "with --no-unicode" $ do+        it "does not recover unicode" $ do+          recover False (show "foo\955bar") (show "foo-bar") `shouldBe` ("\"foo\\955bar\"", "\"foo-bar\"")++  describe "recoverString" $ do+    it "parses back multi-line string literals" $ do+      recoverString True (show "foo\nbar\nbaz\n") `shouldBe` Just "foo\nbar\nbaz\n"++    it "does not parse back string literals that contain control characters" $ do+      recoverString True (show "foo\n\tbar\nbaz\n") `shouldBe` Nothing++    it "does not parse back string literals that span a single line" $ do+      recoverString True (show "foo\n") `shouldBe` Nothing++    context "when unicode is True" $ do+      it "parses back string literals that contain unicode" $ do+        recoverString True (show "foo\n\955\nbaz\n") `shouldBe` Just "foo\n\955\nbaz\n"++    context "when unicode is False" $ do+      it "does not parse back string literals that contain unicode" $ do+        recoverString False (show "foo\n\955\nbaz\n") `shouldBe` Nothing+   describe "partition" $ do     context "with a single shown Char" $ do       it "never partitions a character escape" $ do

@@ -26,6 +26,7 @@   formatConfigUseColor = False , formatConfigOutputUnicode = True , formatConfigUseDiff = True+, formatConfigPrettyPrint = True , formatConfigPrintTimes = False , formatConfigHtmlOutput = False , formatConfigPrintCpuTime = False@@ -38,9 +39,42 @@  spec :: Spec spec = do-  let item = ItemDone ([], "") . Item Nothing 0 ""+  describe "indentChunks" $ do+    context "with Original" $ do+      it "does not indent single-line input" $ do+        indentChunks "  " [Original "foo"] `shouldBe` [PlainChunk "foo"] +      it "indents multi-line input" $ do+        indentChunks "  " [Original "foo\nbar\nbaz\n"] `shouldBe` [PlainChunk "foo\n  bar\n  baz\n  "]++    context "with Modified" $ do+      it "returns the empty list on empty input" $ do+        indentChunks "  " [Modified ""] `shouldBe` []++      it "does not indent single-line input" $ do+        indentChunks "  " [Modified "foo"] `shouldBe` [ColorChunk "foo"]++      it "indents multi-line input" $ do+        indentChunks "  " [Modified "foo\nbar\nbaz\n"] `shouldBe` [ColorChunk "foo", PlainChunk "\n  ", ColorChunk "bar", PlainChunk "\n  ", ColorChunk "baz", PlainChunk "\n  "]++      it "colorizes whitespace-only input" $ do+        indentChunks "  " [Modified "  "] `shouldBe` [ColorChunk "  "]++      it "colorizes whitespace-only lines" $ do+        indentChunks "  " [Modified "foo\n  \n"] `shouldBe` [ColorChunk "foo", PlainChunk "\n  ", ColorChunk "  ", PlainChunk "\n  "]++      it "colorizes whitespace at the end of the input" $ do+        indentChunks "  " [Modified "foo\n  "] `shouldBe` [ColorChunk "foo", PlainChunk "\n  ", ColorChunk "  "]++      it "splits off whitespace-only segments at the end of a line so that they get colorized" $ do+        indentChunks "  " [Modified "foo  \n"] `shouldBe` [ColorChunk "foo", ColorChunk "  ", PlainChunk "\n  "]++      context "with empty lines" $ do+        it "colorizes indentation" $ do+          indentChunks "  " [Original "foo", Modified "\n\n", Original "bar"] `shouldBe` [PlainChunk "foo", PlainChunk "\n", ColorChunk "  ", PlainChunk "\n", ColorChunk "  ", PlainChunk "bar"]+   describe "progress" $ do+    let item = ItemDone ([], "") . Item Nothing 0 ""     describe "formatterItemDone" $ do       it "marks succeeding examples with ." $ do         formatter <- formatterToFormat progress formatConfig

@@ -2,6 +2,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} module Test.Hspec.Core.QuickCheckUtilSpec (spec) where  import           Prelude ()

@@ -50,12 +50,17 @@ module Text.Show.Unicode (ushow, uprint, urecover, ushowWith, uprintWith, urecoverWith) where  import           Prelude ()-import           Test.Hspec.Core.Compat hiding (many)+import           Test.Hspec.Core.Compat hiding (many, (<*>), (*>), (<*))  import           Data.Char                    (isAscii, isPrint) import           Text.ParserCombinators.ReadP import           Text.Read.Lex                (lexChar) import qualified Data.List                     as L++infixl 4 <*++(<*) :: Monad m => m a -> m b -> m a+(<*) = flip (>>)  -- Represents a replaced character using its literal form and its escaped form. type Replacement = (String, String)

@@ -1,1 +1,1 @@-&version 2.9.1+&version 2.9.2