hspec 1.5.4 → 1.6.0

raw patch · 32 files changed

+841/−446 lines, 32 filesdep ~basedep ~transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, transformers

API changes (from Hackage documentation)

Files

• LICENSE +18/−7
• hspec-discover/integration-test/with-formatter-empty/Spec.hs +1/−0
• hspec-discover/integration-test/with-formatter/Spec.hs +1/−0
• hspec-discover/integration-test/with-io-formatter/Spec.hs +1/−0
• hspec-discover/src/Config.hs +33/−0
• hspec-discover/src/Run.hs +34/−19
• hspec-discover/test/ConfigSpec.hs +37/−0
• hspec-discover/test/RunSpec.hs +16/−1
• hspec.cabal +53/−5
• src/Test/Hspec.hs +11/−1
• src/Test/Hspec/Config.hs +51/−127
• src/Test/Hspec/Core/Type.hs +4/−4
• src/Test/Hspec/FailureReport.hs +13/−18
• src/Test/Hspec/Formatters.hs +19/−0
• src/Test/Hspec/Formatters/Internal.hs +5/−14
• src/Test/Hspec/HUnit.hs +2/−2
• src/Test/Hspec/Options.hs +136/−0
• src/Test/Hspec/Runner.hs +45/−78
• src/Test/Hspec/Runner/Eval.hs +124/−0
• test/Helper.hs +58/−0
• test/SpecHelper.hs +0/−37
• test/Test/Hspec/CompatSpec.hs +1/−1
• test/Test/Hspec/Core/TypeSpec.hs +3/−6
• test/Test/Hspec/FailureReportSpec.hs +2/−3
• test/Test/Hspec/FormattersSpec.hs +5/−7
• test/Test/Hspec/HUnitSpec.hs +6/−11
• test/Test/Hspec/OptionsSpec.hs +26/−0
• test/Test/Hspec/QuickCheckSpec.hs +2/−3
• test/Test/Hspec/RunnerSpec.hs +110/−82
• test/Test/Hspec/TimerSpec.hs +1/−2
• test/Test/Hspec/UtilSpec.hs +3/−5
• test/Test/HspecSpec.hs +20/−13

@@ -1,10 +1,21 @@--Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:-+Copyright (c) 2011-2013 Simon Hengel <sol@typeful.net>+Copyright (c) 2011-2012 Trystan Spangler <trystan.s@comcast.net>+Copyright (c) 2011-2011 Greg Weber <greg@gregweber.info> -Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.-Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.-The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.+Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions: -THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --formatter=Test.Hspec.Formatters.progress #-}

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --formatter=Test.Hspec.Formatters.progress #-}

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --formatter=Formatter.count #-}

@@ -0,0 +1,33 @@+module Config (+  Config (..)+, defaultConfig+, parseConfig+, usage+) where++import           System.Console.GetOpt++data Config = Config {+  configNested :: Bool+, configFormatter :: Maybe String+} deriving (Eq, Show)++defaultConfig :: Config+defaultConfig = Config False Nothing++options :: [OptDescr (Config -> Config)]+options = [+    Option [] ["nested"]    (NoArg  $ \c -> c   {configNested = True}) ""+  , Option [] ["formatter"] (ReqArg (\s c -> c {configFormatter = Just s}) "FORMATTER") ""+  ]++usage :: String -> String+usage prog = "\nUsage: " ++ prog ++ " SRC CUR DST [--nested] [--formatter=FORMATTER]\n"++parseConfig :: String -> [String] -> Either String Config+parseConfig prog args = case getOpt Permute options args of+    (opts, [], []) -> Right (foldl (flip id) defaultConfig opts)+    (_, _, err:_)  -> formatError err+    (_, arg:_, _)  -> formatError ("unexpected argument `" ++ arg ++ "'\n")+  where+    formatError err = Left (prog ++ ": " ++ err ++ usage prog)

@@ -14,39 +14,54 @@ import           System.Directory import           System.FilePath hiding (combine) +import           Config+ instance IsString ShowS where   fromString = showString  run :: [String] -> IO ()-run args_ = case args_ of-  src : _ : dst : args -> do-    nested <- case args of-      []           -> return False-      ["--nested"] -> return True-      _            -> exit-    specs <- findSpecs src-    writeFile dst (mkSpecModule src nested specs)-  _ -> exit-  where-    exit = do-      name <- getProgName-      hPutStrLn stderr ("usage: " ++ name ++ " SRC CUR DST [--nested]")+run args_ = do+  name <- getProgName+  case args_ of+    src : _ : dst : args -> case parseConfig name args of+      Left err -> do+        hPutStrLn stderr err+        exitFailure+      Right c -> do+        specs <- findSpecs src+        writeFile dst (mkSpecModule src c specs)+    _ -> do+      hPutStrLn stderr (usage name)       exitFailure -mkSpecModule :: FilePath -> Bool -> [SpecNode] -> String-mkSpecModule src nested nodes =+mkSpecModule :: FilePath -> Config -> [SpecNode] -> String+mkSpecModule src c nodes =   ( "{-# LINE 1 " . shows src . " #-}"   . showString "module Main where\n"-  . showString "import Test.Hspec\n"   . importList nodes-  . showString "main :: IO ()\n"-  . showString "main = hspec $ "+  . maybe driver (driverWithFormatter (null nodes)) (configFormatter c)   . format nodes   ) "\n"   where     format-      | nested    = formatSpecsNested+      | configNested c = formatSpecsNested       | otherwise = formatSpecs++    driver =+        showString "import Test.Hspec\n"+      . showString "main :: IO ()\n"+      . showString "main = hspec $ "++driverWithFormatter :: Bool -> String -> ShowS+driverWithFormatter isEmpty f =+    (if isEmpty then id else "import Test.Hspec\n")+  . showString "import Test.Hspec.Runner\n"+  . showString "import qualified " . showString (moduleName f) . showString "\n"+  . showString "main :: IO ()\n"+  . showString "main = hspecWithFormatter " . showString f . showString " $ "++moduleName :: String -> String+moduleName = reverse . dropWhile (== '.') . dropWhile (/= '.') . reverse  -- | Generate imports for a list of specs. importList :: [SpecNode] -> ShowS

@@ -0,0 +1,37 @@+module ConfigSpec (main, spec) where++import           Test.Hspec.Meta++import           Config++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "parseConfig" $ do+    let parse = parseConfig "hspec-discover"++    it "recognizes --nested" $ do+      parse ["--nested"] `shouldBe` Right (defaultConfig {configNested = True})++    it "recognizes --formatter" $ do+      parse ["--formatter", "someFormatter"] `shouldBe` Right (defaultConfig {configFormatter = Just "someFormatter"})++    it "returns error message on unrecognized option" $ do+      parse ["--foo"] `shouldBe` (Left . unlines) [+          "hspec-discover: unrecognized option `--foo'"+        , ""+        , "Usage: hspec-discover SRC CUR DST [--nested] [--formatter=FORMATTER]"+        ]++    it "returns error message on unexpected argument" $ do+      parse ["foo"]   `shouldBe` (Left . unlines) [+          "hspec-discover: unexpected argument `foo'"+        , ""+        , "Usage: hspec-discover SRC CUR DST [--nested] [--formatter=FORMATTER]"+        ]++    context "when option is given multiple times" $ do+      it "the last occurrence takes precedence" $ do+        parse ["--formatter", "foo", "--formatter", "bar"] `shouldBe` Right (defaultConfig {configFormatter = Just "bar"})

@@ -1,8 +1,9 @@-{-# LANGUAGE OverloadedStrings #-} module RunSpec (main, spec) where  import           Test.Hspec.Meta +import           Data.List (intercalate)+ import           Run  main :: IO ()@@ -41,6 +42,20 @@     context "when there are no specs" $ do       it "returns an empty list" $ do         findSpecs "hspec-discover/test-data/empty-dir/Spec.hs" `shouldReturn` []++  describe "driverWithFormatter" $ do+    it "generates a test driver that uses a custom formatter" $ do+      driverWithFormatter False "Some.Module.formatter" "" `shouldBe` intercalate "\n" [+          "import Test.Hspec"+        , "import Test.Hspec.Runner"+        , "import qualified Some.Module"+        , "main :: IO ()"+        , "main = hspecWithFormatter Some.Module.formatter $ "+        ]++  describe "moduleName" $ do+    it "returns the module name of an fully qualified identifier" $ do+      moduleName "Some.Module.someId" `shouldBe` "Some.Module"    describe "formatSpec" $ do     it "generates code for a spec" $

@@ -1,6 +1,6 @@ name:             hspec-version:          1.5.4-license:          BSD3+version:          1.6.0+license:          MIT license-file:     LICENSE copyright:        (c) 2011-2013 Simon Hengel,                   (c) 2011-2012 Trystan Spangler,@@ -11,7 +11,7 @@ category:         Testing stability:        experimental bug-reports:      https://github.com/hspec/hspec/issues-homepage:         http://hspec.github.com/+homepage:         http://hspec.github.io/ synopsis:         Behavior-Driven Development for Haskell description:      Behavior-Driven Development for Haskell                   .@@ -20,7 +20,7 @@                   tests. Compared to other options, it provides a much nicer                   syntax that makes tests very easy to read.                   .-                  The Hspec Manual is at <http://hspec.github.com/>.+                  The Hspec Manual is at <http://hspec.github.io/>.  -- find hspec-discover/test-data/ -type f extra-source-files:@@ -76,7 +76,9 @@       Test.Hspec.Compat       Test.Hspec.Core.Type       Test.Hspec.Config+      Test.Hspec.Options       Test.Hspec.FailureReport+      Test.Hspec.Runner.Eval       Test.Hspec.Formatters.Internal       Test.Hspec.Timer @@ -89,13 +91,14 @@       Spec.hs   other-modules:       Mock-      SpecHelper+      Helper       Test.HspecSpec       Test.Hspec.CompatSpec       Test.Hspec.Core.TypeSpec       Test.Hspec.FailureReportSpec       Test.Hspec.FormattersSpec       Test.Hspec.HUnitSpec+      Test.Hspec.OptionsSpec       Test.Hspec.QuickCheckSpec       Test.Hspec.RunnerSpec       Test.Hspec.TimerSpec@@ -157,6 +160,7 @@       Main.hs   other-modules:       Run+      Config   build-depends:       base    == 4.*     , filepath@@ -174,6 +178,7 @@       Spec.hs   other-modules:       RunSpec+      ConfigSpec   build-depends:       base    == 4.*     , filepath@@ -203,6 +208,49 @@       -Wall -Werror   hs-source-dirs:       hspec-discover/integration-test/empty+  main-is:+      Spec.hs+  build-depends:+      base    == 4.*+    , hspec++test-suite hspec-discover-integration-test-with-formatter+  buildable: False+  type:+      exitcode-stdio-1.0+  ghc-options:+      -Wall -Werror+  hs-source-dirs:+      hspec-discover/integration-test/with-formatter+  main-is:+      Spec.hs+  build-depends:+      base    == 4.*+    , hspec++test-suite hspec-discover-integration-test-with-io-formatter+  buildable: False+  type:+      exitcode-stdio-1.0+  ghc-options:+      -Wall -Werror+  hs-source-dirs:+      hspec-discover/integration-test/with-io-formatter+  main-is:+      Spec.hs+  build-depends:+      base    == 4.*+    , hspec+    , transformers++test-suite hspec-discover-integration-test-with-formatter-empty+  buildable: False+  type:+      exitcode-stdio-1.0+  ghc-options:+      -Wall -Werror+  hs-source-dirs:+      hspec-discover/integration-test/with-formatter-empty   main-is:       Spec.hs   build-depends:

@@ -32,6 +32,7 @@ , example , pending , pendingWith+, parallel  -- * Running a spec , hspec@@ -124,7 +125,7 @@ -- > describe "absolute" $ do -- >   it "returns a positive number when given a negative number" $ -- >     absolute (-1) == 1-it :: Example v => String -> v -> Spec+it :: Example a => String -> a -> Spec it label action = fromSpecList [Core.it label action]  -- | This is a type restricted version of `id`.  It can be used to get better@@ -141,3 +142,12 @@ -- >   putStrLn example :: Expectation -> Expectation example = id++-- | Run examples of given spec in parallel.+parallel :: Spec -> Spec+parallel = fromSpecList . map go . runSpecM+  where+    go :: SpecTree -> SpecTree+    go spec = case spec of+      SpecItem _ r e -> SpecItem True r e+      SpecGroup d es -> SpecGroup d (map go es)

@@ -1,21 +1,15 @@ module Test.Hspec.Config (   Config (..)-, ColorMode (..) , defaultConfig , getConfig , configAddFilter , configSetSeed---- exported to silence warnings-, Arg (..) ) where -import           Control.Monad (unless) import           Control.Applicative+import           Data.List import           System.IO import           System.Exit-import           System.Environment-import           System.Console.GetOpt import qualified Test.QuickCheck as QC import           Test.Hspec.Formatters @@ -24,11 +18,12 @@ -- for Monad (Either e) when base < 4.3 import           Control.Monad.Trans.Error () +import           Test.Hspec.Options+import           Test.Hspec.FailureReport+ data Config = Config {-  configVerbose         :: Bool-, configDryRun          :: Bool+  configDryRun          :: Bool , configPrintCpuTime    :: Bool-, configReRun           :: Bool , configFastFail        :: Bool  -- |@@ -42,140 +37,69 @@ , configHandle          :: Handle } -{-# DEPRECATED configVerbose "this has no effect anymore and will be removed with a future release" #-} -- deprecated since 1.5.0--data ColorMode = ColorAuto | ColorNever | ColorAlway- defaultConfig :: Config-defaultConfig = Config False False False False False Nothing QC.stdArgs ColorAuto specdoc False stdout--formatters :: [(String, Formatter)]-formatters = [-    ("specdoc", specdoc)-  , ("progress", progress)-  , ("failed-examples", failed_examples)-  , ("silent", silent)-  ]--formatHelp :: String-formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters)--type Result = Either NoConfig Config--data NoConfig = Help | InvalidArgument String String+defaultConfig = Config False False False Nothing QC.stdArgs ColorAuto specdoc False stdout  -- | 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+configAddFilter p1 c = c {+    configFilterPredicate = Just p1 `filterOr` configFilterPredicate c+  } -setMaxSuccess :: Int -> Config -> Config-setMaxSuccess n c = c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.maxSuccess = n}}+filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool)+filterOr p1_ p2_ = case (p1_, p2_) of+  (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path+  _ -> p1_ <|> p2_  configSetSeed :: Integer -> Config -> Config configSetSeed n c = c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.replay = Just (stdGenFromInteger n, 0)}} --data Arg a = Arg {-  argumentName   :: String-, argumentParser :: String -> Maybe a-, argumentSetter :: a -> Config -> Config-}--mkOption :: [Char] -> [Char] -> Arg a -> String -> OptDescr (Result -> Result)-mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help-  where-    arg :: String -> Result -> Result-    arg input x = x >>= \c -> case parser input of-      Just n -> Right (setter n c)-      Nothing -> Left (InvalidArgument name input)--addLineBreaks :: String -> [String]-addLineBreaks = lineBreaksAt 44--options :: [OptDescr (Result -> Result)]-options = [-    Option   []  ["help"]             (NoArg (const $ Left Help))         (h "display this help and exit")-  , mkOption "m"  "match"             (Arg "PATTERN" return setFilter)    (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'")-  , mkOption "f"  "format"            (Arg "FORMATTER" readFormatter setFormatter) formatHelp-  , mkOption "a"  "qc-max-success"    (Arg "N" readMaybe setMaxSuccess)   (h "maximum number of successful tests before a QuickCheck property succeeds")-  , mkOption []   "seed"              (Arg "N" readMaybe configSetSeed)   (h "used seed for QuickCheck properties")-  , 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   []  ["fail-fast"]        (NoArg setFastFail)                 (h "abort on first failure")-  ]+mkConfig :: Maybe FailureReport -> Options -> Config+mkConfig mFailureReport opts = Config {+    configDryRun          = optionsDryRun opts+  , configPrintCpuTime    = optionsPrintCpuTime opts+  , configFastFail        = optionsFastFail opts+  , configFilterPredicate = matchFilter `filterOr` rerunFilter+  , configQuickCheckArgs  = qcArgs+  , configColorMode       = optionsColorMode opts+  , configFormatter       = optionsFormatter opts+  , configHtmlOutput      = optionsHtmlOutput opts+  , configHandle          = stdout+  }   where-    h = unlines . addLineBreaks--    setFilter :: String -> Config -> Config-    setFilter = configAddFilter . filterPredicate--    readFormatter :: String -> Maybe Formatter-    readFormatter = (`lookup` formatters)--    setFormatter :: Formatter -> Config -> Config-    setFormatter f c = c {configFormatter = f}--    setPrintCpuTime x = x >>= \c -> return c {configPrintCpuTime = True}-    setDryRun       x = x >>= \c -> return c {configDryRun       = True}-    setFastFail     x = x >>= \c -> return c {configFastFail     = True}--    setColor mValue x = x >>= \c -> parseColor mValue >>= \v -> return c {configColorMode = v}+    qcArgs = maybe id setSeed mSeed args       where-        parseColor s = case s of-          Nothing       -> return ColorAlway-          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"--    -- for compatibility with test-framework-  , mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default"+        args = maybe id setMaxSuccess mMaxSuccess QC.stdArgs -    -- 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"+    mSeed = optionsSeed opts <|> (failureReportSeed <$> mFailureReport)+    mMaxSuccess = optionsMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport) -    -- now a noop-  , Option "v" ["verbose"]                 (NoArg id)                         "do not suppress output to stdout when evaluating examples"-  ]-  where-    setReRun :: Result -> Result-    setReRun x = x >>= \c -> return c {configReRun = True}+    setMaxSuccess :: Int -> QC.Args -> QC.Args+    setMaxSuccess n args = args {QC.maxSuccess = n} -    setHtml :: Result -> Result-    setHtml x = x >>= \c -> return c {configHtmlOutput = True}+    setSeed :: Integer -> QC.Args -> QC.Args+    setSeed n args = args {QC.replay = Just (stdGenFromInteger n, 0)} -getConfig :: IO Config-getConfig = do-  (opts, args, errors) <- getOpt Permute (options ++ undocumentedOptions) <$> getArgs+    matchFilter = case optionsMatch opts of+      [] -> Nothing+      xs -> Just $ foldl1' (\p0 p1 path -> p0 path || p1 path) (map filterPredicate xs) -  unless (null errors)-    (tryHelp $ head errors)+    rerunFilter = flip elem . failureReportPaths <$> mFailureReport -  unless (null args)-    (tryHelp $ "unexpected argument `" ++ head args ++ "'\n")+getConfig :: Options -> String -> [String] -> IO Config+getConfig opts_ prog args = do+  case parseOptions opts_ prog args of+    Left (err, msg) -> exitWithMessage err msg+    Right opts -> do+      r <- if optionsRerun opts then readFailureReport else return Nothing+      return (mkConfig r opts) -  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+exitWithMessage :: ExitCode -> String -> IO a+exitWithMessage err msg = do+  hPutStr h msg+  exitWith err   where-    tryHelp message = do-      name <- getProgName-      hPutStr stderr $ name ++ ": " ++ message ++ "Try `" ++ name ++ " --help' for more information.\n"-      exitFailure+    h = case err of+      ExitSuccess -> stdout+      _           -> stderr

@@ -58,7 +58,7 @@  forceResult :: Result -> Result forceResult r = case r of-  Success   -> r `seq` r+  Success   -> r   Pending m -> r `seq` m `deepseq` r   Fail    m -> r `seq` m `deepseq` r @@ -74,7 +74,7 @@ -- | Internal representation of a spec. data SpecTree =     SpecGroup String [SpecTree]-  | SpecItem  String (Params -> IO Result)+  | SpecItem Bool String (Params -> IO Result)  -- | The @describe@ function combines a list of specs into a larger spec. describe :: String -> [SpecTree] -> SpecTree@@ -86,7 +86,7 @@  -- | Create a spec item. it :: Example a => String -> a -> SpecTree-it s e = SpecItem msg (`evaluateExample` e)+it s e = SpecItem False msg (`evaluateExample` e)   where     msg       | null s = "(unspecified behavior)"@@ -106,7 +106,7 @@     ]  instance Example Result where-  evaluateExample _ r = return r+  evaluateExample _ = return  instance Example QC.Property where   evaluateExample c p = do

@@ -1,17 +1,20 @@ module Test.Hspec.FailureReport (-  writeFailureReport+  FailureReport (..)+, writeFailureReport , readFailureReport ) where  import           System.IO import           System.SetEnv-import qualified Test.QuickCheck as QC-import           Test.Hspec.Config import           Test.Hspec.Util (Path, safeTry, readMaybe, getEnv) -type Seed = Integer+data FailureReport = FailureReport {+  failureReportSeed :: Integer+, failureReportMaxSuccess :: Int+, failureReportPaths :: [Path]+} deriving (Eq, Show, Read) -writeFailureReport :: (Seed, [Path]) -> IO ()+writeFailureReport :: FailureReport -> IO () writeFailureReport x = do   -- on Windows this can throw an exception when the input is too large, hence   -- we use `safeTry` here@@ -20,19 +23,11 @@     onError err = do       hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")") -readFailureReport :: Config -> IO Config-readFailureReport c = do+readFailureReport :: IO (Maybe FailureReport)+readFailureReport = 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 (seed, xs) -> do-      (return . setSeed seed . configAddFilter (`elem` xs)) c--setSeed :: Seed -> Config -> Config-setSeed seed c-  | hasSeed = c-  | otherwise = configSetSeed seed c-  where-    hasSeed = maybe False (const True) (QC.replay $ configQuickCheckArgs c)+      hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!"+      return Nothing+    x -> return x

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleInstances #-} -- | -- Stability: experimental --@@ -46,6 +47,16 @@  -- ** Helpers , formatException++-- * Using custom formatters with @hspec-discover@+-- |+-- Anything that is an instance of `IsFormatter` can be used by+-- @hspec-discover@ as the default formatter for a spec.  If you have a+-- formatter @myFormatter@ in the module @Custom.Formatters@ you can use it+-- by passing an additional argument to @hspec-discover@.+--+-- >{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --formatter=Custom.Formatters.myFormatter #-}+, IsFormatter (..) ) where  import           Data.Maybe@@ -87,6 +98,14 @@   , withFailColor   ) +class IsFormatter a where+  toFormatter :: a -> IO Formatter++instance IsFormatter (IO Formatter) where+  toFormatter = id++instance IsFormatter Formatter where+  toFormatter = return  silent :: Formatter silent = Formatter {

@@ -27,7 +27,6 @@  -- * Functions for internal use , runFormatM-, liftIO , increaseSuccessCount , increasePendingCount , increaseFailCount@@ -42,7 +41,7 @@ import           Control.Exception (SomeException, AsyncException(..), bracket_, try, throwIO) import           System.Console.ANSI import           Control.Monad.Trans.State hiding (gets, modify)-import qualified Control.Monad.IO.Class as IOClass+import           Control.Monad.IO.Class import qualified System.CPUTime as CPUTime import           Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) @@ -53,20 +52,12 @@ -- | A lifted version of `Control.Monad.Trans.State.gets` gets :: (FormatterState -> a) -> FormatM a gets f = FormatM $ do-  f <$> (get >>= IOClass.liftIO . readIORef)+  f <$> (get >>= liftIO . readIORef)  -- | A lifted version of `Control.Monad.Trans.State.modify` modify :: (FormatterState -> FormatterState) -> FormatM () modify f = FormatM $ do-  get >>= IOClass.liftIO . (`modifyIORef'` f)---- | A lifted version of `IOClass.liftIO`------ This is meant for internal use only, and not part of the public API.  This--- is also the reason why we do not make FormatM an instance MonadIO, so we--- have narrow control over the visibilty of this function.-liftIO :: IO a -> FormatM a-liftIO action = FormatM (IOClass.liftIO action)+  get >>= liftIO . (`modifyIORef'` f)  data FormatterState = FormatterState {   stateHandle     :: Handle@@ -93,7 +84,7 @@ -- 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)+  deriving (Functor, Applicative, Monad, MonadIO)  runFormatM :: Bool -> Bool -> Bool -> Integer -> Handle -> FormatM a -> IO a runFormatM useColor produceHTML_ printCpuTime seed handle (FormatM action) = do@@ -131,7 +122,7 @@ getTotalCount = gets totalCount  -- | Append to the list of accumulated failure messages.-addFailMessage :: Path -> (Either SomeException String) -> FormatM ()+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.

@@ -4,7 +4,7 @@   fromHUnitTest ) where -import           Data.List (intersperse)+import           Data.List (intercalate) import qualified Test.HUnit as HU import           Test.HUnit (Test (..)) @@ -20,7 +20,7 @@     return r     where       details :: String -> String-      details = concat . intersperse "\n" . tail . init . lines+      details = intercalate "\n" . tail . init . lines  -- | -- Convert a HUnit test suite to a spec.  This can be used to run existing

@@ -0,0 +1,136 @@+module Test.Hspec.Options (+  Options (..)+, ColorMode (..)+, defaultOptions+, parseOptions++-- exported to silence warnings+, Arg (..)+) where++import           Data.List+import           System.Exit+import           System.Console.GetOpt+import           Test.Hspec.Formatters++import           Test.Hspec.Util++-- for Monad (Either e) when base < 4.3+import           Control.Monad.Trans.Error ()++data Options = Options {+  optionsDryRun       :: Bool+, optionsPrintCpuTime :: Bool+, optionsRerun        :: Bool+, optionsFastFail     :: Bool+, optionsMatch        :: [String]+, optionsMaxSuccess   :: Maybe Int+, optionsSeed         :: Maybe Integer+, optionsColorMode    :: ColorMode+, optionsFormatter    :: Formatter+, optionsHtmlOutput   :: Bool+}++addMatch :: String -> Options -> Options+addMatch s c = c {optionsMatch = s : optionsMatch c}++setMaxSuccess :: Int -> Options -> Options+setMaxSuccess n c = c {optionsMaxSuccess = Just n}++setSeed :: Integer -> Options -> Options+setSeed n c = c {optionsSeed = Just n}++data ColorMode = ColorAuto | ColorNever | ColorAlways+  deriving (Eq, Show)++defaultOptions :: Options+defaultOptions = Options False False False False [] Nothing Nothing ColorAuto specdoc False++formatters :: [(String, Formatter)]+formatters = [+    ("specdoc", specdoc)+  , ("progress", progress)+  , ("failed-examples", failed_examples)+  , ("silent", silent)+  ]++formatHelp :: String+formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters)++type Result = Either NoConfig Options++data NoConfig = Help | InvalidArgument String String++data Arg a = Arg {+  argumentName   :: String+, argumentParser :: String -> Maybe a+, argumentSetter :: a -> Options -> Options+}++mkOption :: [Char] -> String -> Arg a -> String -> OptDescr (Result -> Result)+mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help+  where+    arg :: String -> Result -> Result+    arg input x = x >>= \c -> case parser input of+      Just n -> Right (setter n c)+      Nothing -> Left (InvalidArgument name input)++addLineBreaks :: String -> [String]+addLineBreaks = lineBreaksAt 44++options :: [OptDescr (Result -> Result)]+options = [+    Option   []  ["help"]             (NoArg (const $ Left Help))         (h "display this help and exit")+  , mkOption "m"  "match"             (Arg "PATTERN" return addMatch)     (h "only run examples that match given PATTERN")+  , Option   []  ["color"]            (NoArg setColor)                    (h "colorize the output")+  , Option   []  ["no-color"]         (NoArg setNoColor)                  (h "do not colorize the output")+  , mkOption "f"  "format"            (Arg "FORMATTER" readFormatter setFormatter) formatHelp+  , mkOption "a"  "qc-max-success"    (Arg "N" readMaybe setMaxSuccess)   (h "maximum number of successful tests before a QuickCheck property succeeds")+  , mkOption []   "seed"              (Arg "N" readMaybe setSeed)         (h "used seed for QuickCheck properties")+  , 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   []  ["fail-fast"]        (NoArg setFastFail)                 (h "abort on first failure")+  , Option   "r" ["rerun"]            (NoArg  setRerun)                   (h "only rerun examples that previously failed")+  ]+  where+    h = unlines . addLineBreaks++    readFormatter :: String -> Maybe Formatter+    readFormatter = (`lookup` formatters)++    setFormatter :: Formatter -> Options -> Options+    setFormatter f c = c {optionsFormatter = f}++    setPrintCpuTime x = x >>= \c -> return c {optionsPrintCpuTime = True}+    setDryRun       x = x >>= \c -> return c {optionsDryRun       = True}+    setFastFail     x = x >>= \c -> return c {optionsFastFail     = True}+    setRerun        x = x >>= \c -> return c {optionsRerun = True}+    setNoColor      x = x >>= \c -> return c {optionsColorMode = ColorNever}+    setColor        x = x >>= \c -> return c {optionsColorMode = ColorAlways}++undocumentedOptions :: [OptDescr (Result -> Result)]+undocumentedOptions = [+    -- for compatibility with test-framework+    mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default"++    -- 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"++    -- now a noop+  , Option "v" ["verbose"]                 (NoArg id)                         "do not suppress output to stdout when evaluating examples"+  ]+  where+    setHtml :: Result -> Result+    setHtml x = x >>= \c -> return c {optionsHtmlOutput = True}++parseOptions :: Options -> String -> [String] -> Either (ExitCode, String) Options+parseOptions c prog args = case getOpt Permute (options ++ undocumentedOptions) args of+    (opts, [], []) -> case foldl' (flip id) (Right c) opts of+        Left Help                         -> Left (ExitSuccess, usageInfo ("Usage: " ++ prog ++ " [OPTION]...\n\nOPTIONS") options)+        Left (InvalidArgument flag value) -> tryHelp ("invalid argument `" ++ value ++ "' for `--" ++ flag ++ "'\n")+        Right x -> Right x+    (_, _, err:_)  -> tryHelp err+    (_, arg:_, _)  -> tryHelp ("unexpected argument `" ++ arg ++ "'\n")+  where+    tryHelp msg = Left (ExitFailure 1, prog ++ ": " ++ msg ++ "Try `" ++ prog ++ " --help' for more information.\n")

@@ -3,6 +3,7 @@ module Test.Hspec.Runner ( -- * Running a spec   hspec+, hspecResult , hspecWith  -- * Types@@ -12,6 +13,9 @@ , Path , defaultConfig , configAddFilter++-- * Internals+, hspecWithFormatter ) where  import           Control.Monad@@ -26,6 +30,7 @@ import           System.Console.ANSI (hHideCursor, hShowCursor) import qualified Test.QuickCheck as QC import           System.Random (newStdGen)+import           Control.Monad.IO.Class (liftIO)  import           Test.Hspec.Util import           Test.Hspec.Core.Type@@ -33,8 +38,10 @@ import           Test.Hspec.Formatters import           Test.Hspec.Formatters.Internal import           Test.Hspec.FailureReport-import           Test.Hspec.Timer +import           Test.Hspec.Options (Options(..), ColorMode(..), defaultOptions)+import           Test.Hspec.Runner.Eval+ -- | Filter specs by given predicate. -- -- The predicate takes a list of "describe" labels and a "requirement".@@ -42,89 +49,29 @@ filterSpecs p = goSpecs []   where     goSpecs :: [String] -> [SpecTree] -> [SpecTree]-    goSpecs groups = catMaybes . map (goSpec groups)+    goSpecs groups = mapMaybe (goSpec groups)      goSpec :: [String] -> SpecTree -> Maybe SpecTree     goSpec groups spec = case spec of-      SpecItem requirement _ -> guard (p (groups, requirement)) >> return spec+      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 :: Bool -> Config -> Formatter -> [SpecTree] -> FormatM ()-runFormatter useColor 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--    eval :: IO Result -> FormatM (Either E.SomeException Result)-    eval-      | configDryRun c = \_ -> return (Right Success)-      | otherwise      = liftIO . safeTry . fmap forceResult--    go :: [String] -> (Int, SpecTree) -> FormatM ()-    go rGroups (n, SpecGroup group xs) = do-      exampleGroupStarted formatter n (reverse rGroups) group-      zip [0..] xs `each` go (group : rGroups)-      exampleGroupDone formatter-    go rGroups (_, SpecItem requirement example) = do-      progressHandler <- mkProgressHandler-      result <- eval (example $ Params (configQuickCheckArgs c) progressHandler)-      case result of-        Right Success -> do-          increaseSuccessCount-          exampleSucceeded formatter path-        Right (Pending reason) -> do-          increasePendingCount-          examplePending formatter path reason--        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--        mkProgressHandler-          | useColor = do-              timer <- liftIO $ newTimer 0.05-              return $ \p -> do-                f <- timer-                when f $ do-                  exampleProgress formatter (configHandle c) path p-          | otherwise = return . const $ return ()- -- | Run given spec and write a report to `stdout`. -- Exit with `exitFailure` if at least one spec item fails.------ (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+hspec = hspecWithOptions defaultOptions -handleReRun :: Config -> IO Config-handleReRun c = do-  if configReRun c-    then do-      readFailureReport c-    else do-      return c+-- | This function is used by @hspec-discover@.  It is not part of the public+-- API and may change at any time.+hspecWithFormatter :: IsFormatter a => a -> Spec -> IO ()+hspecWithFormatter formatter spec = do+  f <- toFormatter formatter+  hspecWithOptions defaultOptions {optionsFormatter = f} spec  -- Add a StdGen to configQuickCheckArgs if there is none.  That way the same--- seed is used for all properties.  This helps with --seed and --re-run.+-- seed is used for all properties.  This helps with --seed and --rerun. ensureStdGen :: Config -> IO Config ensureStdGen c = case QC.replay qcArgs of   Nothing -> do@@ -136,15 +83,31 @@  -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible.+hspecWithOptions :: Options -> Spec -> IO ()+hspecWithOptions opts spec = do+  prog <- getProgName+  args <- getArgs+  c <- getConfig opts prog args+  withArgs [] {- do not leak command-line arguments to examples -} $ do+    r <- hspecWith c spec+    unless (summaryFailures r == 0) exitFailure++-- | Run given spec and returns a summary of the test run. ----- /Note/: `hspecWith` does not exit with `exitFailure` on failing spec items.--- If you need this, you have to check the `Summary` yourself and act+-- /Note/: `hspecResult` does not exit with `exitFailure` on failing spec+-- items.  If you need this, you have to check the `Summary` yourself and act -- accordingly.+hspecResult :: Spec -> IO Summary+hspecResult = hspecWith defaultConfig++-- | Run given spec with custom options and returns a summary of the test run.+--+-- /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 <- handleReRun c_ >>= ensureStdGen-+  c <- ensureStdGen c_   let formatter = configFormatter c       h = configHandle c       seed = (stdGenToInteger . fst . fromJust . QC.replay . configQuickCheckArgs) c@@ -160,7 +123,11 @@        -- dump failure report       xs <- map failureRecordPath <$> getFailMessages-      liftIO $ writeFailureReport (seed, xs)+      liftIO $ writeFailureReport FailureReport {+          failureReportSeed = seed+        , failureReportMaxSuccess = QC.maxSuccess (configQuickCheckArgs c)+        , failureReportPaths = xs+        }        Summary <$> getTotalCount <*> getFailCount   where@@ -173,7 +140,7 @@     doesUseColor h c = case configColorMode c of       ColorAuto  -> hIsTerminalDevice h       ColorNever -> return False-      ColorAlway -> return True+      ColorAlways -> return True  -- | Summary of a test run. data Summary = Summary {

@@ -0,0 +1,124 @@+module Test.Hspec.Runner.Eval (runFormatter) where++import           Control.Monad+import qualified Control.Exception as E+import           Control.Concurrent++import           Control.Monad.IO.Class (liftIO)++import           Test.Hspec.Util+import           Test.Hspec.Core.Type+import           Test.Hspec.Config+import           Test.Hspec.Formatters+import           Test.Hspec.Formatters.Internal+import           Test.Hspec.Timer+import           Data.Time.Clock.POSIX++-- | Evaluate all examples of a given spec and produce a report.+runFormatter :: Bool -> Config -> Formatter -> [SpecTree] -> FormatM ()+runFormatter useColor c formatter specs = do+  headerFormatter formatter+  chan <- liftIO newChan+  run chan useColor c formatter specs++data Message = Done | Run (FormatM ())++data Report = ReportProgress Progress | ReportResult (Either E.SomeException Result)++run :: Chan Message -> Bool -> Config -> Formatter -> [SpecTree] -> FormatM ()+run chan useColor c formatter specs = do+  liftIO $ do+    forM_ (zip [0..] specs) (queueSpec [])+    writeChan chan Done+  processChan chan (configFastFail c)+  where+    defer = writeChan chan . Run++    queueSpec :: [String] -> (Int, SpecTree) -> IO ()+    queueSpec rGroups (n, SpecGroup group xs) = do+      defer (exampleGroupStarted formatter n (reverse rGroups) group)+      forM_ (zip [0..] xs) (queueSpec (group : rGroups))+      defer (exampleGroupDone formatter)+    queueSpec rGroups (_, SpecItem isParallelizable requirement e) =+      queueExample isParallelizable (reverse rGroups, requirement) e++    queueExample :: Bool -> Path -> (Params -> IO Result) -> IO ()+    queueExample isParallelizable path e+      | isParallelizable = runParallel+      | otherwise = defer runSequentially+      where+        runSequentially :: FormatM ()+        runSequentially = do+          progressHandler <- liftIO (mkProgressHandler reportProgress)+          result <- liftIO (evalExample e progressHandler)+          formatResult formatter path result++        runParallel = do+          mvar <- newEmptyMVar+          _ <- forkIO $ do+            progressHandler <- mkProgressHandler (replaceMVar mvar . ReportProgress)+            result <- evalExample e progressHandler+            replaceMVar mvar (ReportResult result)+          defer (evalReport mvar)+          where+            evalReport :: MVar Report -> FormatM ()+            evalReport mvar = do+              r <- liftIO (takeMVar mvar)+              case r of+                ReportProgress p -> do+                  liftIO $ reportProgress p+                  evalReport mvar+                ReportResult result -> formatResult formatter path result++        reportProgress :: (Int, Int) -> IO ()+        reportProgress = exampleProgress formatter (configHandle c) path++    mkProgressHandler :: (a -> IO ()) -> IO (a -> IO ())+    mkProgressHandler report+      | useColor = every 0.05 report+      | otherwise = return . const $ return ()++    evalExample :: (Params -> IO Result) -> (Progress -> IO ()) -> IO (Either E.SomeException Result)+    evalExample e progressHandler+      | configDryRun c = return (Right Success)+      | otherwise      = (safeTry . fmap forceResult) (e $ Params (configQuickCheckArgs c) progressHandler)++replaceMVar :: MVar a -> a -> IO ()+replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p++processChan :: Chan Message -> Bool -> FormatM ()+processChan chan fastFail = go+  where+    go = do+      m <- liftIO (readChan chan)+      case m of+        Run action -> do+          action+          fails <- getFailCount+          unless (fastFail && fails /= 0) go+        Done -> return ()++formatResult :: Formatter -> ([String], String) -> Either E.SomeException Result -> FormatM ()+formatResult formatter path result = do+  case result of+    Right Success -> do+      increaseSuccessCount+      exampleSucceeded formatter path+    Right (Pending reason) -> do+      increasePendingCount+      examplePending formatter path reason+    Right (Fail err) -> failed (Right err)+    Left e           -> failed (Left  e)+  where+    failed err = do+      increaseFailCount+      addFailMessage path err+      exampleFailed  formatter path err++-- | Execute given action at most every specified number of seconds.+every :: POSIXTime -> (a -> IO ()) -> IO (a -> IO ())+every seconds action = do+  timer <- newTimer seconds+  return $ \a -> do+    r <- timer+    when r (action a)

@@ -0,0 +1,58 @@+module Helper (+  module Test.Hspec.Meta+, module Test.QuickCheck+, module Control.Applicative+, module System.IO.Silently+, sleep+, timeout+, defaultParams+, captureLines+, normalizeSummary++, shouldStartWith+, shouldEndWith+, shouldContain+) where++import           Control.Applicative+import           Test.Hspec.Meta+import           Test.QuickCheck hiding (Result(..))++import qualified Test.Hspec.Core as H+import qualified Test.Hspec.Runner as H+import           Data.List+import           Data.Char+import           System.IO.Silently+import           Data.Time.Clock.POSIX+import           Control.Concurrent+import qualified System.Timeout as System++captureLines :: IO a -> IO [String]+captureLines = fmap lines . capture_++shouldContain :: (Eq a, Show a) => [a] -> [a] -> Expectation+x `shouldContain` y = x `shouldSatisfy` isInfixOf y++shouldStartWith :: (Eq a, Show a) => [a] -> [a] -> Expectation+x `shouldStartWith` y = x `shouldSatisfy` isPrefixOf y++shouldEndWith :: (Eq a, Show a) => [a] -> [a] -> Expectation+x `shouldEndWith` y = x `shouldSatisfy` isSuffixOf y++-- replace times in summary with zeroes+normalizeSummary :: [String] -> [String]+normalizeSummary xs = map f xs+  where+    f x | "Finished in " `isPrefixOf` x = map g x+        | otherwise = x+    g x | isNumber x = '0'+        | otherwise  = x++defaultParams :: H.Params+defaultParams = H.Params (H.configQuickCheckArgs H.defaultConfig) (const $ return ())++sleep :: POSIXTime -> IO ()+sleep = threadDelay . floor . (* 1000000)++timeout :: POSIXTime -> IO a -> IO (Maybe a)+timeout = System.timeout . floor . (* 1000000)

@@ -1,37 +0,0 @@-module SpecHelper where--import qualified Test.Hspec.Core as H-import qualified Test.Hspec.Runner as H-import           Data.List-import           Data.Char-import           Test.Hspec.Meta-import           System.IO.Silently-import           Data.Time.Clock.POSIX-import           Control.Concurrent--captureLines :: IO a -> IO [String]-captureLines = fmap lines . capture_--shouldContain :: (Eq a, Show a) => [a] -> [a] -> Expectation-x `shouldContain` y = x `shouldSatisfy` isInfixOf y--shouldStartWith :: (Eq a, Show a) => [a] -> [a] -> Expectation-x `shouldStartWith` y = x `shouldSatisfy` isPrefixOf y--shouldEndWith :: (Eq a, Show a) => [a] -> [a] -> Expectation-x `shouldEndWith` y = x `shouldSatisfy` isSuffixOf y---- replace times in summary with zeroes-normalizeSummary :: [String] -> [String]-normalizeSummary xs = map f xs-  where-    f x | "Finished in " `isPrefixOf` x = map g x-        | otherwise = x-    g x | isNumber x = '0'-        | otherwise  = x--defaultParams :: H.Params-defaultParams = H.Params (H.configQuickCheckArgs H.defaultConfig) (const $ return ())--sleep :: POSIXTime -> IO ()-sleep t = threadDelay (floor $ t * 1000000)

@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} module Test.Hspec.CompatSpec (main, spec) where -import           Test.Hspec.Meta+import           Helper  import           Test.Hspec.Compat import           Data.Typeable

@@ -1,13 +1,10 @@ module Test.Hspec.Core.TypeSpec (main, spec) where -import           Test.Hspec.Meta-import           SpecHelper-import           Test.QuickCheck+import           Helper import           Mock import           Data.List-import           System.IO.Silently- import           Control.Exception (AsyncException(..), throwIO)+ import qualified Test.Hspec.Core.Type as H hiding (describe, it) import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H@@ -103,7 +100,7 @@         mockCounter e `shouldReturn` 100        it "can be used with expecatations/HUnit assertions" $ do-        silence . H.hspecWith H.defaultConfig $ do+        silence . H.hspecResult $ do           H.describe "readIO" $ do             H.it "is inverse to show" $ property $ \x -> do               (readIO . show) x `shouldReturn` (x :: Int)

@@ -1,9 +1,8 @@ module Test.Hspec.FailureReportSpec (main, spec) where -import           Test.Hspec.Meta+import           Helper  import           System.IO-import           System.IO.Silently import           Test.Hspec.FailureReport import           GHC.Paths (ghc) import           System.Process@@ -20,7 +19,7 @@       r `shouldBe` "WARNING: Could not write environment variable HSPEC_FAILURES (some error)\n"    -- GHCi needs to keep the environment on :reload, so that we can store-  -- failures there.  Otherwise --re-run would not be very useful.  So we add a+  -- failures there.  Otherwise --rerun would not be very useful.  So we add a   -- test for that.   describe "GHCi" $ do     it "keeps environment variables on :reload" $ do

@@ -1,10 +1,8 @@ {-# LANGUAGE CPP #-} module Test.Hspec.FormattersSpec (main, spec) where -import           Test.Hspec.Meta+import           Helper -import           SpecHelper-import           System.IO.Silently (capture) import qualified Test.Hspec as H import qualified Test.Hspec.Core as H (Result(..)) import qualified Test.Hspec.Runner as H@@ -198,22 +196,22 @@   -- colorized output, hence the following tests do not work on Windows. #ifndef mingw32_HOST_OS   it "shows summary in green if there are no failures" $ do-    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlway} $ do+    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do       H.it "foobar" True     r `shouldSatisfy` any (== (green ++ "1 example, 0 failures" ++ reset))    it "shows summary in yellow if there are pending examples" $ do-    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlway} $ do+    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do       H.it "foobar" H.pending     r `shouldSatisfy` any (== (yellow ++ "1 example, 0 failures, 1 pending" ++ reset))    it "shows summary in red if there are failures" $ do-    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlway} $ do+    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do       H.it "foobar" False     r `shouldSatisfy` any (== (red ++ "1 example, 1 failure" ++ reset))    it "shows summary in red if there are both failures and pending examples" $ do-    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlway} $ do+    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do       H.it "foo" False       H.it "bar" H.pending     r `shouldSatisfy` any (== (red ++ "2 examples, 1 failure, 1 pending" ++ reset))

@@ -1,9 +1,6 @@ module Test.Hspec.HUnitSpec (main, spec) where -import           Test.Hspec.Meta-import           SpecHelper (captureLines)-import           Control.Applicative-import           System.IO.Silently+import           Helper  import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H@@ -27,7 +24,7 @@         go :: SpecTree -> Tree         go x = case x of           SpecGroup s xs  -> Group s (map go xs)-          SpecItem  s _   -> Example s+          SpecItem _ s _  -> Example s  spec :: Spec spec = do@@ -55,30 +52,28 @@    describe "HUnit TestCase as an example (deprecated!)" $ do     it "is specified with the HUnit `TestCase` data constructor" $ TestCase $ do-      silence . runSpec $ do+      silence . H.hspecResult $ do         H.it "some behavior" (TestCase $ "foo" @?= "bar")         H.it "some behavior" (TestCase $ "foo" @?= "foo")       `shouldReturn` H.Summary 2 1      it "is the assumed example for IO() actions" $ do-      silence . runSpec $ do+      silence . H.hspecResult $ do         H.it "some behavior" ("foo" @?= "bar")         H.it "some behavior" ("foo" @?= "foo")       `shouldReturn` H.Summary 2 1      it "will show the failed assertion text if available (e.g. assertBool)" $ do       let assertionText = "some assertion text"-      r <- captureLines . runSpec $ do+      r <- captureLines . H.hspecResult $ do         H.describe "foo" $ do           H.it "bar" (assertFailure assertionText)       r `shouldSatisfy` any (== assertionText)      it "will show the failed assertion expected and actual values if available (e.g. assertEqual)" $ do-      r <- captureLines . runSpec $ do+      r <- captureLines . H.hspecResult $ do         H.describe "foo" $ do           H.it "bar" (assertEqual "trivial" (1::Int) 2)       assertBool "should find assertion text" $ any (=="trivial") r       assertBool "should find 'expected: 1'"  $ any (=="expected: 1") r       assertBool "should find ' but got: 2'"  $ any (==" but got: 2") r-  where-    runSpec = H.hspecWith H.defaultConfig

@@ -0,0 +1,26 @@+module Test.Hspec.OptionsSpec (main, spec) where++import           Helper++import           Test.Hspec.Options hiding (parseOptions)+import qualified Test.Hspec.Options as Options++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "parseOptions" $ do++    let parseOptions = Options.parseOptions defaultOptions "my-spec"++    it "sets optionsColorMode to ColorAuto" $ do+      optionsColorMode <$> parseOptions [] `shouldBe` Right ColorAuto++    context "with --no-color" $ do+      it "sets optionsColorMode to ColorNever" $ do+        optionsColorMode <$> parseOptions ["--no-color"] `shouldBe` Right ColorNever++    context "with --color" $ do+      it "sets optionsColorMode to ColorAlways" $ do+        optionsColorMode <$> parseOptions ["--color"] `shouldBe` Right ColorAlways

@@ -1,7 +1,6 @@ module Test.Hspec.QuickCheckSpec (main, spec) where -import           Test.Hspec.Meta-import           System.IO.Silently+import           Helper  import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H@@ -14,7 +13,7 @@ spec = do   describe "prop" $ do     it "is a shortcut to use properties as examples" $ do-      silence . H.hspecWith H.defaultConfig $ do+      silence . H.hspecResult $ do         H.describe "read" $ do           H.prop "is inverse to show" $ \x -> (read . show) x == (x :: Int)       `shouldReturn` H.Summary 1 0

@@ -1,22 +1,18 @@ module Test.Hspec.RunnerSpec (main, spec) where -import           Test.Hspec.Meta-import           System.IO.Silently+import           Helper import           System.IO (stderr)-import           Control.Applicative-import           Control.Monad (unless)+import           Control.Monad import           System.Environment (withArgs, withProgName, getArgs) import           System.Exit import qualified Control.Exception as E-import           SpecHelper import           Mock import           System.SetEnv import           Test.Hspec.Util (getEnv)-import           Test.QuickCheck +import qualified Test.Hspec as H import qualified Test.Hspec.Runner as H import qualified Test.Hspec.Core as H (Result(..))-import qualified Test.Hspec as H (describe, it, pending) import qualified Test.Hspec.Formatters as H (silent)  ignoreExitCode :: IO () -> IO ()@@ -56,6 +52,83 @@           , "Try `myspec --help' for more information."           ] +    it "stores a failure report in the environment" $ do+      silence . ignoreExitCode . withArgs ["--seed", "23"] . H.hspec $ do+        H.describe "foo" $ do+          H.describe "bar" $ do+            H.it "example 1" True+            H.it "example 2" False+        H.describe "baz" $ do+          H.it "example 3" False+      getEnv "HSPEC_FAILURES" `shouldReturn` Just ("FailureReport {"+        ++ "failureReportSeed = 23, "+        ++ "failureReportMaxSuccess = 100, "+        ++ "failureReportPaths = [([\"foo\",\"bar\"],\"example 2\"),([\"baz\"],\"example 3\")]}")++    describe "with --rerun" $ do+      let runSpec = (captureLines . ignoreExitCode . H.hspec) $ do+            H.it "example 1" True+            H.it "example 2" False+            H.it "example 3" False+            H.it "example 4" True+            H.it "example 5" False++      it "reruns examples that previously failed" $ do+        r0 <- runSpec+        r0 `shouldSatisfy` elem "5 examples, 3 failures"++        r1 <- withArgs ["--rerun"] runSpec+        r1 `shouldSatisfy` elem "3 examples, 3 failures"++      it "reuses the same seed" $ do+        let runSpec_ = (captureLines . ignoreExitCode . H.hspec) $ do+              H.it "foo" $ property $ (/= (26 :: Integer))++        r0 <- withArgs ["--seed", "2413421499272008081"] runSpec_+        r0 `shouldContain` [+            "Falsifiable (after 66 tests): "+          , "26"+          ]++        r1 <- withArgs ["-r"] runSpec_+        r1 `shouldContain` [+            "Falsifiable (after 66 tests): "+          , "26"+          ]++      it "reuses same --qc-max-success" $ do+        silence . ignoreExitCode . withArgs ["--qc-max-success", "23"] . H.hspec $ do+          H.it "foo" False++        m <- newMock+        silence . withArgs ["--rerun"] . H.hspec $ do+          H.it "foo" $ property $ do+            mockAction m+        mockCounter m `shouldReturn` 23++      context "when there is no failure report in the environment" $ do+        it "runs everything" $ do+          unsetEnv "HSPEC_FAILURES"+          r <- hSilence [stderr] $ withArgs ["-r"] runSpec+          r `shouldSatisfy` elem "5 examples, 3 failures"++        it "prints a warning to stderr" $ do+          unsetEnv "HSPEC_FAILURES"+          r <- hCapture_ [stderr] $ withArgs ["-r"] runSpec+          r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n"++      context "when parsing of failure report fails" $ do+        it "runs everything" $ do+          setEnv "HSPEC_FAILURES" "some invalid report"+          r <- hSilence [stderr] $ withArgs ["-r"] runSpec+          r `shouldSatisfy` elem "5 examples, 3 failures"++        it "prints a warning to stderr" $ do+          setEnv "HSPEC_FAILURES" "some invalid report"+          r <- hCapture [stderr] $ withArgs ["-r"] runSpec+          fst r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n"++     it "does not leak command-line flags to examples" $ do       silence . withArgs ["--verbose"] $ do         H.hspec $ do@@ -198,17 +271,28 @@             H.it "foo" True           r `shouldContain` "invalid argument `foo' for `--format'" -    context "with --maximum-generated-tests=n" $ do-      it "tries QuickCheck properties n times" $ do+    context "with --qc-max-success" $ do+      it "tries QuickCheck properties specified number of times" $ do         m <- newMock-        silence . withArgs ["--qc-max-succes", "23"] . H.hspec $ do+        silence . withArgs ["--qc-max-success", "23"] . H.hspec $ do           H.it "foo" $ property $ do             mockAction m         mockCounter m `shouldReturn` 23 +      context "when run with --rerun" $ do+        it "takes precedence" $ do+          silence . ignoreExitCode . withArgs ["--qc-max-success", "23"] . H.hspec $ do+            H.it "foo" False++          m <- newMock+          silence . withArgs ["--rerun", "--qc-max-success", "42"] . H.hspec $ do+            H.it "foo" $ property $ do+              mockAction m+          mockCounter m `shouldReturn` 42+       context "when given an invalid argument" $ do         it "prints an error message to stderr" $ do-          r <- hCapture_ [stderr] . ignoreExitCode . withArgs ["--qc-max-succes", "foo"] . H.hspec $ do+          r <- hCapture_ [stderr] . ignoreExitCode . withArgs ["--qc-max-success", "foo"] . H.hspec $ do             H.it "foo" True           r `shouldContain` "invalid argument `foo' for `--qc-max-success'" @@ -222,7 +306,7 @@           , "26"           ] -      context "when run with --re-run" $ do+      context "when run with --rerun" $ do         it "takes precedence" $ do           let runSpec args = capture_ . ignoreExitCode . withArgs args . H.hspec $ do                 H.it "foo" $@@ -233,7 +317,7 @@           r1 <- runSpec ["--seed", "42"]           r1 `shouldContain` "(after 48 tests)" -          r2 <- runSpec ["--re-run", "--seed", "23"]+          r2 <- runSpec ["--rerun", "--seed", "23"]           r2 `shouldContain` "(after 88 tests)"        context "when given an invalid argument" $ do@@ -272,73 +356,9 @@           H.it "foo" False         r `shouldContain` "<span class=\"hspec-failure\">- foo" -  describe "hspec (experimental features)" $ do-    it "stores a failure report in environment" $ do-      silence . ignoreExitCode . withArgs ["--seed", "23"] . H.hspec $ do-        H.describe "foo" $ do-          H.describe "bar" $ do-            H.it "example 1" True-            H.it "example 2" False-        H.describe "baz" $ do-          H.it "example 3" False-      getEnv "HSPEC_FAILURES" `shouldReturn` Just "(23,[([\"foo\",\"bar\"],\"example 2\"),([\"baz\"],\"example 3\")])"--    describe "with --re-run" $ do-      let runSpec = (captureLines . ignoreExitCode . H.hspec) $ do-            H.it "example 1" True-            H.it "example 2" False-            H.it "example 3" False-            H.it "example 4" True-            H.it "example 5" False--      it "re-runs examples that previously failed" $ do-        r0 <- runSpec-        r0 `shouldSatisfy` elem "5 examples, 3 failures"--        r1 <- withArgs ["-r"] runSpec-        r1 `shouldSatisfy` elem "3 examples, 3 failures"--      it "reuses the same seed" $ do-        let runSpec_ = (captureLines . ignoreExitCode . H.hspec) $ do-              H.it "foo" $ property $ (/= (26 :: Integer))--        r0 <- withArgs ["--seed", "2413421499272008081"] runSpec_-        r0 `shouldContain` [-            "Falsifiable (after 66 tests): "-          , "26"-          ]--        r1 <- withArgs ["-r"] runSpec_-        r1 `shouldContain` [-            "Falsifiable (after 66 tests): "-          , "26"-          ]--      context "when there is no failure report in the environment" $ do-        it "runs everything" $ do-          unsetEnv "HSPEC_FAILURES"-          r <- hSilence [stderr] $ withArgs ["-r"] runSpec-          r `shouldSatisfy` elem "5 examples, 3 failures"--        it "prints a warning to stderr" $ do-          unsetEnv "HSPEC_FAILURES"-          r <- hCapture_ [stderr] $ withArgs ["-r"] runSpec-          r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--re-run' is ignored!\n"--      context "when parsing of failure report fails" $ do-        it "runs everything" $ do-          setEnv "HSPEC_FAILURES" "some invalid report"-          r <- hSilence [stderr] $ withArgs ["-r"] runSpec-          r `shouldSatisfy` elem "5 examples, 3 failures"--        it "prints a warning to stderr" $ do-          setEnv "HSPEC_FAILURES" "some invalid report"-          r <- hCapture [stderr] $ withArgs ["-r"] runSpec-          fst r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--re-run' is ignored!\n"--  describe "hspecWith" $ do+  describe "hspecResult" $ do     it "returns a summary of the test run" $ do-      silence . H.hspecWith H.defaultConfig $ do+      silence . H.hspecResult $ do         H.it "foo" True         H.it "foo" False         H.it "foo" False@@ -347,12 +367,12 @@       `shouldReturn` H.Summary 5 2      it "treats uncaught exceptions as failure" $ do-      silence . H.hspecWith H.defaultConfig  $ do+      silence . H.hspecResult  $ do         H.it "foobar" (E.throwIO (E.ErrorCall "foobar") >> pure ())       `shouldReturn` H.Summary 1 1      it "uses the specdoc formatter by default" $ do-      _:r:_ <- captureLines . H.hspecWith H.defaultConfig $ do+      _:r:_ <- captureLines . H.hspecResult $ do         H.describe "Foo.Bar" $ do           H.it "some example" True       r `shouldBe` "Foo.Bar"@@ -364,6 +384,14 @@       r `shouldBe` ""      it "does not let escape error thunks from failure messages" $ do-      r <- silence . H.hspecWith H.defaultConfig $ do+      r <- silence . H.hspecResult $ do         H.it "some example" (H.Fail $ "foobar" ++ undefined)       r `shouldBe` H.Summary 1 1++    it "runs specs in parallel" $ do+      let n = 10+          t = 0.01+          dt = t * (fromIntegral n / 2)+      r <- timeout dt . silence . H.hspecResult . H.parallel $ do+        replicateM_ n (H.it "foo" $ sleep t)+      r `shouldBe` Just (H.Summary n 0)

@@ -1,7 +1,6 @@ module Test.Hspec.TimerSpec (main, spec) where -import           Test.Hspec.Meta-import           SpecHelper+import           Helper  import           Test.Hspec.Timer 

@@ -1,15 +1,13 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.UtilSpec (main, spec) where -import           Test.Hspec.Meta-import           Test.QuickCheck+import           Helper import           Data.Int (Int32) import           System.Random (StdGen)- import qualified Control.Exception as E-import           Test.Hspec.Util- import           System.SetEnv++import           Test.Hspec.Util  main :: IO () main = hspec spec

@@ -1,16 +1,11 @@ module Test.HspecSpec (main, spec) where -import           Test.Hspec.Meta-import           SpecHelper+import           Helper import           Data.List (isPrefixOf) -import           Control.Applicative- import           Test.Hspec.Core (SpecTree(..), Result(..), runSpecM) import qualified Test.Hspec as H-import qualified Test.Hspec.Runner as H (hspecWith)-import           Test.Hspec.Runner (defaultConfig)-+import qualified Test.Hspec.Runner as H (hspecResult) main :: IO () main = hspec spec @@ -22,7 +17,7 @@         H.it "foo" H.pending       r `shouldSatisfy` any (== "     # PENDING: No reason given") -  describe "pending" $ do+  describe "pendingWith" $ do     it "specifies a pending example with a reason for why it's pending" $ do       r <- runSpec $ do         H.it "foo" $ do@@ -44,7 +39,7 @@       length r `shouldBe` 3      it "can be nested" $ do-      let [SpecGroup foo [SpecGroup bar [SpecItem baz _]]] = runSpecM $ do+      let [SpecGroup foo [SpecGroup bar [SpecItem _ baz _]]] = runSpecM $ do             H.describe "foo" $ do               H.describe "bar" $ do                 H.it "baz" True@@ -57,16 +52,16 @@    describe "it" $ do     it "takes a description of a desired behavior" $ do-      let [SpecItem d _] = runSpecM (H.it "whatever" True)+      let [SpecItem _ d _] = runSpecM (H.it "whatever" True)       d `shouldBe` "whatever"      it "takes an example of that behavior" $ do-      let [SpecItem _ e] = runSpecM (H.it "whatever" True)+      let [SpecItem _ _ e] = runSpecM (H.it "whatever" True)       e defaultParams `shouldReturn` Success      context "when no description is given" $ do       it "uses a default description" $ do-        let [SpecItem d _] = runSpecM (H.it "" True)+        let [SpecItem _ d _] = runSpecM (H.it "" True)         d `shouldBe` "(unspecified behavior)"    describe "example" $ do@@ -75,6 +70,18 @@         H.it "foo" $ H.example $ do           pure ()       r `shouldSatisfy` any (== "1 example, 0 failures")++  describe "parallel" $ do+    it "marks examples for parallel execution" $ do+      let [SpecItem isParallelizable _ _] = runSpecM . H.parallel $ H.it "whatever" True+      isParallelizable `shouldBe` True++    it "is applied recursively" $ do+      let [SpecGroup _ [SpecGroup _ [SpecItem isParallelizable _ _]]] = runSpecM . H.parallel $ do+            H.describe "foo" $ do+              H.describe "bar" $ do+                H.it "baz" True+      isParallelizable `shouldBe` True   where     runSpec :: H.Spec -> IO [String]-    runSpec = captureLines . H.hspecWith defaultConfig+    runSpec = captureLines . H.hspecResult