packages feed

hspec-meta 1.4.3 → 1.4.4

raw patch · 22 files changed

+146/−47 lines, 22 filesdep ~ansi-terminalPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ansi-terminal

API changes (from Hackage documentation)

Files

+ hspec-discover/test-data/empty-dir/Foo/Bar/Baz/.placeholder view
+ hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs view
+ hspec-discover/test-data/nested-spec/Foo/BarSpec.hs view
+ hspec-discover/test-data/nested-spec/FooSpec.hs view
+ hspec-discover/test-data/no-intermediate-specs/Foo/Bar/BazSpec.hs view
+ hspec-discover/test-data/prefix-name/Foo/BazSpec.hs view
+ hspec-discover/test-data/prefix-name/FooBar/BazSpec.hs view
+ hspec-discover/test-data/prefix-name/FooBarSpec.hs view
+ hspec-discover/test-data/prefix-name/FooSpec.hs view
+ hspec-discover/test-data/several-specs/BarSpec.hs view
+ hspec-discover/test-data/several-specs/BazSpec.hs view
+ hspec-discover/test-data/several-specs/FooSpec.hs view
+ hspec-discover/test-data/single-spec-nested/Foo/BarSpec.hs view
+ hspec-discover/test-data/single-spec/FooSpec.hs view
+ hspec-discover/test-data/single-spec/Spec.hs view
hspec-meta.cabal view
@@ -1,5 +1,5 @@ name:             hspec-meta-version:          1.4.3+version:          1.4.4 license:          BSD3 license-file:     LICENSE copyright:        (c) 2011-2012 Trystan Spangler, (c) 2011-2012 Simon Hengel, (c) 2011 Greg Weber@@ -15,6 +15,24 @@ description:      A stable version of Hspec which is used to test the                   in-development version of Hspec. +-- find hspec-discover/test-data/ -type f+extra-source-files:+  hspec-discover/test-data/single-spec/FooSpec.hs+  hspec-discover/test-data/single-spec/Spec.hs+  hspec-discover/test-data/single-spec-nested/Foo/BarSpec.hs+  hspec-discover/test-data/nested-spec/FooSpec.hs+  hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs+  hspec-discover/test-data/nested-spec/Foo/BarSpec.hs+  hspec-discover/test-data/several-specs/BarSpec.hs+  hspec-discover/test-data/several-specs/FooSpec.hs+  hspec-discover/test-data/several-specs/BazSpec.hs+  hspec-discover/test-data/empty-dir/Foo/Bar/Baz/.placeholder+  hspec-discover/test-data/prefix-name/FooSpec.hs+  hspec-discover/test-data/prefix-name/Foo/BazSpec.hs+  hspec-discover/test-data/prefix-name/FooBarSpec.hs+  hspec-discover/test-data/prefix-name/FooBar/BazSpec.hs+  hspec-discover/test-data/no-intermediate-specs/Foo/Bar/BazSpec.hs+ source-repository head   type: git   location: https://github.com/hspec/hspec@@ -28,7 +46,7 @@       base          == 4.*     , setenv     , silently      >= 1.1.1-    , ansi-terminal == 0.5.*+    , ansi-terminal >= 0.5     , time     , transformers  >= 0.2.2.0 && < 0.4.0     , HUnit         >= 1.2.5
src/Test/Hspec/Compat.hs view
@@ -7,9 +7,17 @@ import           Data.Typeable.Internal (tyConModule, tyConName) #endif - showType :: Typeable a => a -> String showType a = let t = typeRepTyCon (typeOf a) in+#if MIN_VERSION_base(4,4,0)+  show t+#else+  (reverse . takeWhile (/= '.') . reverse . show) t+#endif+++showFullType :: Typeable a => a -> String+showFullType a = let t = typeRepTyCon (typeOf a) in #if MIN_VERSION_base(4,4,0)   tyConModule t ++ "." ++ tyConName t #else
src/Test/Hspec/Config.hs view
@@ -26,6 +26,7 @@ , configDryRun          :: Bool , configPrintCpuTime    :: Bool , configReRun           :: Bool+, configFastFail        :: Bool  -- | -- A predicate that is used to filter the spec before it is run.  Only examples@@ -41,7 +42,7 @@ data ColorMode = ColorAuto | ColorNever | ColorAlway  defaultConfig :: Config-defaultConfig = Config False False False False Nothing defaultParams ColorAuto specdoc False stdout+defaultConfig = Config False False False False False Nothing defaultParams ColorAuto specdoc False stdout  formatters :: [(String, Formatter)] formatters = [@@ -52,7 +53,7 @@   ]  formatHelp :: String-formatHelp = unlines ("Use a custom formatter.  This can be one of:" : map (("  " ++) . fst) formatters)+formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters)  type Result = Either NoConfig Config @@ -73,24 +74,31 @@     mapParams :: (Params -> Params) -> Config -> Config     mapParams f c = c {configParams = f (configParams c)} +addLineBreaks :: String -> [String]+addLineBreaks = lineBreaksAt 44+ options :: [OptDescr (Result -> Result)] options = [-    Option []  ["help"]                    (NoArg (const $ Left Help))        "display this help and exit"-  , Option "v" ["verbose"]                 (NoArg setVerbose)                 "do not suppress output to stdout when\nevaluating examples"-  , Option "m" ["match"]                   (ReqArg setFilter "PATTERN")       "only run examples that match given PATTERN"-  , Option []  ["color"]                   (OptArg setColor "WHEN")           "colorize the output.  WHEN defaults to\n`always' or can be `never' or `auto'."+    Option []  ["help"]                    (NoArg (const $ Left Help))        (h "display this help and exit")+  , Option "v" ["verbose"]                 (NoArg setVerbose)                 (h "do not suppress output to stdout when evaluating examples")+  , Option "m" ["match"]                   (ReqArg setFilter "PATTERN")       (h "only run examples that match given PATTERN")+  , Option []  ["color"]                   (OptArg setColor "WHEN")           (h "colorize the output; WHEN defaults to `always' or can be `never' or `auto'")   , Option "f" ["format"]                  (ReqArg setFormatter "FORMATTER")  formatHelp-  , Option "a" ["qc-max-success"]          (ReqArg setQC_MaxSuccess "N")      "maximum number of successful tests before a\nQuickCheck property succeeds"-  , Option []  ["print-cpu-time"]          (NoArg setPrintCpuTime)            "include used CPU time in summary"-  , Option []  ["dry-run"]                 (NoArg setDryRun)                  "pretend that everything passed; don't verify\nanything"+  , Option "a" ["qc-max-success"]          (ReqArg setQC_MaxSuccess "N")      (h "maximum number of successful tests before a QuickCheck property succeeds")+  , Option []  ["print-cpu-time"]          (NoArg setPrintCpuTime)            (h "include used CPU time in summary")+  , Option []  ["dry-run"]                 (NoArg setDryRun)                  (h "pretend that everything passed; don't verify anything")+  , Option []  ["fast-fail"]               (NoArg setFastFail)                (h "stop after first failure")   ]   where+    h = unlines . addLineBreaks+     setFilter :: String -> Result -> Result     setFilter pattern x = configAddFilter (filterPredicate pattern) <$> x      setVerbose      x = x >>= \c -> return c {configVerbose      = True}     setPrintCpuTime x = x >>= \c -> return c {configPrintCpuTime = True}     setDryRun       x = x >>= \c -> return c {configDryRun       = True}+    setFastFail     x = x >>= \c -> return c {configFastFail     = True}      setFormatter name x = x >>= \c -> case lookup name formatters of       Nothing -> Left (InvalidArgument "format" name)
src/Test/Hspec/Formatters.hs view
@@ -42,14 +42,16 @@ , withSuccessColor , withPendingColor , withFailColor++-- ** Helpers+, formatException ) where  import           Data.Maybe import           Test.Hspec.Util import           Test.Hspec.Compat-import           Data.List (intersperse) import           Text.Printf-import           Control.Monad (unless)+import           Control.Monad (unless, forM_) import           Control.Applicative import qualified Control.Exception as E @@ -149,20 +151,36 @@ defaultFailedFormatter :: FormatM () defaultFailedFormatter = do   newParagraph-  withFailColor $ do-    failures <- map formatFailure . zip [1..] <$> getFailMessages-    mapM_ writeLine (intersperse "" failures)-    unless (null failures) (writeLine "")++  failures <- getFailMessages++  forM_ (zip [1..] failures) $ \x -> do+    formatFailure x+    writeLine ""   where-    formatFailure :: (Int, FailureRecord) -> String-    formatFailure (i, FailureRecord path reason) =-      show i ++ ") " ++ formatRequirement path ++ " FAILED" ++ err+    formatFailure :: (Int, FailureRecord) -> FormatM ()+    formatFailure (n, FailureRecord path reason) = do+      write (show n ++ ") ")+      withFailColor $ do+        write (formatRequirement path ++ " FAILED")+        write $ case reason of+          Right _ -> "\n"+          Left _  -> " (uncaught exception)\n"+        unless (null err) $ do+          writeLine err       where-        err = case reason of-          Left (E.SomeException e)  -> " (uncaught exception)\n" ++ formatException e-          Right e -> if null e then "" else "\n" ++ e+        err = either formatException id reason -        formatException e = showType e ++ " (" ++ show e ++ ")"+-- | Convert an exception to a string.+--+-- The type of the exception is included.  Here is an example:+--+-- >>> import Control.Applicative+-- >>> import Control.Exception+-- >>> either formatException show <$> (try . evaluate) (1 `div` 0)+-- "ArithException (divide by zero)"+formatException :: E.SomeException -> String+formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")"  defaultFooter :: FormatM () defaultFooter = do
src/Test/Hspec/Formatters/Internal.hs view
@@ -31,29 +31,32 @@ , increasePendingCount , increaseFailCount , addFailMessage+, finally_ ) where  import qualified System.IO as IO import           System.IO (Handle) import           Control.Monad (when, unless) import           Control.Applicative-import           Control.Exception (SomeException, bracket_)+import           Control.Exception (SomeException, AsyncException(..), bracket_, try, throwIO) import           System.Console.ANSI import           Control.Monad.Trans.State hiding (gets, modify)-import qualified Control.Monad.Trans.State as State import qualified Control.Monad.IO.Class as IOClass import qualified System.CPUTime as CPUTime+import           Data.IORef import           Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)  import           Test.Hspec.Util (Path) --- | A lifted version of `State.gets`+-- | A lifted version of `Control.Monad.Trans.State.gets` gets :: (FormatterState -> a) -> FormatM a-gets f = FormatM (State.gets f)+gets f = FormatM $ do+  f <$> (get >>= IOClass.liftIO . readIORef) --- | A lifted version of `State.modify`+-- | A lifted version of `Control.Monad.Trans.State.modify` modify :: (FormatterState -> FormatterState) -> FormatM ()-modify f = FormatM (State.modify f)+modify f = FormatM $ do+  get >>= IOClass.liftIO . (`modifyIORef` f)  -- | A lifted version of `IOClass.liftIO` --@@ -80,14 +83,17 @@ totalCount :: FormatterState -> Int totalCount s = successCount s + pendingCount s + failCount s -newtype FormatM a = FormatM (StateT FormatterState IO a)+-- NOTE: We use an IORef here, so that the state persists when UserInterrupt is+-- thrown.+newtype FormatM a = FormatM (StateT (IORef FormatterState) IO a)   deriving (Functor, Applicative, Monad)  runFormatM :: Bool -> Bool -> Bool -> Handle -> FormatM a -> IO a runFormatM useColor produceHTML_ printCpuTime handle (FormatM action) = do   time <- getPOSIXTime   cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing-  evalStateT action (FormatterState handle useColor produceHTML_ False 0 0 0 [] cpuTime time)+  st <- newIORef (FormatterState handle useColor produceHTML_ False 0 0 0 [] cpuTime time)+  evalStateT action st  -- | Increase the counter for successful examples increaseSuccessCount :: FormatM ()@@ -207,20 +213,35 @@ htmlSpan cls action = write ("<span class=\"" ++ cls ++ "\">") *> action <* write "</span>"  withColor_ :: SGR -> FormatM a -> FormatM a-withColor_ color (FormatM action) = FormatM . StateT $ \st -> do-  let useColor = stateUseColor st-      h        = stateHandle st+withColor_ color (FormatM action) = do+  useColor <- gets stateUseColor+  h        <- gets stateHandle -  bracket_+  FormatM . StateT $ \st -> do+    bracket_ -    -- set color-    (when useColor $ hSetSGR h [color])+      -- set color+      (when useColor $ hSetSGR h [color]) -    -- reset colors-    (when useColor $ hSetSGR h [Reset])+      -- reset colors+      (when useColor $ hSetSGR h [Reset]) -    -- run action-    (runStateT action st)+      -- run action+      (runStateT action st)++-- |+-- @finally_ actionA actionB@ runs @actionA@ and then @actionB@.  @actionB@ is+-- run even when a `UserInterrupt` occurs during @actionA@.+finally_ :: FormatM () -> FormatM () -> FormatM ()+finally_ (FormatM actionA) (FormatM actionB) = FormatM . StateT $ \st -> do+  r <- try (execStateT actionA st)+  case r of+    Left e -> do+      when (e == UserInterrupt) $+        runStateT actionB st >> return ()+      throwIO e+    Right st_ -> do+      runStateT actionB st_  -- | Get the used CPU time since the test run has been started. getCPUTime :: FormatM (Maybe Double)
src/Test/Hspec/Runner.hs view
@@ -48,8 +48,17 @@  -- | Evaluate all examples of a given spec and produce a report. runFormatter :: Config -> Formatter -> [SpecTree] -> FormatM ()-runFormatter c formatter specs = headerFormatter formatter >> mapM_ (go []) (zip [0..] specs)+runFormatter c formatter specs = headerFormatter formatter >> zip [0..] specs `each` go []   where+    -- like forM_, but respects --fast-fail+    each :: [a] -> (a -> FormatM ()) -> FormatM ()+    each []     _ = pure ()+    each (x:xs) f = do+      f x+      fails <- getFailCount+      unless (configFastFail c && fails /= 0) $ do+        xs `each` f+     silence_       | configVerbose c = id       | otherwise       = silence@@ -61,7 +70,7 @@     go :: [String] -> (Int, SpecTree) -> FormatM ()     go rGroups (n, SpecGroup group xs) = do       exampleGroupStarted formatter n (reverse rGroups) group-      mapM_ (go (group : rGroups)) (zip [0..] xs)+      zip [0..] xs `each` go (group : rGroups)       exampleGroupDone formatter     go rGroups (_, SpecItem requirement example) = do       result <- eval (example $ configParams c)@@ -115,8 +124,9 @@    useColor <- doesUseColor h c   runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) h $ do-    runFormatter c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec)-    failedFormatter formatter+    runFormatter c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_`+      failedFormatter formatter+     footerFormatter formatter      -- dump failure report
src/Test/Hspec/Util.hs view
@@ -1,5 +1,6 @@ module Test.Hspec.Util (   quantify+, lineBreaksAt , safeEvaluate , Path , filterPredicate@@ -78,3 +79,18 @@  getEnv :: String -> IO (Maybe String) getEnv key = either (const Nothing) Just <$> safeEvaluate (Environment.getEnv key)++-- ensure that lines are not longer then given `n`, insert line beraks at word+-- boundaries+lineBreaksAt :: Int -> String -> [String]+lineBreaksAt n input = case words input of+  []   -> []+  x:xs -> go (x, xs)+  where+    go :: (String, [String]) -> [String]+    go c = case c of+      (s, [])   -> [s]+      (s, y:ys) -> let r = s ++ " " ++ y in+        if length r <= n+          then go (r, ys)+          else s : go (y, ys)