packages feed

hspec-meta 2.9.0.1 → 2.9.2

raw patch · 11 files changed

+270/−26 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

hspec-core/src/Test/Hspec/Core/Config/Definition.hs view
@@ -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}
hspec-core/src/Test/Hspec/Core/Format.hs view
@@ -59,6 +59,7 @@   formatConfigUseColor :: Bool , formatConfigOutputUnicode :: Bool , formatConfigUseDiff :: Bool+, formatConfigPrettyPrint :: Bool , formatConfigPrintTimes :: Bool , formatConfigHtmlOutput :: Bool , formatConfigPrintCpuTime :: Bool
hspec-core/src/Test/Hspec/Core/Formatters/Diff.hs view
@@ -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
hspec-core/src/Test/Hspec/Core/Formatters/Internal.hs view
@@ -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
hspec-core/src/Test/Hspec/Core/Formatters/V1.hs view
@@ -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 ""
hspec-core/src/Test/Hspec/Core/Formatters/V2.hs view
@@ -58,22 +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) import           Control.Monad.IO.Class import           Control.Exception @@ -116,6 +125,7 @@   , outputUnicode    , useDiff+  , prettyPrint   , extraChunk   , missingChunk   )@@ -255,6 +265,7 @@   where     formatFailure :: (Int, FailureRecord) -> FormatM ()     formatFailure (n, FailureRecord mLoc path reason) = do+      unicode <- outputUnicode       forM_ mLoc $ \loc -> do         withInfoColor $ writeLine ("  " ++ formatLocation loc)       write ("  " ++ show n ++ ") ")@@ -262,7 +273,13 @@       case reason of         NoReason -> return ()         Reason err -> withFailColor $ indent err-        ExpectedButGot preface expected actual -> do+        ExpectedButGot preface expected_ actual_ -> do+          pretty <- prettyPrint+          let+            (expected, actual)+              | pretty = recover unicode expected_ actual_+              | otherwise = (expected_, actual_)+           mapM_ indent preface            b <- useDiff@@ -279,34 +296,77 @@             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        writeLine ""-      writeLine ("  To rerun use: --match " ++ show (joinPath path))++      let path_ = (if unicode then ushow else show) (joinPath path)+      writeLine ("  To rerun use: --match " ++ path_)       where         indentation = "       "         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
hspec-core/src/Test/Hspec/Core/Runner.hs view
@@ -223,6 +223,7 @@         formatConfigUseColor = useColor       , formatConfigOutputUnicode = outputUnicode       , formatConfigUseDiff = configDiff config+      , formatConfigPrettyPrint = configPrettyPrint config       , formatConfigPrintTimes = configTimes config       , formatConfigHtmlOutput = configHtmlOutput config       , formatConfigPrintCpuTime = configPrintCpuTime config
hspec-core/src/Test/Hspec/Core/Util.hs view
@@ -11,7 +11,7 @@ , formatRequirement , filterPredicate --- * Working with exception+-- * Working with exceptions , safeTry , formatException ) where
+ hspec-core/vendor/Text/Show/Unicode.hs view
@@ -0,0 +1,140 @@+{- |+Copyright   : (c) Takayuki Muranushi, 2016+License     : BSD3+Maintainer  : whosekiteneverfly@gmail.com+Stability   : experimental+++Provides a interactive printer for printing Unicode characters in ghci REPL. Our design goal is that 'uprint' produces String representations that are valid Haskell 'String' literals and uses as many Unicode printable characters as possible. Hence++@+read . ushow == id+@++see the tests of this package for detailed specifications.++__Example__++With 'print' :++@+$ __ghci__+...+> __["哈斯克尔7.6.1"]__+["\\21704\\26031\\20811\\23572\\&7.6.1"]+>+@++With 'uprint' :++@+$ __ghci -interactive-print=Text.Show.Unicode.uprint Text.Show.Unicode__+...+Ok, modules loaded: Text.Show.Unicode.+> __("Хорошо!",["哈斯克尔7.6.1的力量","感じる"])__+("Хорошо!",["哈斯克尔7.6.1的力量","感じる"])+> "改\\n行"+"改\\n行"+@++You can make 'uprint' the default interactive printer in several ways. One is to+@cabal install unicode-show@, and add the following lines to your @~/.ghci@ config file.++@+import qualified Text.Show.Unicode+:set -interactive-print=Text.Show.Unicode.uprint+@++-}++module Text.Show.Unicode (ushow, uprint, urecover, ushowWith, uprintWith, urecoverWith) where++import           Prelude ()+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)++-- | Parse one Haskell character literal expression from a 'String' produced by 'show', and+--+--  * If the found char satisfies the predicate, replace the literal string with the character itself.+--  * Otherwise, leave the string as it was.+--  * Note that special delimiter sequence "\&" may appear in a string. c.f.  <https://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6 Section 2.6 of the Haskell 2010 specification>.+recoverChar :: (Char -> Bool) -> ReadP Replacement+recoverChar p = represent <$> gather lexCharAndConsumeEmpties+  where+    represent :: (String, Char) -> Replacement+    represent (o,lc)+      -- This is too dirty a hack.+      -- However, I couldn't think of any other way to recover the & consumed by lexChar while not needlessly increasing the number of & by mis-detecting the escape sequence.+      | p lc      =+        if head o /= '\\' &&+        "\\&" `L.isSuffixOf` o+        then (o, lc : "\\&")+        else (o, [lc])+      | otherwise = (o, o)++-- | The base library lexChar has been handling & by itself since 4.9.1.0,+-- so consumeEmpties is a meaningless action,+-- but it makes sense for older versions of lexChar.+lexCharAndConsumeEmpties :: ReadP Char+lexCharAndConsumeEmpties = lexChar <* consumeEmpties+    where+    -- Consumes the string "\&" repeatedly and greedily (will only produce one match)+    consumeEmpties :: ReadP ()+    consumeEmpties = do+        rest <- look+        case rest of+            ('\\':'&':_) -> string "\\&" >> consumeEmpties+            _ -> return ()++-- | Show the input, and then replace Haskell character literals+-- with the character it represents, for any Unicode printable characters except backslash, single and double quotation marks.+-- If something fails, fallback to standard 'show'.+ushow :: Show a => a -> String+ushow = ushowWith shouldRecover++-- | Replace Haskell character literals with the character it represents, for+-- any Unicode printable characters except backslash, single and double+-- quotation marks.+urecover :: String -> String+urecover = urecoverWith shouldRecover++shouldRecover :: Char -> Bool+shouldRecover c = isPrint c && not (isAscii c)++-- | A version of 'print' that uses 'ushow'.+uprint :: Show a => a -> IO ()+uprint = putStrLn . ushow++-- | Show the input, and then replace character literals+-- with the character itself, for characters that satisfy the given predicate.+ushowWith :: Show a => (Char -> Bool) -> a -> String+ushowWith p = urecoverWith p . show++-- | Replace character literals with the character itself, for characters that+-- satisfy the given predicate.+urecoverWith :: (Char -> Bool) -> String -> String+urecoverWith p = go ("", "") . readP_to_S (many $ recoverChar p)+  where+    go :: Replacement -> [([Replacement], String)] -> String+    go _  []            = ""+    go _  (([],""):_)   = ""+    go _  ((rs,""):_)   = snd $ last rs+    go _  [(_,o)]       = o+    go pr (([],_):rest) = go pr rest+    go _  ((rs,_):rest) = let r = last rs in snd r ++ go r rest++-- | A version of 'print' that uses 'ushowWith'.+uprintWith :: Show a => (Char -> Bool) -> a -> IO ()+uprintWith p = putStrLn . ushowWith p
hspec-meta.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hspec-meta-version:        2.9.0.1+version:        2.9.2 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.@@ -71,6 +71,7 @@       Test.Hspec.Core.Util       Control.Concurrent.Async       Data.Algorithm.Diff+      Text.Show.Unicode       Test.HUnit       Test.HUnit.Base       Test.HUnit.Lang
version.yaml view
@@ -1,1 +1,1 @@-&version 2.9.0.1+&version 2.9.2