hspec 1.3.0.2 → 1.4.0

raw patch · 19 files changed

+788/−567 lines, 19 filesdep +ghc-pathsdep +processdep +setenvdep ~HUnitdep ~QuickCheckdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-paths, process, setenv

Dependency ranges changed: HUnit, QuickCheck, base, doctest, hspec-expectations, transformers

API changes (from Hackage documentation)

Files

• example/NonMonadic.hs +0/−23
• example/Spec.hs +2/−7
• hspec.cabal +19/−25
• src/Test/Hspec.hs +33/−5
• src/Test/Hspec/Compat.hs +17/−0
• src/Test/Hspec/Config.hs +140/−0
• src/Test/Hspec/Core.hs +54/−115
• src/Test/Hspec/Core/Type.hs +86/−0
• src/Test/Hspec/FailureReport.hs +26/−0
• src/Test/Hspec/Formatters.hs +75/−36
• src/Test/Hspec/Formatters/Internal.hs +73/−29
• src/Test/Hspec/HUnit.hs +27/−33
• src/Test/Hspec/Internal.hs +0/−80
• src/Test/Hspec/Monadic.hs +21/−86
• src/Test/Hspec/Pending.hs +9/−10
• src/Test/Hspec/QuickCheck.hs +21/−38
• src/Test/Hspec/Runner.hs +104/−79
• src/Test/Hspec/Util.hs +80/−0
• test/doctests.hs +1/−1

@@ -1,23 +0,0 @@-module Main (main, spec) where--import Test.Hspec.Core-import Test.Hspec.HUnit ()-import Test.Hspec.QuickCheck-import Test.HUnit--shouldBe :: (Show a, Eq a) => a -> a -> Assertion-actual `shouldBe` expected = actual @?= expected--main :: IO ()-main = hspec spec--spec :: Specs-spec = [-    describe "reverse" [-      it "reverses a list" $ do-        reverse [1 :: Int, 2, 3] `shouldBe` [3, 2, 1]--    , it "gives the original list, if applied twice" $ property $-        \(xs) -> reverse (reverse xs) == (xs :: [Int])-    ]-  ]

@@ -1,12 +1,7 @@ module Main (main, spec) where -import Test.Hspec.Monadic-import Test.Hspec.HUnit ()-import Test.Hspec.QuickCheck-import Test.HUnit--shouldBe :: (Show a, Eq a) => a -> a -> Assertion-actual `shouldBe` expected = actual @?= expected+import Test.Hspec+import Test.QuickCheck  main :: IO () main = hspec spec

@@ -1,5 +1,5 @@ name:             hspec-version:          1.3.0.2+version:          1.4.0 license:          BSD3 license-file:     LICENSE copyright:        (c) 2011-2012 Trystan Spangler, (c) 2011-2012 Simon Hengel, (c) 2011 Greg Weber@@ -18,8 +18,7 @@                   tests. Compared to other options, it provides a much nicer                   syntax that makes tests very easy to read.                   .-                  Start with the introductory documentation:-                  <http://hspec.github.com/>+                  The Hspec Manual is at <http://hspec.github.com/>.  source-repository head   type: git@@ -32,13 +31,14 @@       src   build-depends:       base >= 4 && <= 5+    , setenv     , silently >= 1.1.1 && < 2     , ansi-terminal == 0.5.5     , time < 1.5-    , transformers >= 0.2.0 && < 0.4.0-    , HUnit >= 1 && <= 2+    , transformers >= 0.2.2.0 && < 0.4.0+    , HUnit >= 1.2.5     , QuickCheck >= 2.4.0.1 && < 2.6-    , hspec-expectations == 0.3.0.*+    , hspec-expectations   exposed-modules:       Test.Hspec       Test.Hspec.Core@@ -48,8 +48,12 @@       Test.Hspec.HUnit       Test.Hspec.QuickCheck   other-modules:+      Test.Hspec.Util+      Test.Hspec.Compat       Test.Hspec.Pending-      Test.Hspec.Internal+      Test.Hspec.Core.Type+      Test.Hspec.Config+      Test.Hspec.FailureReport       Test.Hspec.Formatters.Internal  test-suite spec@@ -63,14 +67,18 @@       -Wall -Werror   build-depends:       base >= 4 && <= 5+    , setenv     , silently >= 1.1.1 && < 2     , ansi-terminal == 0.5.5     , time < 1.5-    , transformers >= 0.2.0 && < 0.4.0-    , HUnit >= 1 && <= 2+    , transformers >= 0.2.2.0 && < 0.4.0+    , HUnit >= 1.2.5     , QuickCheck >= 2.4.0.1 && < 2.6     , hspec-expectations+     , hspec-meta+    , process+    , ghc-paths  test-suite doctests   main-is:@@ -83,7 +91,7 @@       test   build-depends:       base-    , doctest >= 0.7+    , doctest >= 0.8  test-suite example   type:@@ -97,21 +105,7 @@   build-depends:       base     , hspec-    , HUnit--test-suite example-non-monadic-  type:-      exitcode-stdio-1.0-  main-is:-      NonMonadic.hs-  hs-source-dirs:-      example-  ghc-options:-      -Wall -Werror-  build-depends:-      base-    , hspec-    , HUnit+    , QuickCheck  -- hspec-discover executable hspec-discover

@@ -1,5 +1,6 @@-{-# OPTIONS_HADDOCK prune #-} -- |+-- Stability: stable+-- -- Hspec is a framework for /Behavior-Driven Development (BDD)/ in Haskell. BDD -- is an approach to software development that combines Test-Driven -- Development, Domain-Driven Design, and Acceptance Test-Driven Planning.@@ -8,8 +9,10 @@ -- -- Hspec (and the preceding intro) are based on the Ruby library RSpec. Much of -- what applies to RSpec also applies to Hspec. Hspec ties together--- /descriptions/ of behavior and /examples/ of that behavior. The examples can--- also be run as tests and the output summarizes what needs to be implemented.+-- /textual descriptions/ of behavior and /examples/ for that behavior.  The+-- examples serve as test cases for the specified behavior.  Hspec's mechanism+-- for examples is extensible.  Support for QuickCheck properties and HUnit+-- tests is included in the core package. module Test.Hspec (  -- * Introduction@@ -33,10 +36,12 @@ , hspec ) where -import           Test.Hspec.Monadic+import           Test.Hspec.Core.Type hiding (describe, it)+import           Test.Hspec.Runner import           Test.Hspec.HUnit ()-import           Test.Hspec.QuickCheck () import           Test.Hspec.Expectations+import           Test.Hspec.Pending+import qualified Test.Hspec.Core as Core  -- $intro --@@ -98,3 +103,26 @@ -- > phoneNumber = do -- >   n <- elements [7,10,11,12,13,14,15] -- >   vectorOf n (elements "0123456789")+++-- | Combine a list of specs into a larger spec.+describe :: String -> Spec -> Spec+describe label action = fromSpecList [Core.describe label (runSpecM action)]++-- | An alias for `describe`.+context :: String -> Spec -> Spec+context = describe++-- | Create a spec item.+--+-- A spec item consists of:+--+-- * a textual description of a desired behavior+--+-- * an example for that behavior+--+-- > describe "absolute" $ do+-- >   it "returns a positive number when given a negative number" $+-- >     absolute (-1) == 1+it :: Example v => String -> v -> Spec+it label action = fromSpecList [Core.it label action]

@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Compat where++import           Data.Typeable (Typeable, typeOf, typeRepTyCon)++#if MIN_VERSION_base(4,5,0)+import           Data.Typeable (tyConModule, tyConName)+#endif+++showType :: Typeable a => a -> String+showType a = let t = typeRepTyCon (typeOf a) in+#if MIN_VERSION_base(4,5,0)+  tyConModule t ++ "." ++ tyConName t+#else+  show t+#endif

@@ -0,0 +1,140 @@+module Test.Hspec.Config (+  Config (..)+, ColorMode (..)+, defaultConfig+, getConfig+, configAddFilter+) where++import           Control.Monad (unless)+import           Control.Applicative+import           System.IO+import           System.Exit+import           System.Environment+import           System.Console.GetOpt+import qualified Test.QuickCheck as QC+import           Test.Hspec.Formatters++import           Test.Hspec.Util+import           Test.Hspec.Core.Type (Params (..), defaultParams)++-- for Monad (Either e) when base < 4.3+import           Control.Monad.Trans.Error ()++data Config = Config {+  configVerbose         :: Bool+, configReRun           :: Bool++-- |+-- A predicate that is used to filter the spec before it is run.  Only examples+-- that satisfy the predicate are run.+, configFilterPredicate :: Maybe (Path -> Bool)+, configParams          :: Params+, configColorMode       :: ColorMode+, configFormatter       :: Formatter+, configHtmlOutput      :: Bool+, configHandle          :: Handle+}++data ColorMode = ColorAuto | ColorNever | ColorAlway++defaultConfig :: Config+defaultConfig = Config False False Nothing defaultParams ColorAuto specdoc False stdout++formatters :: [(String, Formatter)]+formatters = [+    ("specdoc", specdoc)+  , ("progress", progress)+  , ("failed-examples", failed_examples)+  , ("silent", silent)+  ]++formatHelp :: String+formatHelp = unlines ("Use a custom formatter.  This can be one of:" : map (("  " ++) . fst) formatters)++type Result = Either NoConfig Config++data NoConfig = Help | InvalidArgument String String++-- | Add a filter predicate to config.  If there is already a filter predicate,+-- then combine them with `||`.+configAddFilter :: (Path -> Bool) -> Config -> Config+configAddFilter p1 c = c {configFilterPredicate = Just p}+  where+    -- if there is already a predicate, we combine them with ||+    p  = maybe p1 (\p0 path -> p0 path || p1 path) mp+    mp = configFilterPredicate c++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 evaluating 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 `always' or can be `never' or `auto'."+  , Option "f" ["format"]                  (ReqArg setFormatter "FORMATTER")  formatHelp+  , Option "a" ["maximum-generated-tests"] (ReqArg setQC_MaxSuccess "NUMBER") "how many automated tests something like QuickCheck should try, by default"+  ]+  where+    setFilter :: String -> Result -> Result+    setFilter pattern x = configAddFilter (filterPredicate pattern) <$> x++    setVerbose x = x >>= \c -> return c {configVerbose = True}++    setFormatter name x = x >>= \c -> case lookup name formatters of+      Nothing -> Left (InvalidArgument "format" name)+      Just f  -> return c {configFormatter = f}++    setQC_MaxSuccess :: String -> Result -> Result+    setQC_MaxSuccess n x = (mapParams $ \p -> p {paramsQuickCheckArgs = (paramsQuickCheckArgs p) {QC.maxSuccess = read n}}) <$> x++    mapParams :: (Params -> Params) -> Config -> Config+    mapParams f c = c {configParams = f (configParams c)}++    setColor mValue x = x >>= \c -> parseColor mValue >>= \v -> return c {configColorMode = v}+      where+        parseColor s = case s of+          Nothing       -> return ColorAuto+          Just "auto"   -> return ColorAuto+          Just "never"  -> return ColorNever+          Just "always" -> return ColorAlway+          Just v        -> Left (InvalidArgument "color" v)++undocumentedOptions :: [OptDescr (Result -> Result)]+undocumentedOptions = [+    Option "r" ["re-run"]                  (NoArg  setReRun)                  "only re-run examples that previously failed"++    -- undocumented for now, as we probably want to change this to produce a+    -- standalone HTML report in the future+  , Option []  ["html"]                    (NoArg setHtml)                    "produce HTML output"+  ]+  where+    setReRun :: Result -> Result+    setReRun x = x >>= \c -> return c {configReRun = True}++    setHtml :: Result -> Result+    setHtml x = x >>= \c -> return c {configHtmlOutput = True}++getConfig :: IO Config+getConfig = do+  (opts, args, errors) <- getOpt Permute (options ++ undocumentedOptions) <$> getArgs++  unless (null errors)+    (tryHelp $ head errors)++  unless (null args)+    (tryHelp $ "unexpected argument `" ++ head args ++ "'\n")++  case foldl (flip id) (Right defaultConfig) opts of+    Left Help -> do+      name <- getProgName+      putStr $ usageInfo ("Usage: " ++ name ++ " [OPTION]...\n\nOPTIONS") options+      exitSuccess+    Left (InvalidArgument flag value) -> do+      tryHelp $ "invalid argument `" ++ value ++ "' for `--" ++ flag ++ "'\n"+    Right config -> do+      return config+  where+    tryHelp message = do+      name <- getProgName+      hPutStr stderr $ name ++ ": " ++ message ++ "Try `" ++ name ++ " --help' for more information.\n"+      exitFailure

@@ -1,133 +1,72 @@-{-# OPTIONS_HADDOCK prune #-} -- |--- NOTE: There is a monadic and a non-monadic API.  This is the documentation--- for the non-monadic API.  The monadic API is more stable, so you may prefer--- it over this one.  For documentation on the monadic API look at--- "Test.Hspec".+-- Stability: experimental+--+-- This module provides access to Hspec's internals.  It is less stable than+-- other parts of the API.  For most users "Test.Hspec" is more suitable! module Test.Hspec.Core ( ---- * Introduction--- $intro+-- * A type class for examples+  Example (..)+, Params (..)+, Result (..) --- * Types-  Spec-, Specs-, Example (..)-, Pending+-- * A writer monad for constructing specs+, SpecM+, runSpecM+, fromSpecList --- * Defining a spec+-- * Internal representation of a spec tree+, SpecTree (..) , describe , it-, pending --- * Running a spec-, hspec+-- * Deprecated types and functions+, Spec+, Specs , hspecB+, hspecX , hHspec-, Summary (..)+, hspec+, Pending+, pending+) where --- * Internals-, quantify-, Result (..)+import           Control.Applicative+import           System.IO (Handle) --- deprecated stuff-, descriptions-, hspecX-, AnyExample-, safeEvaluateExample-, UnevaluatedSpec-) where+import           Test.Hspec.Core.Type hiding (Spec)+import qualified Test.Hspec.Pending as Pending+import qualified Test.Hspec.Runner as Runner+import           Test.Hspec.Runner (Summary(..), Config(..), defaultConfig) -import           Test.Hspec.Internal hiding (safeEvaluateExample)-import qualified Test.Hspec.Internal as Internal-import           Test.Hspec.Pending-import           Test.Hspec.Runner+hspecWith :: Config -> [SpecTree] -> IO Summary+hspecWith c = Runner.hspecWith c . fromSpecList --- $intro------ The three functions you'll use the most are 'hspec', 'describe', and 'it'.--- Here is an example of functions that format and unformat phone numbers and--- the specs for them.------ > import Test.Hspec--- > import Test.Hspec.QuickCheck--- > import Test.Hspec.HUnit ()--- > import Test.QuickCheck--- > import Test.HUnit--- >--- > main :: IO ()--- > main = hspec spec------ Since the specs are often used to tell you what to implement, it's best to--- start with undefined functions. Once we have some specs, then you can--- implement each behavior one at a time, ensuring that each behavior is met--- and there is no undocumented behavior.------ > unformatPhoneNumber :: String -> String--- > unformatPhoneNumber number = undefined--- >--- > formatPhoneNumber :: String -> String--- > formatPhoneNumber number = undefined------ The 'describe' function takes a list of behaviors and examples bound--- together with the 'it' function------ > spec = [describe "unformatPhoneNumber" [------ A boolean expression can act as a behavior's example.------ >   it "removes dashes, spaces, and parenthesies" $--- >     unformatPhoneNumber "(555) 555-1234" == "5555551234"--- >   ,------ The 'pending' function marks a behavior as pending an example. The example--- doesn't count as failing.------ >   it "handles non-US phone numbers" $--- >     pending "need to look up how other cultures format phone numbers"--- >   ,------ An HUnit 'Test.HUnit.Test' can act as a behavior's example. (must import--- "Test.Hspec.HUnit")------ >   it "removes the \"ext\" prefix of the extension" $ TestCase $ do--- >     let expected = "5555551234135"--- >         actual   = unformatPhoneNumber "(555) 555-1234 ext 135"--- >     expected @?= actual--- >   ,------ An @IO()@ action is treated like an HUnit 'TestCase'. (must import--- "Test.Hspec.HUnit")------ >   it "converts letters to numbers" $ do--- >     let expected = "6862377"--- >         actual   = unformatPhoneNumber "NUMBERS"--- >     actual @?= expected--- >   ,------ The 'property' function allows a QuickCheck property to act as an example.--- (must import "Test.Hspec.QuickCheck")------ >   it "can add and remove formatting without changing the number" $ property $--- >     forAll phoneNumber $ \n -> unformatPhoneNumber (formatPhoneNumber n) == n--- >   ]]--- >--- > phoneNumber :: Gen String--- > phoneNumber = do--- >   n <- elements [7,10,11,12,13,14,15]--- >   vectorOf n (elements "0123456789")+{-# DEPRECATED hspecX "use `Test.Hspec.Runner.hspec` instead" #-}     -- since 1.2.0+hspecX :: [SpecTree] -> IO ()+hspecX = hspec -{-# DEPRECATED UnevaluatedSpec "use Spec instead" #-}-type UnevaluatedSpec = Spec+{-# DEPRECATED hspec "use `Test.Hspec.Runner.hspec` instead" #-}      -- since 1.4.0+hspec :: [SpecTree] -> IO ()+hspec = Runner.hspec . fromSpecList -{-# DEPRECATED descriptions "this is no longer needed, and will be removed in a future release" #-}-descriptions :: Specs -> Specs-descriptions = id+{-# DEPRECATED hspecB "use `Test.Hspec.Runner.hspecWith` instead" #-} -- since 1.4.0+hspecB :: [SpecTree] -> IO Bool+hspecB spec = (== 0) . summaryFailures <$> hspecWith defaultConfig spec -{-# DEPRECATED AnyExample "This will be removed with the next major release.  If you still need this, raise your voice!" #-}-type AnyExample  = IO Result+{-# DEPRECATED hHspec "use `Test.Hspec.Runner.hspecWith` instead" #-} -- since 1.4.0+hHspec :: Handle -> [SpecTree] -> IO Summary+hHspec h = hspecWith defaultConfig {configHandle = h} -{-# DEPRECATED safeEvaluateExample "This will be removed with the next major release.  If you still need this, raise your voice!" #-}-safeEvaluateExample :: AnyExample -> IO Result-safeEvaluateExample = Internal.safeEvaluateExample+{-# DEPRECATED Spec "use `SpecTree` instead" #-}                      -- since 1.4.0+type Spec = SpecTree++{-# DEPRECATED Specs "use `[SpecTree]` instead" #-}                   -- since 1.4.0+type Specs = [SpecTree]++{-# DEPRECATED pending "use `Test.Hspec.pending` instead" #-}         -- since 1.4.0+pending :: String -> Pending+pending = Pending.pending++{-# DEPRECATED Pending "use `Test.Hspec.Pending` instead" #-}         -- since 1.4.0+type Pending = Pending.Pending

@@ -0,0 +1,86 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving #-}+module Test.Hspec.Core.Type (+  Spec+, SpecM (..)+, runSpecM+, fromSpecList+, SpecTree (..)+, Example (..)+, Result (..)++, Params (..)+, defaultParams++, describe+, it+) where++import qualified Control.Exception as E+import           Control.Applicative+import           Control.Monad.Trans.Writer (Writer, execWriter, tell)++import           Test.Hspec.Util+import           Test.Hspec.Expectations+import           Test.HUnit.Lang (HUnitFailure(..))+import qualified Test.QuickCheck as QC++type Spec = SpecM ()++-- | A writer monad for `SpecTree` forests.+newtype SpecM a = SpecM (Writer [SpecTree] a)+  deriving (Functor, Applicative, Monad)++-- | Convert a `Spec` to a forest of `SpecTree`s.+runSpecM :: Spec -> [SpecTree]+runSpecM (SpecM specs) = execWriter specs++-- | Create a `Spec` from a forest of `SpecTree`s.+fromSpecList :: [SpecTree] -> Spec+fromSpecList = SpecM . tell++-- | The result of running an example.+data Result = Success | Pending (Maybe String) | Fail String+  deriving (Eq, Show)++data Params = Params {+  paramsQuickCheckArgs :: QC.Args+}++defaultParams :: Params+defaultParams = Params QC.stdArgs++-- | Internal representation of a spec.+data SpecTree =+    SpecGroup String [SpecTree]+  | SpecItem  String (Params -> IO Result)++-- | The @describe@ function combines a list of specs into a larger spec.+describe :: String -> [SpecTree] -> SpecTree+describe = SpecGroup++-- | Create a spec item.+it :: Example a => String -> a -> SpecTree+it s e = SpecItem s (`evaluateExample` e)++-- | A type class for examples.+class Example a where+  evaluateExample :: Params -> a -> IO Result++instance Example Bool where+  evaluateExample _ b = if b then return Success else return (Fail "")++instance Example Expectation where+  evaluateExample _ action = (action >> return Success) `E.catch` \(HUnitFailure err) -> return (Fail err)++instance Example Result where+  evaluateExample _ r = r `seq` return r++instance Example QC.Property where+  evaluateExample c p = do+    r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) p+    return $+      case r of+        QC.Success {}               -> Success+        f@(QC.Failure {})           -> Fail (QC.output f)+        QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ quantify n "test" )+        QC.NoExpectedFailure {}     -> Fail ("No expected failure")

@@ -0,0 +1,26 @@+module Test.Hspec.FailureReport where++import           System.IO+import           System.SetEnv+import           Test.Hspec.Config+import           Test.Hspec.Util (safeEvaluate, readMaybe, getEnv)++writeFailureReport :: String -> IO ()+writeFailureReport x = do+  -- on Windows this can throw an exception when the input is too large, hence+  -- we use `safeEvaluate` here+  r <- safeEvaluate (setEnv "HSPEC_FAILURES" x)+  either onError return r+  where+    onError err = do+      hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")")++readFailureReport :: Config -> IO Config+readFailureReport c = do+  mx <- getEnv "HSPEC_FAILURES"+  case mx >>= readMaybe of+    Nothing -> do+      hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--re-run' is ignored!"+      return c+    Just xs -> do+      return $ configAddFilter (`elem` xs) c

@@ -1,6 +1,8 @@--- | This module contains formatters that take a set of specs and write to a given handle.--- They follow a structure similar to RSpec formatters.+-- |+-- Stability: experimental --+-- This module contains formatters that can be used with+-- `Test.Hspec.Runner.hspecWith`. module Test.Hspec.Formatters (  -- * Formatters@@ -24,13 +26,17 @@ , getPendingCount , getFailCount , getTotalCount++, FailureRecord (..) , getFailMessages+ , getCPUTime , getRealTime  -- ** Appending to the gerenated report , write , writeLine+, newParagraph  -- ** Dealing with colors , withSuccessColor@@ -39,11 +45,13 @@ ) where  import           Data.Maybe-import           Test.Hspec.Internal (quantify)+import           Test.Hspec.Util+import           Test.Hspec.Compat import           Data.List (intersperse) import           Text.Printf import           Control.Monad (unless) import           Control.Applicative+import qualified Control.Exception as E  -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make -- sure, that we only use the public API to implement formatters.@@ -58,12 +66,16 @@   , getPendingCount   , getFailCount   , getTotalCount++  , FailureRecord (..)   , getFailMessages+   , getCPUTime   , getRealTime    , write   , writeLine+  , newParagraph    , withSuccessColor   , withPendingColor@@ -73,11 +85,12 @@  silent :: Formatter silent = Formatter {-  formatterName       = "silent"-, exampleGroupStarted = \_ _ -> return ()-, exampleSucceeded    = \_ _ -> return ()-, exampleFailed       = \_ _ _ -> return ()-, examplePending      = \_ _ _  -> return ()+  headerFormatter     = return ()+, exampleGroupStarted = \_ _ _ -> return ()+, exampleGroupDone    = return ()+, exampleSucceeded    = \_ -> return ()+, exampleFailed       = \_ _ -> return ()+, examplePending      = \_ _  -> return () , failedFormatter     = return () , footerFormatter     = return () }@@ -85,35 +98,43 @@  specdoc :: Formatter specdoc = silent {-  formatterName = "specdoc" -, exampleGroupStarted = \nesting name -> do-    writeLine ("\n" ++ indentationForGroup nesting ++ name)+  headerFormatter = do+    writeLine "" -, exampleSucceeded = \nesting requirement -> withSuccessColor $ do-    writeLine $ indentationForExample nesting ++ " - " ++ requirement+, exampleGroupStarted = \n nesting name -> do -, exampleFailed = \nesting requirement _ -> withFailColor $ do+    -- separate groups with an empty line+    unless (n == 0) $ do+      newParagraph++    writeLine (indentationFor nesting ++ name)++, exampleGroupDone = do+    newParagraph++, exampleSucceeded = \(nesting, requirement) -> withSuccessColor $ do+    writeLine $ indentationFor nesting ++ "- " ++ requirement++, exampleFailed = \(nesting, requirement) _ -> withFailColor $ do     n <- getFailCount-    writeLine $ indentationForExample nesting ++ " - " ++ requirement ++ " FAILED [" ++ show n ++ "]"+    writeLine $ indentationFor nesting ++ "- " ++ requirement ++ " FAILED [" ++ show n ++ "]" -, examplePending = \nesting requirement reason -> withPendingColor $ do-    writeLine $ indentationForExample nesting ++ " - " ++ requirement ++ "\n     # PENDING: " ++ fromMaybe "No reason given" reason+, examplePending = \(nesting, requirement) reason -> withPendingColor $ do+    writeLine $ indentationFor nesting ++ "- " ++ requirement ++ "\n     # PENDING: " ++ fromMaybe "No reason given" reason  , failedFormatter = defaultFailedFormatter  , footerFormatter = defaultFooter } where-    indentationForExample nesting = replicate (pred nesting * 2) ' '-    indentationForGroup nesting = replicate (nesting * 2) ' '+    indentationFor nesting = replicate (length nesting * 2) ' '   progress :: Formatter progress = silent {-  formatterName    = "progress"-, exampleSucceeded = \_ _ -> withSuccessColor $ write "."-, exampleFailed    = \_ _ _ -> withFailColor    $ write "F"-, examplePending   = \_ _ _ -> withPendingColor $ write "."+  exampleSucceeded = \_   -> withSuccessColor $ write "."+, exampleFailed    = \_ _ -> withFailColor    $ write "F"+, examplePending   = \_ _ -> withPendingColor $ write "." , failedFormatter  = defaultFailedFormatter , footerFormatter  = defaultFooter }@@ -121,26 +142,44 @@  failed_examples :: Formatter failed_examples   = silent {-  formatterName   = "failed_examples"-, failedFormatter = defaultFailedFormatter+  failedFormatter = defaultFailedFormatter , footerFormatter = defaultFooter } - defaultFailedFormatter :: FormatM ()-defaultFailedFormatter = withFailColor $ do-  failures <- getFailMessages-  mapM_ writeLine ("" : intersperse "" failures)-  unless (null failures) (writeLine "")+defaultFailedFormatter = do+  newParagraph+  withFailColor $ do+    failures <- map formatFailure . zip [1..] <$> getFailMessages+    mapM_ writeLine (intersperse "" failures)+    unless (null failures) (writeLine "")+  where+    formatFailure :: (Int, FailureRecord) -> String+    formatFailure (i, FailureRecord path reason) =+      show i ++ ") " ++ formatRequirement path ++ " FAILED" ++ err+      where+        err = case reason of+          Left (E.SomeException e)  -> " (uncaught exception)\n" ++ formatException e+          Right e -> if null e then "" else "\n" ++ e +        formatException e = showType e ++ " (" ++ show e ++ ")"+ defaultFooter :: FormatM () defaultFooter = do    writeLine =<< printf "Finished in %1.4f seconds, used %1.4f seconds of CPU time" <$> getRealTime <*> getCPUTime -  fails <- getFailCount-  total <- getTotalCount-  (if fails == 0 then withSuccessColor else withFailColor) $ do-    writeLine ""-    write $ quantify total "example" ++ ", "-    writeLine $ quantify fails "failure"+  fails   <- getFailCount+  pending <- getPendingCount+  total   <- getTotalCount+  writeLine ""++  let c | fails /= 0   = withFailColor+        | pending /= 0 = withPendingColor+        | otherwise    = withSuccessColor+  c $ do+    write $ quantify total   "example"+    write (", " ++ quantify fails "failure")+    unless (pending == 0) $+      write (", " ++ show pending ++ " pending")+  writeLine ""

@@ -9,12 +9,16 @@ , getPendingCount , getFailCount , getTotalCount++, FailureRecord (..) , getFailMessages+ , getCPUTime , getRealTime  , write , writeLine+, newParagraph  , withSuccessColor , withPendingColor@@ -31,9 +35,9 @@  import qualified System.IO as IO import           System.IO (Handle)-import           Control.Monad (when)+import           Control.Monad (when, unless) import           Control.Applicative-import           Control.Exception (bracket_)+import           Control.Exception (SomeException, bracket_) import           System.Console.ANSI import           Control.Monad.Trans.State hiding (gets, modify) import qualified Control.Monad.Trans.State as State@@ -41,6 +45,8 @@ import qualified System.CPUTime as CPUTime import           Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) +import           Test.Hspec.Util (Path)+ -- | A lifted version of `State.gets` gets :: (FormatterState -> a) -> FormatM a gets f = FormatM (State.gets f)@@ -58,14 +64,16 @@ liftIO action = FormatM (IOClass.liftIO action)  data FormatterState = FormatterState {-  stateHandle   :: Handle-, stateUseColor :: Bool-, successCount  :: Int-, pendingCount  :: Int-, failCount     :: Int-, failMessages  :: [String]-, cpuStartTime  :: Integer-, startTime     :: POSIXTime+  stateHandle     :: Handle+, stateUseColor   :: Bool+, produceHTML     :: Bool+, lastIsEmptyLine :: Bool    -- True, if last line was empty+, successCount    :: Int+, pendingCount    :: Int+, failCount       :: Int+, failMessages    :: [FailureRecord]+, cpuStartTime    :: Integer+, startTime       :: POSIXTime }  -- | The total number of examples encountered so far.@@ -75,11 +83,11 @@ newtype FormatM a = FormatM (StateT FormatterState IO a)   deriving (Functor, Applicative, Monad) -runFormatM :: Bool -> Handle -> FormatM a -> IO a-runFormatM useColor handle (FormatM action) = do+runFormatM :: Bool -> Bool -> Handle -> FormatM a -> IO a+runFormatM useColor produceHTML_ handle (FormatM action) = do   time <- getPOSIXTime   cpuTime <- CPUTime.getCPUTime-  evalStateT action (FormatterState handle useColor 0 0 0 [] cpuTime time)+  evalStateT action (FormatterState handle useColor produceHTML_ False 0 0 0 [] cpuTime time)  -- | Increase the counter for successful examples increaseSuccessCount :: FormatM ()@@ -110,60 +118,96 @@ getTotalCount = gets totalCount  -- | Append to the list of accumulated failure messages.-addFailMessage :: String -> FormatM ()-addFailMessage err = modify $ \s -> s {failMessages = err : failMessages s}+addFailMessage :: Path -> (Either SomeException String) -> FormatM ()+addFailMessage p m = modify $ \s -> s {failMessages = FailureRecord p m : failMessages s}  -- | Get the list of accumulated failure messages.-getFailMessages :: FormatM [String]+getFailMessages :: FormatM [FailureRecord] getFailMessages = reverse `fmap` gets failMessages +data FailureRecord = FailureRecord {+  failureRecordPath     :: Path+, failureRecordMessage  :: Either SomeException String+}+ data Formatter = Formatter {-  formatterName       :: String +  headerFormatter :: FormatM ()+ -- | evaluated before each test group-, exampleGroupStarted :: Int -> String -> FormatM ()+--+-- The given number indicates the position within the parent group.+, exampleGroupStarted :: Int -> [String] -> String -> FormatM ()++, exampleGroupDone    :: FormatM ()+ -- | evaluated after each successful example-, exampleSucceeded    :: Int -> String -> FormatM ()+, exampleSucceeded    :: Path -> FormatM ()+ -- | evaluated after each failed example-, exampleFailed       :: Int -> String -> String -> FormatM ()+, exampleFailed       :: Path -> Either SomeException String -> FormatM ()+ -- | evaluated after each pending example-, examplePending      :: Int -> String -> Maybe String -> FormatM ()+, examplePending      :: Path -> Maybe String -> FormatM ()+ -- | evaluated after a test run , failedFormatter     :: FormatM ()+ -- | evaluated after `failuresFormatter` , footerFormatter     :: FormatM () } ++-- | Append an empty line to the report.+--+-- Calling this multiple times has the same effect as calling it once.+newParagraph :: FormatM ()+newParagraph = do+  f <- gets lastIsEmptyLine+  unless f $ do+    writeLine ""+    setLastIsEmptyLine True++setLastIsEmptyLine :: Bool -> FormatM ()+setLastIsEmptyLine f = modify $ \s -> s {lastIsEmptyLine = f}+ -- | Append some output to the report. write :: String -> FormatM () write s = do   h <- gets stateHandle   liftIO $ IO.hPutStr h s+  setLastIsEmptyLine False  -- | The same as `write`, but adds a newline character. writeLine :: String -> FormatM ()-writeLine s = do-  h <- gets stateHandle-  liftIO $ IO.hPutStrLn h s+writeLine s = write s >> write "\n"  -- | Set output color to red, run given action, and finally restore the default -- color. withFailColor :: FormatM a -> FormatM a-withFailColor = withColor (SetColor Foreground Dull Red)+withFailColor = withColor (SetColor Foreground Dull Red) "hspec-failure"  -- | Set output to color green, run given action, and finally restore the -- default color. withSuccessColor :: FormatM a -> FormatM a-withSuccessColor = withColor (SetColor Foreground Dull Green)+withSuccessColor = withColor (SetColor Foreground Dull Green) "hspec-success"  -- | Set output color to yellow, run given action, and finally restore the -- default color. withPendingColor :: FormatM a -> FormatM a-withPendingColor = withColor (SetColor Foreground Dull Yellow)+withPendingColor = withColor (SetColor Foreground Dull Yellow) "hspec-pending"  -- | Set a color, run an action, and finally reset colors.-withColor :: SGR -> FormatM a -> FormatM a-withColor color (FormatM action) = FormatM . StateT $ \st -> do+withColor :: SGR -> String -> FormatM a -> FormatM a+withColor color cls action = do+  r <- gets produceHTML+  (if r then htmlSpan cls else withColor_ color) action++htmlSpan :: String -> FormatM a -> FormatM a+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 

@@ -1,41 +1,19 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# OPTIONS -fno-warn-orphans #-}---- |--- Importing this module allows you to use an @HUnit@ `HU.Test` as an example--- for a behavior.  You can use an explicit `HU.TestCase` data constructor or--- use an `HU.Assertion`.  For an @Assertion@, any exception means the example--- failed; otherwise, it's successfull.------ NOTE: Any output from the example to @stdout@ is ignored.  If you need to--- write out for debugging, you can write to @stderr@ or a file handle.------ > import Test.Hspec.Monadic--- > import Test.Hspec.HUnit ()--- > import Test.HUnit--- >--- > main :: IO ()--- > main = hspec $ do--- >   describe "reverse" $ do--- >     it "reverses a list" $ do--- >       reverse [1, 2, 3] @?= [3, 2, 1]--- >--- >     it "gives the original list, if applied twice" $ TestCase $--- >       (reverse . reverse) [1, 2, 3] @?= [1, 2, 3]----module Test.Hspec.HUnit () where+module Test.Hspec.HUnit (+-- * Interoperability with HUnit+  fromHUnitTest+) where -import           System.IO.Silently-import           Test.Hspec.Core-import qualified Test.HUnit as HU import           Data.List (intersperse)+import qualified Test.HUnit as HU+import           Test.HUnit (Test (..)) -instance Example HU.Assertion where-  evaluateExample io = evaluateExample (HU.TestCase io)+import           Test.Hspec.Core.Type -instance Example HU.Test where-  evaluateExample test = do-    (counts, fails) <- silence $ HU.runTestText HU.putTextToShowS test+-- | This instance is deprecated, use `Test.Hspec.HUnit.fromHUnitTest` instead!+instance Example Test where+  evaluateExample _ test = do+    (counts, fails) <- HU.runTestText HU.putTextToShowS test     let r = if HU.errors counts + HU.failures counts == 0              then Success              else Fail (details $ fails "")@@ -43,3 +21,19 @@     where       details :: String -> String       details = concat . intersperse "\n" . tail . init . lines++-- |+-- Convert a HUnit test suite to a spec.  This can be used to run existing+-- HUnit tests with Hspec.+fromHUnitTest :: Test -> Spec+fromHUnitTest t = fromSpecList $ case t of+  TestList xs -> map go xs+  x           -> [go x]+  where+    go :: Test -> SpecTree+    go t_ = case t_ of+      TestLabel s (TestCase e)  -> SpecItem  s (`evaluateExample` e)+      TestLabel s (TestList xs) -> SpecGroup s (map go xs)+      TestLabel s x             -> SpecGroup s [go x]+      TestList xs               -> SpecGroup "<unlabeled>" (map go xs)+      TestCase e                -> SpecItem  "<unlabeled>" (`evaluateExample` e)

@@ -1,80 +0,0 @@-module Test.Hspec.Internal (-  Spec (..)-, Specs-, Example (..)-, safeEvaluateExample-, Result (..)--, describe-, it--, quantify-)-where--import           Control.Exception---- | A list of specs.-type Specs = [Spec]---- | The result of running an example.-data Result = Success | Pending (Maybe String) | Fail String-  deriving (Eq, Show)---- | Internal representation of a spec.-data Spec = SpecGroup String [Spec]-          | SpecExample String (IO Result)---- | The @describe@ function combines a list of specs into a larger spec.-describe :: String -> [Spec] -> Spec-describe = SpecGroup--safeEvaluateExample :: IO Result -> IO Result-safeEvaluateExample action = do-  action `catches` [-    -- Re-throw AsyncException, otherwise execution will not terminate on-    -- SIGINT (ctrl-c).  All AsyncExceptions are re-thrown (not just-    -- UserInterrupt) because all of them indicate severe conditions and-    -- should not occur during normal test runs.-    Handler (\e -> throw (e :: AsyncException)),--    Handler (\e -> return $ Fail (show (e :: SomeException)))-    ]----- | Create a set of specifications for a specific type being described.--- Once you know what you want specs for, use this.------ > describe "abs" [--- >   it "returns a positive number given a negative number"--- >     (abs (-1) == 1)--- >   ]----it :: Example a => String -> a -> Spec-it requirement = SpecExample requirement . evaluateExample---- | A type class for examples.-class Example a where-  evaluateExample :: a -> IO Result--instance Example Bool where-  evaluateExample b = if b then return Success else return (Fail "")--instance Example Result where-  evaluateExample r = r `seq` return r---- | Create a more readable display of a quantity of something.------ Examples:------ >>> quantify 0 "example"--- "0 examples"------ >>> quantify 1 "example"--- "1 example"------ >>> quantify 2 "example"--- "2 examples"-quantify :: Int -> String -> String-quantify 1 s = "1 " ++ s-quantify n s = show n ++ " " ++ s ++ "s"

@@ -1,7 +1,5 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# OPTIONS_HADDOCK prune #-}-{-# OPTIONS_GHC -fno-warn-deprecations #-}-module Test.Hspec.Monadic (+{-# OPTIONS_HADDOCK not-home #-}+module Test.Hspec.Monadic {-# DEPRECATED "use \"Test.Hspec\", \"Test.Hspec.Runner\" or \"Test.Hspec.Core\" instead" #-} ( -- * Types   Spec , Example@@ -15,105 +13,42 @@  -- * Running a spec , hspec-, hspecB-, hHspec , Summary (..)  -- * Interface to the non-monadic API , runSpecM , fromSpecList --- deprecated stuff+-- * Deprecated types and functions , Specs , descriptions+, hspecB , hspecX+, hHspec ) where  import           System.IO-import           Test.Hspec.Core (Example)-import qualified Test.Hspec.Core as Core-import qualified Test.Hspec.Runner as Runner-import           Test.Hspec.Runner (Summary (..))-import           Test.Hspec.Pending (Pending)-import qualified Test.Hspec.Pending as Pending--import           Control.Monad.Trans.Writer (Writer, execWriter, tell)+import           Control.Applicative +import           Test.Hspec.Core (runSpecM, fromSpecList)+import           Test.Hspec.Runner+import           Test.Hspec -type Spec = SpecM ()+{-# DEPRECATED Specs "use `Spec` instead" #-}             -- since 1.2.0+type Specs = Spec -newtype SpecM a = SpecM (Writer [Core.Spec] a)-  deriving Monad+{-# DEPRECATED descriptions "use `sequence_` instead" #-} -- since 1.0.0+descriptions :: [Spec] -> Spec+descriptions = sequence_ --- | Create a document of the given spec and write it to stdout.------ Exit the program with `exitSuccess` if all examples passed, with--- `exitFailure` otherwise.-hspec :: Spec -> IO ()-hspec = Runner.hspec . runSpecM+{-# DEPRECATED hspecX "use `hspec` instead" #-}           -- since 1.2.0+hspecX :: Spec -> IO ()+hspecX = hspec --- | Create a document of the given spec and write it to stdout.------ Return `True` if all examples passed, `False` otherwise.+{-# DEPRECATED hspecB "use `hspecWith` instead" #-}       -- since 1.4.0 hspecB :: Spec -> IO Bool-hspecB = Runner.hspecB . runSpecM+hspecB spec = (== 0) . summaryFailures <$> hspecWith defaultConfig spec --- | Create a document of the given specs and write it to the given handle.------ > writeReport filename specs = withFile filename WriteMode (\h -> hHspec h specs)---+{-# DEPRECATED hHspec "use hspecWith instead" #-}         -- since 1.4.0 hHspec :: Handle -> Spec -> IO Summary-hHspec h = Runner.hHspec h . runSpecM---- | Convert a monadic spec into a non-monadic spec.-runSpecM :: Spec -> [Core.Spec]-runSpecM (SpecM specs) = execWriter specs---- | Convert a non-monadic spec into a monadic spec.-fromSpecList :: [Core.Spec] -> Spec-fromSpecList = SpecM . tell---- | The @describe@ function combines a list of specs into a larger spec.-describe :: String -> Spec -> Spec-describe label action = SpecM . tell $ [Core.describe label (runSpecM action)]---- | An alias for `describe`.-context :: String -> Spec -> Spec-context = describe---- |--- Create a set of specifications for a specific type being described.  Once--- you know what you want specs for, use this.------ > describe "abs" $ do--- >   it "returns a positive number given a negative number" $--- >     abs (-1) == 1-it :: Example v => String -> v -> Spec-it label action = (SpecM . tell) [Core.it label action]---- | A pending example.------ If you want to report on a behavior but don't have an example yet, use this.------ > describe "fancyFormatter" $ do--- >   it "can format text in a way that everyone likes" $--- >     pending------ You can give an optional reason for why it's pending.------ > describe "fancyFormatter" $ do--- >   it "can format text in a way that everyone likes" $--- >     pending "waiting for clarification from the designers"-pending :: String  -> Pending-pending = Pending.pending--{-# DEPRECATED Specs "use Spec instead" #-}-type Specs = SpecM ()--{-# DEPRECATED descriptions "use sequence_ instead" #-}-descriptions :: [Spec] -> Spec-descriptions = sequence_--{-# DEPRECATED hspecX "use hspec instead" #-}-hspecX :: Spec -> IO a-hspecX = Runner.hspecX . runSpecM+hHspec h = hspecWith defaultConfig {configHandle = h}

@@ -1,8 +1,8 @@ {-# LANGUAGE FlexibleInstances #-} module Test.Hspec.Pending where -import qualified Test.Hspec.Internal as Internal-import           Test.Hspec.Internal (Example(..))+import qualified Test.Hspec.Core.Type as Core+import           Test.Hspec.Core.Type (Example(..))  -- NOTE: This is defined in a separate packages, because it clashes with -- Result.Pending.@@ -11,25 +11,24 @@ newtype Pending = Pending (Maybe String)  instance Example Pending where-  evaluateExample (Pending reason) = evaluateExample (Internal.Pending reason)+  evaluateExample c (Pending reason) = evaluateExample c (Core.Pending reason)  instance Example (String -> Pending) where-  evaluateExample _ = evaluateExample (Pending Nothing)+  evaluateExample c _ = evaluateExample c (Pending Nothing)  -- | A pending example. ----- If you want to report on a behavior but don't have an example yet, use this.+-- If you want to textually specify a behavior but do not have an example yet,+-- use this: ----- > describe "fancyFormatter" [+-- > describe "fancyFormatter" $ do -- >   it "can format text in a way that everyone likes" $ -- >     pending--- > ] ----- You can give an optional reason for why it's pending.+-- You can give an optional reason for why it's pending: ----- > describe "fancyFormatter" [+-- > describe "fancyFormatter" $ do -- >   it "can format text in a way that everyone likes" $ -- >     pending "waiting for clarification from the designers"--- > ] pending :: String -> Pending pending = Pending . Just

@@ -1,44 +1,27 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} -- |--- Importing this module allows you to use a QuickCheck `QC.Property` as an--- example for a behavior.  Use `QC.property` to turn any `QC.Testable` into a--- @Property@.------ NOTE: Any output from the example to @stdout@ is ignored.  If you need to--- write out for debugging, you can write to @stderr@ or a file handle.------ > import Test.Hspec.Monadic--- > import Test.Hspec.QuickCheck--- >--- > main :: IO ()--- > main = hspec $ do--- >   describe "reverse" $ do--- >     it "gives the original list, if applied twice" $ property $--- >       \xs -> (reverse . reverse) xs == (xs :: [Int])---+-- Stability: provisional module Test.Hspec.QuickCheck (-  QC.property+-- * Re-exports from QuickCheck+-- |+-- Previous versions of Hspec provided a distinct `property` combinator, but+-- it's now possible to use QuickCheck's `property` instead.  For backward+-- compatibility we now re-export QuickCheck's `property`, but it is advisable+-- to import it from "Test.QuickCheck" instead.+  property+-- * Shortcuts , prop ) where -import           System.IO.Silently-import           Test.Hspec.Core-import qualified Test.QuickCheck as QC---- just for the prop shortcut-import qualified Test.Hspec.Monadic as DSL---- | Monadic DSL shortcut, use this instead of `DSL.it`.-prop :: QC.Testable t => String -> t -> DSL.Spec-prop n p = DSL.it n (QC.property p)+import           Test.QuickCheck+import           Test.Hspec -instance Example QC.Property where-  evaluateExample p = do-    r <- silence $ QC.quickCheckResult p-    return $-      case r of-        QC.Success {}               -> Success-        f@(QC.Failure {})           -> Fail (QC.output f)-        QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ quantify n "test" )-        QC.NoExpectedFailure {}     -> Fail ("No expected failure")+-- |+-- > prop ".." $+-- >   ..+--+-- is a shortcut for+--+-- > it ".." $ property $+-- >   ..+prop :: Testable prop => String -> prop -> Spec+prop s = it s . property

@@ -1,106 +1,131 @@--- | This module contains the runners that take a set of specs, evaluate their examples, and--- report to a given handle.---+-- |+-- Stability: provisional module Test.Hspec.Runner (-  Specs-, hspec-, hspecB-, hHspec-, hHspecWithFormat-, toExitCode+-- * Running a spec+  hspec+, hspecWith +-- * Types , Summary (..)---- * Deprecated functions-, hspecX+, Config (..)+, ColorMode (..)+, Path+, defaultConfig+, configAddFilter ) where -import           Control.Monad (unless, (>=>))+import           Control.Monad import           Control.Applicative import           Data.Monoid+import           Data.Maybe+import           System.IO+import           System.Environment+import           System.Exit+import           System.IO.Silently (silence) -import           Test.Hspec.Internal+import           Test.Hspec.Util (Path, safeEvaluate)+import           Test.Hspec.Core.Type+import           Test.Hspec.Config import           Test.Hspec.Formatters import           Test.Hspec.Formatters.Internal-import           System.IO-import           System.Exit+import           Test.Hspec.FailureReport --- | Evaluate and print the result of checking the spec examples.-runFormatter :: Formatter -> Spec -> FormatM ()-runFormatter formatter = go 0 []+-- | Filter specs by given predicate.+--+-- The predicate takes a list of "describe" labels and a "requirement".+filterSpecs :: (Path -> Bool) -> [SpecTree] -> [SpecTree]+filterSpecs p = goSpecs []   where-    go :: Int -> [String] -> Spec -> FormatM ()-    go nesting groups (SpecGroup group xs) = do-      exampleGroupStarted formatter nesting group-      mapM_ (go (succ nesting) (group : groups)) xs-    go nesting groups (SpecExample requirement e) = do-      result <- liftIO $ safeEvaluateExample e+    goSpecs :: [String] -> [SpecTree] -> [SpecTree]+    goSpecs groups = catMaybes . map (goSpec groups)++    goSpec :: [String] -> SpecTree -> Maybe SpecTree+    goSpec groups spec = case spec of+      SpecItem requirement _ -> guard (p (groups, requirement)) >> return spec+      SpecGroup group specs     -> case goSpecs (groups ++ [group]) specs of+        [] -> Nothing+        xs -> Just (SpecGroup group xs)++-- | 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)+  where+    silence_+      | configVerbose c = id+      | otherwise       = silence++    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)+      exampleGroupDone formatter+    go rGroups (_, SpecItem requirement example) = do+      result <- (liftIO . safeEvaluate . silence_) (example $ configParams c)       case result of-        Success -> do+        Right Success -> do           increaseSuccessCount-          exampleSucceeded formatter nesting requirement-        Fail err -> do-          increaseFailCount-          exampleFailed  formatter nesting requirement err-          n <- getFailCount-          addFailMessage $ failureDetails groups requirement err n-        Pending reason -> do+          exampleSucceeded formatter path+        Right (Pending reason) -> do           increasePendingCount-          examplePending formatter nesting requirement reason+          examplePending formatter path reason -failureDetails :: [String] -> String -> String -> Int -> String-failureDetails groups requirement err i =-  show i ++ ") " ++ groups_ ++ requirement ++ " FAILED" ++ err_-  where-    err_-      | null err  = ""-      | otherwise = "\n" ++ err-    groups_ = case groups of-      [x] -> x ++ " "-      _   -> concatMap (++ " - ") (reverse groups)+        Right (Fail err) -> failed (Right err)+        Left e           -> failed (Left  e)+      where+        path = (groups, requirement)+        groups = reverse rGroups+        failed err = do+          increaseFailCount+          addFailMessage path err+          exampleFailed  formatter path err  --- | Create a document of the given specs and write it to stdout.+-- | Run given spec and write a report to `stdout`.+-- Exit with `exitFailure` if at least one spec item fails. ----- Exit the program with `exitSuccess` if all examples passed, with--- `exitFailure` otherwise.-hspec :: Specs -> IO ()-hspec = hspecB >=> (`unless` exitFailure)--{-# DEPRECATED hspecX "use hspec instead" #-}-hspecX :: Specs -> IO a-hspecX = hspecB >=> exitWith . toExitCode+-- (see also `hspecWith`)+hspec :: Spec -> IO ()+hspec spec = do+  c <- getConfig+  withArgs [] {- do not leak command-line arguments to examples -} $ do+    r <- hspecWith c spec+    unless (summaryFailures r == 0) exitFailure --- | Create a document of the given specs and write it to stdout.+-- | Run given spec with custom options.+-- This is similar to `hspec`, but more flexible. ----- Return `True` if all examples passed, `False` otherwise.-hspecB :: Specs -> IO Bool-hspecB = fmap success . hHspec stdout-  where-    success :: Summary -> Bool-    success s = summaryFailures s == 0+-- /Note/: `hspecWith` does not exit with `exitFailure` on failing spec items.+-- If you need this, you have to check the `Summary` yourself and act+-- accordingly.+hspecWith :: Config -> Spec -> IO Summary+hspecWith c_ spec = do+  -- read failure report on --re-run+  c <- if configReRun c_+    then do+      readFailureReport c_+    else do+      return c_ --- | Create a document of the given specs and write it to the given handle.------ > writeReport filename specs = withFile filename WriteMode (\h -> hHspec h specs)----hHspec :: Handle -> Specs -> IO Summary-hHspec h specs = do-  useColor <- hIsTerminalDevice h-  hHspecWithFormat specdoc useColor h specs+  let formatter = configFormatter c+      h = configHandle c --- | Create a document of the given specs and write it to the given handle.--- THIS IS LIKELY TO CHANGE-hHspecWithFormat :: Formatter -> Bool -> Handle -> Specs -> IO Summary-hHspecWithFormat formatter useColor h ss = runFormatM useColor h $ do-  mapM_ (runFormatter formatter) ss-  failedFormatter formatter-  footerFormatter formatter-  Summary <$> getTotalCount <*> getFailCount+  useColor <- doesUseColor h c+  runFormatM useColor (configHtmlOutput c) h $ do+    runFormatter c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec)+    failedFormatter formatter+    footerFormatter formatter -toExitCode :: Bool -> ExitCode-toExitCode True  = ExitSuccess-toExitCode False = ExitFailure 1+    -- dump failure report+    xs <- map failureRecordPath <$> getFailMessages+    liftIO $ writeFailureReport (show xs)++    Summary <$> getTotalCount <*> getFailCount+  where+    doesUseColor :: Handle -> Config -> IO Bool+    doesUseColor h c = case configColorMode c of+      ColorAuto  -> hIsTerminalDevice h+      ColorNever -> return False+      ColorAlway -> return True  -- | Summary of a test run. data Summary = Summary {

@@ -0,0 +1,80 @@+module Test.Hspec.Util (+  quantify+, safeEvaluate+, Path+, filterPredicate+, formatRequirement+, readMaybe+, getEnv+) where++import           Data.List+import           Data.Maybe+import           Data.Char (isSpace)+import           Control.Applicative+import qualified Control.Exception as E+import qualified System.Environment as Environment++-- | Create a more readable display of a quantity of something.+--+-- Examples:+--+-- >>> quantify 0 "example"+-- "0 examples"+--+-- >>> quantify 1 "example"+-- "1 example"+--+-- >>> quantify 2 "example"+-- "2 examples"+quantify :: Int -> String -> String+quantify 1 s = "1 " ++ s+quantify n s = show n ++ " " ++ s ++ "s"++safeEvaluate :: IO a -> IO (Either E.SomeException a)+safeEvaluate action = (Right <$> action) `E.catches` [+  -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT+  -- (ctrl-c).  All AsyncExceptions are re-thrown (not just UserInterrupt)+  -- because all of them indicate severe conditions and should not occur during+  -- normal operation.+    E.Handler $ \e -> E.throw (e :: E.AsyncException)++  , E.Handler $ \e -> (return . Left) (e :: E.SomeException)+  ]++-- |+-- A tuple that represents the location of an example within a spec.+--+-- It consists of a list of group descriptions and a requirement description.+type Path = ([String], String)++-- | A predicate that can be used to filter specs.+filterPredicate :: String -> Path -> Bool+filterPredicate pattern path@(groups, requirement) =+     pattern `isInfixOf` plain+  || pattern `isInfixOf` formatted+  where+    plain = intercalate "/" (groups ++ [requirement])+    formatted = formatRequirement path++-- |+-- Try to create a proper English sentence from a path by applying some+-- heuristics.+formatRequirement :: Path -> String+formatRequirement (groups, requirement) = groups_ ++ requirement+  where+    groups_ = case break (any isSpace) groups of+      ([], ys) -> join ys+      (xs, ys) -> join (intercalate "." xs : ys)++    join xs = case xs of+      [x] -> x ++ " "+      ys  -> concatMap (++ ", ") ys++-- NOTE: base-4.6.0.0 provides a function with that name and type.  For+-- compatibility with earlier versions, we define our own version here.+readMaybe :: Read a => String -> Maybe a+readMaybe = fmap fst . listToMaybe . reads++getEnv :: String -> IO (Maybe String)+getEnv key = either (const Nothing) Just <$> safeEvaluate (Environment.getEnv key)

@@ -3,4 +3,4 @@ import           Test.DocTest  main :: IO ()-main = doctest ["--optghc=-isrc", "src/Test/Hspec/Internal.hs"]+main = doctest ["-isrc", "src/Test/Hspec/Util.hs"]