packages feed

hspec-meta 2.11.12 → 2.11.13

raw patch · 6 files changed

+163/−126 lines, 6 files

Files

hspec-core/src/Test/Hspec/Core/Formatters/Diff.hs view
@@ -1,8 +1,15 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} module Test.Hspec.Core.Formatters.Diff (   Diff (..) , diff++, LineDiff(..)+, lineDiff++, splitLines+ #ifdef TEST , partition , breakList@@ -15,73 +22,117 @@ import           Data.Char import qualified Data.Algorithm.Diff as Diff -data Diff = First String | Second String | Both String | Omitted Int+data Diff = First String | Second String | Both String   deriving (Eq, Show) --- |--- Split a string at line boundaries.------ >>> splitLines "foo\nbar\nbaz"--- ["foo\n","bar\n","baz"]------ prop> concat (splitLines xs) == xs+data LineDiff =+    LinesFirst [String]+  | LinesSecond [String]+  | LinesBoth [String]+  | SingleLineDiff [Diff]+  | LinesOmitted Int+  deriving (Eq, Show)++lineDiff :: Maybe Int -> String -> String -> [LineDiff]+lineDiff context expected actual = maybe id applyContext context $ singleLineDiffs diffs+  where+    diffs :: [LineDiff]+    diffs = Diff.getGroupedDiff expectedLines actualLines <&> \ case+      Diff.First xs -> LinesFirst xs+      Diff.Second xs -> LinesSecond xs+      Diff.Both xs _ -> LinesBoth xs++    expectedLines :: [String]+    expectedLines = splitLines expected++    actualLines :: [String]+    actualLines = splitLines actual++singleLineDiffs :: [LineDiff] -> [LineDiff]+singleLineDiffs = go+  where+    go = \ case+      [] -> []+      LinesFirst [first_] : LinesSecond [second_] : xs -> SingleLineDiff (diff first_ second_) : go xs+      x : xs -> x : go xs+ splitLines :: String -> [String] splitLines = go   where+    go :: String -> [String]     go xs = case break (== '\n') xs of-      (ys, '\n' : zs) -> (ys ++ ['\n']) : go zs-      ("", "") -> []+      (ys, '\n' : zs) -> ys : go zs       _ -> [xs] -data TrimMode = FirstChunck | Chunck | LastChunck+data TrimMode = FirstChunk | Chunk | LastChunk -trim :: Int -> [Diff] -> [Diff]-trim context = \ chunks -> case chunks of+applyContext :: Int -> [LineDiff] -> [LineDiff]+applyContext context = \ diffs -> case diffs of   [] -> []-  x : xs -> trimChunk FirstChunck x (go xs)+  x : xs -> trimChunk FirstChunk x (go xs)   where+    omitThreshold :: Int     omitThreshold = 3 -    go chunks = case chunks of+    go :: [LineDiff] -> [LineDiff]+    go diffs = case diffs of       [] -> []-      [x] -> trimChunk LastChunck x []-      x : xs -> trimChunk Chunck x (go xs)+      [x] -> trimChunk LastChunk x []+      x : xs -> trimChunk Chunk x (go xs) +    trimChunk :: TrimMode -> LineDiff -> [LineDiff] -> [LineDiff]     trimChunk mode chunk = case chunk of-      Both xs | omitted >= omitThreshold -> keep start . (Omitted omitted :) . keep end+      LinesBoth allLines | meetsThreshold -> keep start . (LinesOmitted omitted :) . keep end         where+          meetsThreshold :: Bool+          meetsThreshold = omitThreshold <= omitted++          lastLineHasNL = case (mode, reverse allLines) of+            (LastChunk, "" : _) -> True+            _ -> False+           omitted :: Int           omitted = n - keepStart - keepEnd            keepStart :: Int           keepStart = case mode of-            FirstChunck -> 0-            _ -> succ context+            FirstChunk -> 0+            _ -> context            keepEnd :: Int           keepEnd = case mode of-            LastChunck -> 0-            _ -> if xs `endsWith` "\n" then context else succ context+            LastChunk -> 0+            _ -> context            n :: Int-          n = length allLines--          allLines :: [String]-          allLines = splitLines xs+          n = length allLines - case lastLineHasNL of+            False -> 0+            True -> 1            start :: [String]           start = take keepStart allLines            end :: [String]           end = drop (keepStart + omitted) allLines+       _ -> (chunk :) -    keep xs-      | null xs = id-      | otherwise = (Both (concat xs) :)+keep :: [String] -> [LineDiff] -> [LineDiff]+keep xs+  | null xs = id+  | otherwise = (LinesBoth xs :) -diff :: Maybe Int -> String -> String -> [Diff]-diff context expected actual = maybe id trim context $ map (toDiff . fmap concat) $ Diff.getGroupedDiff (partition expected) (partition actual)+diff :: String -> String -> [Diff]+diff expected actual = diffs+  where+    diffs :: [Diff]+    diffs = map (toDiff . fmap concat) $ Diff.getGroupedDiff expectedChunks actualChunks++    expectedChunks :: [String]+    expectedChunks = partition expected++    actualChunks :: [String]+    actualChunks = partition actual  toDiff :: Diff.Diff String -> Diff toDiff d = case d of
hspec-core/src/Test/Hspec/Core/Formatters/Internal.hs view
@@ -371,9 +371,14 @@     missing = diffColorize Green "hspec-success"  diffColorize :: Color -> String -> String-> FormatM ()-diffColorize color cls s = withColor (SetColor layer Dull color) cls $ do-  write s+diffColorize color cls s = withColor (SetColor layer Dull color) cls $ case s of+  "" -> write eraseInLine+  _ -> write s   where+    eraseInLine :: String+    eraseInLine = "\ESC[K"++    layer :: ConsoleLayer     layer       | all isSpace s = Background       | otherwise = Foreground
hspec-core/src/Test/Hspec/Core/Formatters/Pretty.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Test.Hspec.Core.Formatters.Pretty (   pretty2@@ -90,18 +91,32 @@   fromString = Builder . showString  renderValue :: Bool -> Value -> String-renderValue unicode = runBuilder . render+renderValue unicode = runBuilder . render 0   where-    render :: Value -> Builder-    render value = case value of+    render :: Int -> Value -> Builder+    render indentation = \ case       Char c -> shows c       String str -> if unicode then Builder $ ushows str else shows str-      Rational n d -> render n <> " % " <> render d+      Rational n d -> render indentation n <> " % " <> render indentation d       Number n -> fromString n-      Record name fields -> fromString name <> " {\n  " <> (intercalate ",\n  " $ map renderField fields) <> "\n}"-      Constructor name values -> intercalate " " (fromString name : map render values)-      Tuple [e@Record{}] -> render e-      Tuple xs -> "(" <> intercalate ", " (map render xs) <> ")"-      List xs -> "[" <> intercalate ", " (map render xs) <> "]"+      Record name fields -> fromString name <> renderFields fields+      Constructor name values -> intercalate " " (fromString name : map (render indentation) values)+      Tuple [e@Record{}] -> render indentation e+      Tuple xs -> "(" <> intercalate ", " (map (render indentation) xs) <> ")"+      List xs -> "[" <> intercalate ", " (map (render indentation) xs) <> "]"+      where+        spaces :: Builder+        spaces = indentBy (succ indentation) -    renderField (name, value) = fromString name <> " = " <> render value+        renderFields :: [(String, Value)] -> Builder+        renderFields fields = mconcat [+            " {\n" <> spaces+          , intercalate (",\n" <> spaces) $ map renderField fields+          , "\n" <> indentBy indentation <> "}"+          ]++        renderField :: (String, Value) -> Builder+        renderField (name, value) = fromString name <> " = " <> render (succ indentation) value++    indentBy :: Int -> Builder+    indentBy n = fromString $ replicate (2 * n) ' '
hspec-core/src/Test/Hspec/Core/Formatters/V1/Internal.hs view
@@ -296,7 +296,7 @@           let threshold = 2 :: Seconds            mchunks <- liftIO $ if b-            then timeout threshold (evaluate $ diff Nothing expected actual)+            then timeout threshold (evaluate $ diff expected actual)             else return Nothing            case mchunks of@@ -315,7 +315,6 @@                 Both a -> indented write a                 First a -> indented extra a                 Second _ -> pass-                Omitted _ -> pass               writeLine ""                withFailColor $ write (indentation ++ " but got: ")@@ -323,7 +322,6 @@                 Both a -> indented write a                 First _ -> pass                 Second a -> indented missing a-                Omitted _ -> pass               writeLine ""          Error _ e -> withFailColor . indent $ (("uncaught exception: " ++) . formatException) e
hspec-core/src/Test/Hspec/Core/Formatters/V2.hs view
@@ -86,7 +86,6 @@ #ifdef TEST , Chunk(..) , ColorChunk(..)-, indentChunks #endif ) where @@ -94,7 +93,6 @@ import           Test.Hspec.Core.Compat hiding (First) import           System.IO (hFlush, stdout) -import           Data.Char import           Test.Hspec.Core.Util hiding (formatException) import qualified Test.Hspec.Core.Util as Util import           Test.Hspec.Core.Clock@@ -323,15 +321,16 @@             Nothing -> do               context <- diffContext               mchunks <- liftIO $ if b-                then timeout threshold (evaluate $ diff context expected actual)+                then timeout threshold (evaluate $ lineDiff context expected actual)                 else return Nothing                case mchunks of                 Just chunks -> do                   writeDiff chunks extraChunk missingChunk                 Nothing -> do-                  writeDiff [First expected, Second actual] write write+                  writeDiff [LinesFirst (splitLines expected), LinesSecond (splitLines actual)] write write           where+            writeDiff :: [LineDiff] -> (String -> FormatM ()) -> (String -> FormatM ()) -> FormatM ()             writeDiff chunks extra missing = do               writeChunks "expected: " (expectedChunks chunks) extra               writeChunks " but got: " (actualChunks chunks) missing@@ -339,14 +338,26 @@             writeChunks :: String -> [Chunk] -> (String -> FormatM ()) -> FormatM ()             writeChunks pre chunks colorize = do               withFailColor $ write (indentation ++ pre)-              forM_ (indentChunks indentation_ chunks) $ \ case-                PlainChunk a -> write a-                ColorChunk a -> colorize a-                Informational a -> withInfoColor $ write a-              writeLine ""+              go pass chunks               where+                indentation_ :: [Char]                 indentation_ = indentation ++ replicate (length pre) ' ' +                go :: FormatM () -> [Chunk] -> FormatM ()+                go indent_ = \ case+                  [] -> pass+                  c : cs -> do+                    indent_+                    case c of+                      Original a -> write a+                      Modified a -> colorize a+                      Info text -> withInfoColor $ write text+                      ModifiedChunks xs -> for_ xs $ \ case+                        PlainChunk a -> write a+                        ColorChunk a -> colorize a+                    write "\n"+                    go (write indentation_) cs+         Error info e -> do           mapM_ indent info           formatException <- getConfigValue formatConfigFormatException@@ -367,79 +378,36 @@   forM_ (lines message) $ \ line -> do     writeLine (indentation ++ line) -data Chunk = Original String | Modified String | OmittedLines Int+data Chunk = Original String | Modified String | Info String | ModifiedChunks [ColorChunk]   deriving (Eq, Show) -expectedChunks :: [Diff] -> [Chunk]-expectedChunks = mapMaybe $ \ case-  Both a -> Just $ Original a-  First a -> Just $ Modified a-  Second _ -> Nothing-  Omitted n -> Just $ OmittedLines n+expectedChunks :: [LineDiff] -> [Chunk]+expectedChunks = concatMap $ \ case+  LinesBoth a -> map Original a+  LinesFirst a -> map Modified a+  LinesSecond _ -> []+  LinesOmitted n -> [Info $ formatOmittedLines n]+  SingleLineDiff diffs -> return . ModifiedChunks . flip mapMaybe diffs $ \ case+    First a -> Just $ ColorChunk a+    Second _ -> Nothing+    Both a -> Just $ PlainChunk a -actualChunks :: [Diff] -> [Chunk]-actualChunks = mapMaybe $ \ case-  Both a -> Just $ Original a-  First _ -> Nothing-  Second a -> Just $ Modified a-  Omitted n -> Just $ OmittedLines n+actualChunks :: [LineDiff] -> [Chunk]+actualChunks = concatMap $ \ case+  LinesBoth a -> map Original a+  LinesFirst _ -> []+  LinesSecond a -> map Modified a+  LinesOmitted n -> [Info $ formatOmittedLines n]+  SingleLineDiff diffs -> return . ModifiedChunks . flip mapMaybe diffs $ \ case+    First _ -> Nothing+    Second a -> Just $ ColorChunk a+    Both a -> Just $ PlainChunk a -data ColorChunk = PlainChunk String | ColorChunk String | Informational String+data ColorChunk = PlainChunk String | ColorChunk String   deriving (Eq, Show) -data StartsWith = StartsWithNewline | StartsWithNonNewline-  deriving Eq--indentChunks :: String -> [Chunk] -> [ColorChunk]-indentChunks indentation = go-  where-    go :: [Chunk] -> [ColorChunk]-    go = \ case-      Original x : xs -> indentOriginal indentation x : go xs-      Modified x : xs -> indentModified (startsWith xs) indentation x ++ go xs-      OmittedLines n : xs -> Informational (formatOmittedLines n) : go xs-      [] -> []--    startsWith :: [Chunk] -> StartsWith-    startsWith xs-      | all isSpace (takeWhile (/= '\n') $ unChunks xs) = StartsWithNewline-      | otherwise = StartsWithNonNewline--    unChunks :: [Chunk] -> String-    unChunks = \ case-      Original x : xs -> x ++ unChunks xs-      Modified x : xs -> x ++ unChunks xs-      OmittedLines {} : _ -> ""-      [] -> ""--    formatOmittedLines :: Int -> String-    formatOmittedLines n = "@@ " <> show n <> " lines omitted @@\n" <> indentation--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 :: StartsWith -> String -> String -> [ColorChunk]-indentModified nextChunk indentation = go-  where-    go :: String -> [ColorChunk]-    go = \ case-      "" -> []-      "\n" -> [PlainChunk "\n", ColorChunk indentation]-      '\n' : ys@('\n' : _) -> PlainChunk "\n" : ColorChunk indentation : go ys-      '\n' : xs -> PlainChunk ('\n' : indentation) : go xs-      text -> case break (== '\n') text of-        (xs, "") | nextChunk == StartsWithNonNewline -> [ColorChunk xs]-        (xs, ys) -> segment xs ++ go ys--    segment :: String -> [ColorChunk]-    segment xs = case span isSpace $ reverse xs of-      ("", _) -> [ColorChunk xs]-      (_, "") -> [ColorChunk xs]-      (ys, zs) -> [ColorChunk (reverse zs), ColorChunk (reverse ys)]+formatOmittedLines :: Int -> String+formatOmittedLines n = "@@ " <> show n <> " lines omitted @@"  defaultFooter :: FormatM () defaultFooter = do
hspec-meta.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.0.+-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack  name:           hspec-meta-version:        2.11.12+version:        2.11.13 synopsis:       A version of Hspec which is used to test Hspec itself description:    A stable version of Hspec which is used to test the                 in-development version of Hspec.@@ -96,7 +96,7 @@   ghc-options: -Wall -fno-warn-incomplete-uni-patterns   build-depends:       HUnit ==1.6.*-    , QuickCheck >=2.13.1 && <2.16+    , QuickCheck >=2.13.1 && <2.17     , ansi-terminal >=0.6.2     , array     , base >=4.9.0.0 && <5@@ -136,7 +136,7 @@   ghc-options: -Wall -fno-warn-incomplete-uni-patterns   build-depends:       HUnit ==1.6.*-    , QuickCheck >=2.13.1 && <2.16+    , QuickCheck >=2.13.1 && <2.17     , ansi-terminal >=0.6.2     , array     , base >=4.9.0.0 && <5