hspec 1.12.4 → 2.0.0

raw patch · 44 files changed

+75/−3695 lines, 44 filesdep +hspec-coredep +hspec-discoverdep −HUnitdep −ansi-terminaldep −asyncdep ~QuickCheckdep ~basedep ~hspec-expectationsPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec-core, hspec-discover

Dependencies removed: HUnit, ansi-terminal, async, deepseq, filepath, ghc-paths, process, quickcheck-io, random, setenv, silently, tf-random, time

Dependency ranges changed: QuickCheck, base, hspec-expectations, hspec-meta, transformers

API changes (from Hackage documentation)

Files

• hspec-discover/src/Config.hs +0/−45
• hspec-discover/src/Main.hs +0/−8
• hspec-discover/src/Run.hs +0/−134
• hspec-discover/test-data/empty-dir/Foo/Bar/Baz/.placeholder +0/−0
• hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs +0/−0
• hspec-discover/test-data/nested-spec/Foo/BarSpec.hs +0/−0
• hspec-discover/test-data/nested-spec/FooSpec.hs +0/−0
• hspec-discover/test/ConfigSpec.hs +0/−47
• hspec-discover/test/RunSpec.hs +0/−115
• hspec-discover/test/Spec.hs +0/−1
• hspec.cabal +13/−101
• src/Test/Hspec.hs +21/−67
• src/Test/Hspec/Compat.hs +0/−83
• src/Test/Hspec/Config.hs +0/−82
• src/Test/Hspec/Core.hs +6/−35
• src/Test/Hspec/Core/QuickCheckUtil.hs +0/−56
• src/Test/Hspec/Core/Type.hs +0/−223
• src/Test/Hspec/Discover.hs +20/−12
• src/Test/Hspec/FailureReport.hs +0/−36
• src/Test/Hspec/Formatters.hs +2/−236
• src/Test/Hspec/Formatters/Internal.hs +0/−262
• src/Test/Hspec/HUnit.hs +0/−23
• src/Test/Hspec/Options.hs +0/−178
• src/Test/Hspec/QuickCheck.hs +2/−31
• src/Test/Hspec/Runner.hs +2/−175
• src/Test/Hspec/Runner/Eval.hs +0/−152
• src/Test/Hspec/Runner/Tree.hs +0/−50
• src/Test/Hspec/Timer.hs +0/−14
• src/Test/Hspec/Util.hs +0/−109
• test/Helper.hs +3/−88
• test/Mock.hs +0/−15
• test/Test/Hspec/CompatSpec.hs +0/−33
• test/Test/Hspec/Core/QuickCheckUtilSpec.hs +0/−31
• test/Test/Hspec/Core/TypeSpec.hs +0/−136
• test/Test/Hspec/DiscoverSpec.hs +6/−7
• test/Test/Hspec/FailureReportSpec.hs +0/−39
• test/Test/Hspec/FormattersSpec.hs +0/−228
• test/Test/Hspec/HUnitSpec.hs +0/−45
• test/Test/Hspec/OptionsSpec.hs +0/−44
• test/Test/Hspec/QuickCheckSpec.hs +0/−19
• test/Test/Hspec/RunnerSpec.hs +0/−399
• test/Test/Hspec/TimerSpec.hs +0/−29
• test/Test/Hspec/UtilSpec.hs +0/−106
• test/Test/HspecSpec.hs +0/−201

@@ -1,45 +0,0 @@-module Config (-  Config (..)-, defaultConfig-, parseConfig-, usage-) where--import           Data.Maybe-import           System.Console.GetOpt--data Config = Config {-  configNested :: Bool-, configFormatter :: Maybe String-, configNoMain :: Bool-, configModuleName :: Maybe String-} deriving (Eq, Show)--defaultConfig :: Config-defaultConfig = Config False Nothing False Nothing--options :: [OptDescr (Config -> Config)]-options = [-    Option [] ["nested"] (NoArg $ \c -> c {configNested = True}) ""-  , Option [] ["formatter"] (ReqArg (\s c -> c {configFormatter = Just s}) "FORMATTER") ""-  , Option [] ["module-name"] (ReqArg (\s c -> c {configModuleName = Just s}) "NAME") ""-  , Option [] ["no-main"] (NoArg $ \c   -> c {configNoMain = True}) ""-  ]--usage :: String -> String-usage prog = "\nUsage: " ++ prog ++ " SRC CUR DST [--module-name=NAME]\n"--parseConfig :: String -> [String] -> Either String Config-parseConfig prog args = case getOpt Permute options args of-    (opts, [], []) -> let-        c = (foldl (flip id) defaultConfig opts)-      in-        if (configNoMain c && isJust (configFormatter c))-           then-             formatError "option `--formatter=<fmt>' does not make sense with `--no-main'\n"-           else-             Right c-    (_, _, err:_)  -> formatError err-    (_, arg:_, _)  -> formatError ("unexpected argument `" ++ arg ++ "'\n")-  where-    formatError err = Left (prog ++ ": " ++ err ++ usage prog)

@@ -1,8 +0,0 @@-module Main (main) where--import           System.Environment--import           Run (run)--main :: IO ()-main = getArgs >>= run

@@ -1,134 +0,0 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--- | A preprocessor that finds and combines specs.-module Run (-  run---- exported for testing-, Spec(..)-, importList-, fileToSpec-, findSpecs-, getFilesRecursive-, driverWithFormatter-, moduleName-) where-import           Control.Monad-import           Control.Applicative-import           Data.List-import           Data.Char-import           Data.Maybe-import           Data.String-import           System.Environment-import           System.Exit-import           System.IO-import           System.Directory (doesDirectoryExist, getDirectoryContents, doesFileExist)-import           System.FilePath hiding (combine)--import           Config--instance IsString ShowS where-  fromString = showString--data Spec = Spec {-  specFile :: FilePath-, specModule :: String-} deriving (Eq, Show)--run :: [String] -> IO ()-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-        when (configNested c) (hPutStrLn stderr "hspec-discover: WARNING - The `--nested' flag is deprecated and will be removed in a future release!")-        specs <- findSpecs src-        writeFile dst (mkSpecModule src c specs)-    _ -> do-      hPutStrLn stderr (usage name)-      exitFailure--mkSpecModule :: FilePath -> Config -> [Spec] -> String-mkSpecModule src c nodes =-  ( "{-# LINE 1 " . shows src . " #-}\n"-  . showString "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}\n"-  . showString ("module " ++ module_ ++" where\n")-  . importList nodes-  . showString "import Test.Hspec.Discover\n"-  . maybe driver driverWithFormatter (configFormatter c)-  . showString "spec :: Spec\n"-  . showString "spec = "-  . formatSpecs nodes-  ) "\n"-  where-    driver =-        case configNoMain c of-          False ->-              showString "main :: IO ()\n"-            . showString "main = hspec spec\n"-          True -> ""-    module_ = fromMaybe (if configNoMain c then pathToModule src else "Main") (configModuleName c)-    pathToModule f = let-        fileName = last $ splitDirectories f-        m:ms = takeWhile (/='.') fileName-     in-        toUpper m:ms---driverWithFormatter :: String -> ShowS-driverWithFormatter f =-    showString "import qualified " . showString (moduleName f) . showString "\n"-  . showString "main :: IO ()\n"-  . showString "main = hspecWithFormatter " . showString f . showString " spec\n"--moduleName :: String -> String-moduleName = reverse . dropWhile (== '.') . dropWhile (/= '.') . reverse---- | Generate imports for a list of specs.-importList :: [Spec] -> ShowS-importList = foldr (.) "" . map f-  where-    f :: Spec -> ShowS-    f spec = "import qualified " . showString (specModule spec) . "Spec\n"---- | Combine a list of strings with (>>).-sequenceS :: [ShowS] -> ShowS-sequenceS = foldr (.) "" . intersperse " >> "---- | Convert a list of specs to code.-formatSpecs :: [Spec] -> ShowS-formatSpecs xs-  | null xs   = "return ()"-  | otherwise = sequenceS (map formatSpec xs)---- | Convert a spec to code.-formatSpec :: Spec -> ShowS-formatSpec (Spec file name) = "postProcessSpec " . shows file . " (describe " . shows name . " " . showString name . "Spec.spec)"--findSpecs :: FilePath -> IO [Spec]-findSpecs src = do-  let (dir, file) = splitFileName src-  mapMaybe (fileToSpec dir) . filter (/= file) <$> getFilesRecursive dir--fileToSpec :: FilePath -> FilePath -> Maybe Spec-fileToSpec dir file = case reverse $ splitDirectories file of-  x:xs -> case stripSuffix "Spec.hs" x <|> stripSuffix "Spec.lhs" x of-    Just name | (not . null) name -> Just . Spec (dir </> file) $ (intercalate "." . reverse) (name : xs)-    _ -> Nothing-  _ -> Nothing-  where-    stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]-    stripSuffix suffix str = reverse <$> stripPrefix (reverse suffix) (reverse str)--getFilesRecursive :: FilePath -> IO [FilePath]-getFilesRecursive baseDir = sort <$> go []-  where-    go :: FilePath -> IO [FilePath]-    go dir = do-      c <- map (dir </>) . filter (`notElem` [".", ".."]) <$> getDirectoryContents (baseDir </> dir)-      dirs <- filterM (doesDirectoryExist . (baseDir </>)) c >>= mapM go-      files <- filterM (doesFileExist . (baseDir </>)) c-      return (files ++ concat dirs)

@@ -1,47 +0,0 @@-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 "recognizes --no-main" $ do-      parse ["--no-main"] `shouldBe` Right (defaultConfig {configNoMain = True})--    it "returns error message on unrecognized option" $ do-      parse ["--foo"] `shouldBe` (Left . unlines) [-          "hspec-discover: unrecognized option `--foo'"-        , ""-        , "Usage: hspec-discover SRC CUR DST [--module-name=NAME]"-        ]--    it "returns error message on unexpected argument" $ do-      parse ["foo"]   `shouldBe` (Left . unlines) [-          "hspec-discover: unexpected argument `foo'"-        , ""-        , "Usage: hspec-discover SRC CUR DST [--module-name=NAME]"-        ]--    it "returns error message on --formatter=<fmt> with --no-main" $ do-      parse ["--no-main", "--formatter=foo"] `shouldBe` (Left . unlines) [-          "hspec-discover: option `--formatter=<fmt>' does not make sense with `--no-main'"-        , ""-        , "Usage: hspec-discover SRC CUR DST [--module-name=NAME]"-        ]--    context "when option is given multiple times" $ do-      it "gives the last occurrence precedence" $ do-        parse ["--formatter", "foo", "--formatter", "bar"] `shouldBe` Right (defaultConfig {configFormatter = Just "bar"})

@@ -1,115 +0,0 @@-module RunSpec (main, spec) where--import           Test.Hspec.Meta--import           Control.Applicative-import           System.IO-import           System.Directory-import           System.FilePath-import           Data.List (sort)--import           Run hiding (Spec)-import qualified Run--main :: IO ()-main = hspec spec--withTempFile :: (FilePath -> IO a) -> IO a-withTempFile action = do-  dir <- getTemporaryDirectory-  (file, h) <- openTempFile dir ""-  hClose h-  action file <* removeFile file---spec :: Spec-spec = do-  describe "run" $ do-    it "generates test driver" $ withTempFile $ \f -> do-      run ["hspec-discover/test-data/nested-spec/Spec.hs", "", f]-      readFile f `shouldReturn` unlines [-          "{-# LINE 1 \"hspec-discover/test-data/nested-spec/Spec.hs\" #-}"-        , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}"-        , "module Main where"-        , "import qualified Foo.Bar.BazSpec"-        , "import qualified Foo.BarSpec"-        , "import qualified FooSpec"-        , "import Test.Hspec.Discover"-        , "main :: IO ()"-        , "main = hspec spec"-        , "spec :: Spec"-        , "spec = " ++ unwords [-               "postProcessSpec \"hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs\" (describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec)"-          , ">> postProcessSpec \"hspec-discover/test-data/nested-spec/Foo/BarSpec.hs\" (describe \"Foo.Bar\" Foo.BarSpec.spec)"-          , ">> postProcessSpec \"hspec-discover/test-data/nested-spec/FooSpec.hs\" (describe \"Foo\" FooSpec.spec)"-          ]-        ]--    it "generates test driver for an empty directory" $ withTempFile $ \f -> do-      run ["hspec-discover/test-data/empty-dir/Spec.hs", "", f]-      readFile f `shouldReturn` unlines [-          "{-# LINE 1 \"hspec-discover/test-data/empty-dir/Spec.hs\" #-}"-        , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}"-        , "module Main where"-        , "import Test.Hspec.Discover"-        , "main :: IO ()"-        , "main = hspec spec"-        , "spec :: Spec"-        , "spec = return ()"-        ]--  describe "getFilesRecursive" $ do-    it "recursively returns all file entries of a given directory" $ do-      getFilesRecursive "hspec-discover/test-data" `shouldReturn` sort [-          "empty-dir/Foo/Bar/Baz/.placeholder"-        , "nested-spec/Foo/Bar/BazSpec.hs"-        , "nested-spec/Foo/BarSpec.hs"-        , "nested-spec/FooSpec.hs"-        ]--  describe "fileToSpec" $ do-    it "converts path to spec name" $ do-      fileToSpec "" "FooSpec.hs" `shouldBe` Just (spec_ "FooSpec.hs" "Foo")--    it "rejects spec with empty name" $ do-      fileToSpec "" "Spec.hs" `shouldBe` Nothing--    it "works for lhs files" $ do-      fileToSpec "" "FooSpec.lhs" `shouldBe` Just (spec_ "FooSpec.lhs" "Foo")--    it "returns Nothing for invalid spec name" $ do-      fileToSpec "" "foo" `shouldBe` Nothing--    context "when path has directory component" $ do-      it "converts path to spec name" $ do-        let file = "Foo" </> "Bar" </> "BazSpec.hs"-        fileToSpec "" file `shouldBe` Just (spec_ file "Foo.Bar.Baz")--      it "rejects spec with empty name" $ do-        fileToSpec "" ("Foo" </> "Bar" </> "Spec.hs") `shouldBe` Nothing--  describe "findSpecs" $ do-    it "finds specs" $ do-      let dir = "hspec-discover/test-data/nested-spec"-      findSpecs (dir </> "Spec.hs") `shouldReturn` [spec_ (dir </> "Foo/Bar/BazSpec.hs") "Foo.Bar.Baz", spec_ (dir </> "Foo/BarSpec.hs") "Foo.Bar", spec_ (dir </> "FooSpec.hs") "Foo"]--  describe "driverWithFormatter" $ do-    it "generates a test driver that uses a custom formatter" $ do-      driverWithFormatter "Some.Module.formatter" "" `shouldBe` unlines [-          "import qualified Some.Module"-        , "main :: IO ()"-        , "main = hspecWithFormatter Some.Module.formatter spec"-        ]--  describe "moduleName" $ do-    it "returns the module name of an fully qualified identifier" $ do-      moduleName "Some.Module.someId" `shouldBe` "Some.Module"--  describe "importList" $ do-    it "generates imports for a list of specs" $ do-      importList [spec_ "FooSpec.hs" "Foo", spec_ "BarSpec.hs" "Bar"] "" `shouldBe` unlines [-          "import qualified FooSpec"-        , "import qualified BarSpec"-        ]-  where-    spec_ = Run.Spec

@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-}

@@ -1,5 +1,5 @@ name:             hspec-version:          1.12.4+version:          2.0.0 license:          MIT license-file:     LICENSE copyright:        (c) 2011-2014 Simon Hengel,@@ -30,120 +30,52 @@ extra-source-files:   changelog --- find hspec-discover/test-data/ -type f-  hspec-discover/test-data/nested-spec/FooSpec.hs-  hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs-  hspec-discover/test-data/nested-spec/Foo/BarSpec.hs-  hspec-discover/test-data/empty-dir/Foo/Bar/Baz/.placeholder- source-repository head   type: git   location: https://github.com/hspec/hspec -Library+library   ghc-options:       -Wall   hs-source-dirs:       src   build-depends:       base == 4.*-    , random-    , tf-random-    , setenv-    , ansi-terminal >= 0.5-    , time+    , hspec-core == 2.0.0+    , hspec-discover == 2.0.0+    , hspec-expectations == 0.6.1.*     , transformers >= 0.2.2.0-    , deepseq-    , HUnit >= 1.2.5     , QuickCheck >= 2.5.1-    , quickcheck-io-    , hspec-expectations == 0.6.1.*-    , async >= 2   exposed-modules:       Test.Hspec-      Test.Hspec.Core       Test.Hspec.Runner       Test.Hspec.Formatters-      Test.Hspec.HUnit       Test.Hspec.QuickCheck       Test.Hspec.Discover-  other-modules:-      Test.Hspec.Util-      Test.Hspec.Compat-      Test.Hspec.Core.Type-      Test.Hspec.Core.QuickCheckUtil-      Test.Hspec.Config-      Test.Hspec.Options-      Test.Hspec.FailureReport-      Test.Hspec.Runner.Eval-      Test.Hspec.Runner.Tree-      Test.Hspec.Formatters.Internal-      Test.Hspec.Timer-  default-language: Haskell2010--executable hspec-discover-  ghc-options:-      -Wall-  hs-source-dirs:-      hspec-discover/src-  main-is:-      Main.hs-  other-modules:-      Run-      Config-  build-depends:-      base == 4.*-    , filepath-    , directory+      Test.Hspec.Core   default-language: Haskell2010  test-suite spec   type:       exitcode-stdio-1.0+  ghc-options:+      -Wall   hs-source-dirs:-      src, test+      test   main-is:       Spec.hs   other-modules:-      Mock       Helper       HelperSpec-      Test.HspecSpec-      Test.Hspec.CompatSpec-      Test.Hspec.Core.QuickCheckUtilSpec-      Test.Hspec.Core.TypeSpec       Test.Hspec.DiscoverSpec-      Test.Hspec.FailureReportSpec-      Test.Hspec.FormattersSpec-      Test.Hspec.HUnitSpec-      Test.Hspec.OptionsSpec-      Test.Hspec.QuickCheckSpec-      Test.Hspec.RunnerSpec-      Test.Hspec.TimerSpec-      Test.Hspec.UtilSpec-  ghc-options:-      -Wall -Werror   build-depends:       base == 4.*-    , random-    , tf-random-    , setenv-    , silently >= 1.2.4-    , ansi-terminal-    , time-    , transformers-    , deepseq-    , HUnit-    , QuickCheck-    , quickcheck-io-    , hspec-expectations-    , async+    , hspec-core+    , hspec -    , hspec-meta >= 1.12-    , process     , directory     , stringbuilder-    , ghc-paths+    , hspec-meta >= 1.12   default-language: Haskell2010  test-suite example@@ -154,29 +86,9 @@   hs-source-dirs:       example   ghc-options:-      -Wall -Werror+      -Wall   build-depends:       base == 4.*     , hspec     , QuickCheck-  default-language: Haskell2010--test-suite hspec-discover-spec-  type:-      exitcode-stdio-1.0-  ghc-options:-      -Wall -Werror-  hs-source-dirs:-      hspec-discover/src-    , hspec-discover/test-  main-is:-      Spec.hs-  other-modules:-      RunSpec-      ConfigSpec-  build-depends:-      base == 4.*-    , filepath-    , directory-    , hspec-meta   default-language: Haskell2010

@@ -9,6 +9,8 @@ module Test.Hspec ( -- * Types   Spec+, SpecWith+, Arg , Example  -- * Setting expectations@@ -22,54 +24,32 @@ , example , pending , pendingWith+, parallel+, runIO++-- * Hooks+, ActionWith , before+, beforeWith , beforeAll , after+, after_ , afterAll+, afterAll_ , around-, parallel-, runIO+, around_+, aroundWith  -- * Running a spec , hspec ) where -import           Control.Exception (finally)-import           Control.Concurrent.MVar--import           Test.Hspec.Core.Type+import           Test.Hspec.Core.Spec+import           Test.Hspec.Core.Hooks import           Test.Hspec.Runner-import           Test.Hspec.HUnit () import           Test.Hspec.Expectations-import qualified Test.Hspec.Core as Core --- | Combine a list of specs into a larger spec.-describe :: String -> Spec -> Spec-describe label spec = runIO (runSpecM spec) >>= fromSpecList . return . Core.specGroup label---- | 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 a => String -> a -> Spec-it label action = fromSpecList [Core.specItem label action]---- | An alias for `it`.-specify :: Example a => String -> a -> Spec-specify = it---- | This is a type restricted version of `id`.  It can be used to get better+-- | @example@ is a type restricted version of `id`.  It can be used to get better -- error messages on type mismatches. -- -- Compare e.g.@@ -84,36 +64,10 @@ example :: Expectation -> Expectation example = id --- | Run spec items of given `Spec` in parallel.-parallel :: Spec -> Spec-parallel = mapSpecItem $ \item -> item {itemIsParallelizable = True}---- | Run a custom action before every spec item.-before :: IO () -> Spec -> Spec-before action = around (action >>)---- | Run a custom action before the first spec item.-beforeAll :: IO () -> Spec -> Spec-beforeAll action spec = do-  mvar <- runIO (newMVar Nothing)-  let action_ = memoize mvar action-  before action_ spec--memoize :: MVar (Maybe a) -> IO a -> IO a-memoize mvar action = modifyMVar mvar $ \ma -> case ma of-  Just a -> return (ma, a)-  Nothing -> do-    a <- action-    return (Just a, a)---- | Run a custom action after every spec item.-after :: IO () -> Spec -> Spec-after action = around (`finally` action)---- | Run a custom action after the last spec item.-afterAll :: IO () -> Spec -> Spec-afterAll action spec = runIO (runSpecM spec) >>= fromSpecList . return . SpecWithCleanup action+-- | @context@ is an alias for `describe`.+context :: String -> SpecWith a -> SpecWith a+context = describe --- | Run a custom action before and/or after every spec item.-around :: (IO () -> IO ()) -> Spec -> Spec-around a2 = mapSpecItem $ \item -> item {itemExample = \params a1 -> itemExample item params (a1 . a2)}+-- | @specify@ is an alias for `it`.+specify :: Example a => String -> a -> SpecWith (Arg a)+specify = it

@@ -1,83 +0,0 @@-{-# LANGUAGE CPP #-}-module Test.Hspec.Compat (-  showType-, showFullType-, readMaybe-, lookupEnv-, module Data.IORef-#if !MIN_VERSION_base(4,6,0)-, modifyIORef'-#endif-) where--#if !MIN_VERSION_base(4,3,0)-import           Control.Monad.Trans.Error () -- for Monad (Either e)-#endif--import           Data.Typeable (Typeable, typeOf, typeRepTyCon)-import           Text.Read-import           Data.IORef-import           System.Environment--#if MIN_VERSION_base(4,4,0)-import           Data.Typeable.Internal (tyConModule, tyConName)-#endif--#if !MIN_VERSION_base(4,6,0)-import qualified Text.ParserCombinators.ReadP as P-#endif--#if !MIN_VERSION_base(4,6,0)--- |Strict version of 'modifyIORef'-modifyIORef' :: IORef a -> (a -> a) -> IO ()-modifyIORef' ref f = do-    x <- readIORef ref-    let x' = f x-    x' `seq` writeIORef ref x'---- | Parse a string using the 'Read' instance.--- Succeeds if there is exactly one valid result.--- A 'Left' value indicates a parse error.-readEither :: Read a => String -> Either String a-readEither s =-  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of-    [x] -> Right x-    []  -> Left "Prelude.read: no parse"-    _   -> Left "Prelude.read: ambiguous parse"- where-  read' =-    do x <- readPrec-       lift P.skipSpaces-       return x---- | Parse a string using the 'Read' instance.--- Succeeds if there is exactly one valid result.-readMaybe :: Read a => String -> Maybe a-readMaybe s = case readEither s of-                Left _  -> Nothing-                Right a -> Just a---- | Return the value of the environment variable @var@, or @Nothing@ if--- there is no such value.------ For POSIX users, this is equivalent to 'System.Posix.Env.getEnv'.-lookupEnv :: String -> IO (Maybe String)-lookupEnv k = lookup k `fmap` getEnvironment-#endif--showType :: Typeable a => a -> String-showType a = let t = typeRepTyCon (typeOf a) in-#if MIN_VERSION_base(4,4,0)-  show t-#else-  (reverse . takeWhile (/= '.') . reverse . show) t-#endif---showFullType :: Typeable a => a -> String-showFullType a = let t = typeRepTyCon (typeOf a) in-#if MIN_VERSION_base(4,4,0)-  tyConModule t ++ "." ++ tyConName t-#else-  show t-#endif

@@ -1,82 +0,0 @@-module Test.Hspec.Config (-  Config (..)-, ColorMode(..)-, defaultConfig-, getConfig-, configAddFilter-, configQuickCheckArgs-) where--import           Control.Applicative-import           System.IO-import           System.Exit-import qualified Test.QuickCheck as QC--import           Test.Hspec.Util-import           Test.Hspec.Options-import           Test.Hspec.FailureReport-import           Test.Hspec.Core.QuickCheckUtil (mkGen)---- | 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 p1 `filterOr` configFilterPredicate c-  }--mkConfig :: Maybe FailureReport -> Config -> Config-mkConfig mFailureReport opts = opts {-    configFilterPredicate = matchFilter `filterOr` rerunFilter-  , configQuickCheckSeed = mSeed-  , configQuickCheckMaxSuccess = mMaxSuccess-  , configQuickCheckMaxDiscardRatio = mMaxDiscardRatio-  , configQuickCheckMaxSize = mMaxSize-  }-  where--    mSeed = configQuickCheckSeed opts <|> (failureReportSeed <$> mFailureReport)-    mMaxSuccess = configQuickCheckMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport)-    mMaxSize = configQuickCheckMaxSize opts <|> (failureReportMaxSize <$> mFailureReport)-    mMaxDiscardRatio = configQuickCheckMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport)--    matchFilter = configFilterPredicate opts--    rerunFilter = flip elem . failureReportPaths <$> mFailureReport--configQuickCheckArgs :: Config -> QC.Args-configQuickCheckArgs c = qcArgs-  where-    qcArgs = (-        maybe id setSeed (configQuickCheckSeed c)-      . maybe id setMaxDiscardRatio (configQuickCheckMaxDiscardRatio c)-      . maybe id setMaxSize (configQuickCheckMaxSize c)-      . maybe id setMaxSuccess (configQuickCheckMaxSuccess c)) QC.stdArgs--    setMaxSuccess :: Int -> QC.Args -> QC.Args-    setMaxSuccess n args = args {QC.maxSuccess = n}--    setMaxSize :: Int -> QC.Args -> QC.Args-    setMaxSize n args = args {QC.maxSize = n}--    setMaxDiscardRatio :: Int -> QC.Args -> QC.Args-    setMaxDiscardRatio n args = args {QC.maxDiscardRatio = n}--    setSeed :: Integer -> QC.Args -> QC.Args-    setSeed n args = args {QC.replay = Just (mkGen (fromIntegral n), 0)}--getConfig :: Config -> 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 configRerun opts then readFailureReport else return Nothing-      return (mkConfig r opts)--exitWithMessage :: ExitCode -> String -> IO a-exitWithMessage err msg = do-  hPutStr h msg-  exitWith err-  where-    h = case err of-      ExitSuccess -> stdout-      _           -> stderr

@@ -1,47 +1,18 @@--- |--- 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 (---- * A type class for examples-  Example (..)-, Params (..)-, Progress-, ProgressCallback-, Result (..)---- * A writer monad for constructing specs-, SpecM-, runSpecM-, fromSpecList---- * Internal representation of a spec tree-, SpecTree (..)-, mapSpecTree-, Item (..)-, Location (..)-, LocationAccuracy(..)-, mapSpecItem-, modifyParams-, specGroup-, specItem-+-- | Stability: unstable+module Test.Hspec.Core {-# DEPRECATED "use \"Test.Hspec.Core.Spec\" instead" #-} (+  module Test.Hspec.Core.Spec -- * Deprecated functions , describe , it ) where -import           Test.Hspec.Core.Type+import           Test.Hspec.Core.Spec hiding (describe, it) -modifyParams :: (Params -> Params) -> Spec -> Spec-modifyParams f = mapSpecItem $ \item -> item {itemExample = \p -> (itemExample item) (f p)}  {-# DEPRECATED describe "use `specGroup` instead" #-}-describe :: String -> [SpecTree] -> SpecTree+describe :: String -> [SpecTree a] -> SpecTree a describe = specGroup  {-# DEPRECATED it "use `specItem` instead" #-}-it :: Example a => String -> a -> SpecTree+it :: Example a => String -> a -> SpecTree (Arg a) it = specItem

@@ -1,56 +0,0 @@-{-# LANGUAGE CPP #-}-module Test.Hspec.Core.QuickCheckUtil where--import           Control.Applicative-import           Data.Int-import           Data.IORef-import           Test.QuickCheck hiding (Result(..))-import           Test.QuickCheck as QC-import           Test.QuickCheck.Property hiding (Result(..))-import qualified Test.QuickCheck.Property as QCP-import           Test.QuickCheck.IO ()---#if MIN_VERSION_QuickCheck(2,7,0)-import           Test.QuickCheck.Random-#endif--import           System.Random--import           Test.Hspec.Util--aroundProperty :: (IO () -> IO ()) -> Property -> Property-#if MIN_VERSION_QuickCheck(2,7,0)-aroundProperty action (MkProperty p) = MkProperty $ MkProp . aroundRose action . unProp <$> p-#else-aroundProperty action p = MkProp . aroundRose action . unProp <$> p-#endif--aroundRose :: (IO () -> IO ()) -> Rose QCP.Result -> Rose QCP.Result-aroundRose action r = ioRose $ do-  ref <- newIORef (return QCP.succeeded)-  action (reduceRose r >>= writeIORef ref)-  readIORef ref--formatNumbers :: Result -> String-formatNumbers r = "(after " ++ pluralize (numTests r) "test" ++ shrinks ++ ")"-  where-    shrinks-      | 0 < numShrinks r = " and " ++ pluralize (numShrinks r) "shrink"-      | otherwise = ""--newSeed :: IO Int-newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$>-#if MIN_VERSION_QuickCheck(2,7,0)-  newQCGen-#else-  newStdGen-#endif--#if MIN_VERSION_QuickCheck(2,7,0)-mkGen :: Int -> QCGen-mkGen = mkQCGen-#else-mkGen :: Int -> StdGen-mkGen = mkStdGen-#endif

@@ -1,223 +0,0 @@-{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-module Test.Hspec.Core.Type (-  Spec-, SpecM (..)-, runSpecM-, fromSpecList-, SpecTree (..)-, mapSpecTree-, Item (..)-, mapSpecItem-, Location (..)-, LocationAccuracy(..)-, Example (..)-, Result (..)-, Params (..)-, Progress-, ProgressCallback--, specGroup-, specItem-, forceResult--, runIO--, pending-, pendingWith-) where--import qualified Control.Exception as E-import           Control.Applicative-import           Control.Monad.Trans.Writer-import           Control.Monad.IO.Class (liftIO)-import           Data.Typeable (Typeable)-import           Data.List (isPrefixOf)-import           Data.Maybe (fromMaybe)--import           Test.Hspec.Compat-import           Test.Hspec.Util-import           Test.Hspec.Expectations-import           Test.HUnit.Lang (HUnitFailure(..))-import qualified Test.QuickCheck as QC-import qualified Test.QuickCheck.State as QC-import qualified Test.QuickCheck.Property as QCP-import qualified Test.QuickCheck.IO ()--import           Test.Hspec.Core.QuickCheckUtil-import           Control.DeepSeq (deepseq)--type Spec = SpecM ()---- | A writer monad for `SpecTree` forests.-newtype SpecM a = SpecM (WriterT [SpecTree] IO a)-  deriving (Functor, Applicative, Monad)---- | Convert a `Spec` to a forest of `SpecTree`s.-runSpecM :: Spec -> IO [SpecTree]-runSpecM (SpecM specs) = execWriterT specs---- | Create a `Spec` from a forest of `SpecTree`s.-fromSpecList :: [SpecTree] -> Spec-fromSpecList = SpecM . tell---- | Run an IO action while constructing the spec tree.------ `SpecM` is a monad to construct a spec tree, without executing any spec--- items.  `runIO` allows you to run IO actions during this construction phase.--- The IO action is always run when the spec tree is constructed (e.g. even--- when @--dry-run@ is specified).-runIO :: IO a -> SpecM a-runIO = SpecM . liftIO---- | The result of running an example.-data Result = Success | Pending (Maybe String) | Fail String-  deriving (Eq, Show, Read, Typeable)--forceResult :: Result -> Result-forceResult r = case r of-  Success   -> r-  Pending m -> m `deepseq` r-  Fail    m -> m `deepseq` r--instance E.Exception Result--type Progress = (Int, Int)-type ProgressCallback = Progress -> IO ()--data Params = Params {-  paramsQuickCheckArgs  :: QC.Args-, paramsSmallCheckDepth :: Int-} deriving (Show)---- | Internal representation of a spec.-data SpecTree =-    SpecGroup String [SpecTree]-  | SpecWithCleanup (IO ()) [SpecTree]-  | SpecItem Item--data Item = Item {-  itemRequirement :: String-, itemLocation :: Maybe Location-, itemIsParallelizable :: Bool-, itemExample :: Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result-}--mapSpecTree :: (SpecTree -> SpecTree) -> Spec -> Spec-mapSpecTree f spec = runIO (runSpecM spec) >>= fromSpecList . map f--mapSpecItem :: (Item -> Item) -> Spec -> Spec-mapSpecItem f = mapSpecTree go-  where-    go :: SpecTree -> SpecTree-    go spec = case spec of-      SpecGroup d xs -> SpecGroup d (map go xs)-      SpecWithCleanup cleanup xs -> SpecWithCleanup cleanup (map go xs)-      SpecItem item -> SpecItem (f item)--data LocationAccuracy = ExactLocation | BestEffort-  deriving (Eq, Show)--data Location = Location {-  locationFile :: String-, locationLine :: Int-, locationColumn :: Int-, locationAccuracy :: LocationAccuracy-} deriving (Eq, Show)---- | The @specGroup@ function combines a list of specs into a larger spec.-specGroup :: String -> [SpecTree] -> SpecTree-specGroup s = SpecGroup msg-  where-    msg-      | null s = "(no description given)"-      | otherwise = s---- | The @specItem@ function creates a spec item.-specItem :: Example a => String -> a -> SpecTree-specItem s e = SpecItem $ Item requirement Nothing False (evaluateExample e)-  where-    requirement-      | null s = "(unspecified behavior)"-      | otherwise = s---- | A type class for examples.-class Example a where-  evaluateExample :: a -> Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result--instance Example Bool where-  evaluateExample b _ _ _ = if b then return Success else return (Fail "")--instance Example Expectation where-  evaluateExample e _ action _ = (action e >> return Success) `E.catches` [-      E.Handler (\(HUnitFailure err) -> return (Fail err))-    , E.Handler (return :: Result -> IO Result)-    ]--instance Example Result where-  evaluateExample r _ _ _ = return r--instance Example QC.Property where-  evaluateExample p c action progressCallback = do-    r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty action p)-    return $-      case r of-        QC.Success {}               -> Success-        QC.Failure {QC.output = m}  -> fromMaybe (Fail $ sanitizeFailureMessage r) (parsePending m)-        QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ pluralize n "test" )-        QC.NoExpectedFailure {}     -> Fail ("No expected failure")-    where-      qcProgressCallback = QCP.PostTest QCP.NotCounterexample $-        \st _ -> progressCallback (QC.numSuccessTests st, QC.maxSuccessTests st)--      sanitizeFailureMessage :: QC.Result -> String-      sanitizeFailureMessage r = let m = QC.output r in strip $-#if MIN_VERSION_QuickCheck(2,7,0)-        case QC.theException r of-          Just e -> let numbers = formatNumbers r in-            "uncaught exception: " ++ formatException e ++ " " ++ numbers ++ "\n" ++ case lines m of-              x:xs | x == (exceptionPrefix ++ show e ++ "' " ++ numbers ++ ": ") -> unlines xs-              _ -> m-          Nothing ->-#endif-            (addFalsifiable . stripFailed) m--      addFalsifiable :: String -> String-      addFalsifiable m-        | "(after " `isPrefixOf` m = "Falsifiable " ++ m-        | otherwise = m--      stripFailed :: String -> String-      stripFailed m-        | prefix `isPrefixOf` m = drop n m-        | otherwise = m-        where-          prefix = "*** Failed! "-          n = length prefix--      parsePending :: String -> Maybe Result-      parsePending m-        | exceptionPrefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m-        | otherwise = Nothing-        where-          n = length exceptionPrefix--      exceptionPrefix = "*** Failed! Exception: '"---- | Specifies a pending example.------ If you want to textually specify a behavior but do not have an example yet,--- use this:------ > describe "fancyFormatter" $ do--- >   it "can format text in a way that everyone likes" $--- >     pending-pending :: Expectation-pending = E.throwIO (Pending Nothing)---- | Specifies a pending example with a reason for why it's pending.------ > describe "fancyFormatter" $ do--- >   it "can format text in a way that everyone likes" $--- >     pendingWith "waiting for clarification from the designers"-pendingWith :: String -> Expectation-pendingWith = E.throwIO . Pending . Just

@@ -1,12 +1,13 @@+{-# LANGUAGE FlexibleInstances #-} module Test.Hspec.Discover {-# WARNING   "This module is used by @hspec-discover@.  It is not part of the public API and may change at any time."   #-} (   Spec , hspec+, IsFormatter (..) , hspecWithFormatter , postProcessSpec , describe- , module Prelude ) where @@ -16,13 +17,20 @@ import           Data.Traversable hiding (mapM) import           Control.Monad.Trans.State -import           Test.Hspec-import           Test.Hspec.Core.Type-import           Test.Hspec.Runner-import           Test.Hspec.Runner.Tree+import           Test.Hspec.Core.Spec+import           Test.Hspec.Core.Runner import           Test.Hspec.Formatters-import           Test.Hspec.Util+import           Test.Hspec.Core.Util (safeTry) +class IsFormatter a where+  toFormatter :: a -> IO Formatter++instance IsFormatter (IO Formatter) where+  toFormatter = id++instance IsFormatter Formatter where+  toFormatter = return+ hspecWithFormatter :: IsFormatter a => a -> Spec -> IO () hspecWithFormatter formatter spec = do   f <- toFormatter formatter@@ -35,23 +43,23 @@ locationHeuristicFromFile file spec = do   mInput <- either (const Nothing) Just <$> (runIO . safeTry . readFile) file   let lookupLoc = maybe (\_ _ _ -> Nothing) (lookupLocation file)  mInput-  runIO (toTree spec) >>= fromTree . addLoctions lookupLoc+  runIO (runSpecM spec) >>= fromSpecList . addLoctions lookupLoc -addLoctions :: (Int -> Int -> String -> Maybe Location) -> [Tree Item] -> [Tree Item]+addLoctions :: (Int -> Int -> String -> Maybe Location) -> [SpecTree a] -> [SpecTree a] addLoctions lookupLoc = map (fmap f) . enumerate   where-    f :: ((Int, Int), Item) -> Item+    f :: ((Int, Int), Item a) -> Item a     f ((n, total), item) = item {itemLocation = itemLocation item <|> lookupLoc n total (itemRequirement item)}  type EnumerateM = State [(String, Int)] -enumerate :: [Tree Item] -> [Tree ((Int, Int), Item)]+enumerate :: [SpecTree a] -> [Tree (ActionWith a) ((Int, Int), (Item a))] enumerate tree = (mapM (traverse addPosition) tree >>= mapM (traverse addTotal)) `evalState` []   where-    addPosition :: Item -> EnumerateM (Int, Item)+    addPosition :: Item a -> EnumerateM (Int, Item a)     addPosition item = (,) <$> getOccurrence (itemRequirement item) <*> pure item -    addTotal :: (Int, Item) -> EnumerateM ((Int, Int), Item)+    addTotal :: (Int, Item a) -> EnumerateM ((Int, Int), Item a)     addTotal (n, item) = do       total <- getTotal (itemRequirement item)       return ((n, total), item)

@@ -1,36 +0,0 @@-module Test.Hspec.FailureReport (-  FailureReport (..)-, writeFailureReport-, readFailureReport-) where--import           System.IO-import           System.SetEnv-import           Test.Hspec.Compat-import           Test.Hspec.Util (Path, safeTry)--data FailureReport = FailureReport {-  failureReportSeed :: Integer-, failureReportMaxSuccess :: Int-, failureReportMaxSize :: Int-, failureReportMaxDiscardRatio :: Int-, failureReportPaths :: [Path]-} deriving (Eq, Show, Read)--writeFailureReport :: FailureReport -> IO ()-writeFailureReport x = do-  -- on Windows this can throw an exception when the input is too large, hence-  -- we use `safeTry` here-  safeTry (setEnv "HSPEC_FAILURES" $ show x) >>= either onError return-  where-    onError err = do-      hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")")--readFailureReport :: IO (Maybe FailureReport)-readFailureReport = do-  mx <- lookupEnv "HSPEC_FAILURES"-  case mx >>= readMaybe of-    Nothing -> do-      hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!"-      return Nothing-    x -> return x

@@ -1,236 +1,2 @@-{-# LANGUAGE FlexibleInstances #-}--- |--- Stability: experimental------ This module contains formatters that can be used with--- `Test.Hspec.Runner.hspecWith`.-module Test.Hspec.Formatters (---- * Formatters-  silent-, specdoc-, progress-, failed_examples---- * Implementing a custom Formatter--- |--- A formatter is a set of actions.  Each action is evaluated when a certain--- situation is encountered during a test run.------ Actions live in the `FormatM` monad.  It provides access to the runner state--- and primitives for appending to the generated report.-, Formatter (..)-, FormatM---- ** Accessing the runner state-, getSuccessCount-, getPendingCount-, getFailCount-, getTotalCount--, FailureRecord (..)-, getFailMessages-, usedSeed--, getCPUTime-, getRealTime---- ** Appending to the gerenated report-, write-, writeLine-, newParagraph---- ** Dealing with colors-, withInfoColor-, withSuccessColor-, withPendingColor-, withFailColor---- ** 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-import           Test.Hspec.Util-import           Test.Hspec.Core.Type (Location(..), LocationAccuracy(..))-import           Text.Printf-import           Control.Monad (when, unless)-import           Data.Foldable (forM_)-import           Control.Applicative-import           System.IO (hPutStr, hFlush)---- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make--- sure, that we only use the public API to implement formatters.------ Everything imported here has to be re-exported, so that users can implement--- their own formatters.-import Test.Hspec.Formatters.Internal (-    Formatter (..)-  , FormatM--  , getSuccessCount-  , getPendingCount-  , getFailCount-  , getTotalCount--  , FailureRecord (..)-  , getFailMessages-  , usedSeed--  , getCPUTime-  , getRealTime--  , write-  , writeLine-  , newParagraph--  , withInfoColor-  , withSuccessColor-  , withPendingColor-  , 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 {-  headerFormatter     = return ()-, exampleGroupStarted = \_ _ -> return ()-, exampleGroupDone    = return ()-, exampleProgress     = \_ _ _ -> return ()-, exampleSucceeded    = \_ -> return ()-, exampleFailed       = \_ _ -> return ()-, examplePending      = \_ _  -> return ()-, failedFormatter     = return ()-, footerFormatter     = return ()-}---specdoc :: Formatter-specdoc = silent {--  headerFormatter = do-    writeLine ""--, exampleGroupStarted = \nesting name -> do-    writeLine (indentationFor nesting ++ name)--, exampleProgress = \h _ p -> do-    hPutStr h (formatProgress p)-    hFlush h--, exampleSucceeded = \(nesting, requirement) -> withSuccessColor $ do-    writeLine $ indentationFor nesting ++ "- " ++ requirement--, exampleFailed = \(nesting, requirement) _ -> withFailColor $ do-    n <- getFailCount-    writeLine $ indentationFor nesting ++ "- " ++ requirement ++ " FAILED [" ++ show n ++ "]"--, examplePending = \(nesting, requirement) reason -> withPendingColor $ do-    writeLine $ indentationFor nesting ++ "- " ++ requirement ++ "\n     # PENDING: " ++ fromMaybe "No reason given" reason--, failedFormatter = defaultFailedFormatter--, footerFormatter = defaultFooter-} where-    indentationFor nesting = replicate (length nesting * 2) ' '-    formatProgress (current, total)-      | total == 0 = show current ++ "\r"-      | otherwise  = show current ++ "/" ++ show total ++ "\r"---progress :: Formatter-progress = silent {-  exampleSucceeded = \_   -> withSuccessColor $ write "."-, exampleFailed    = \_ _ -> withFailColor    $ write "F"-, examplePending   = \_ _ -> withPendingColor $ write "."-, failedFormatter  = defaultFailedFormatter-, footerFormatter  = defaultFooter-}---failed_examples :: Formatter-failed_examples   = silent {-  failedFormatter = defaultFailedFormatter-, footerFormatter = defaultFooter-}--defaultFailedFormatter :: FormatM ()-defaultFailedFormatter = do-  writeLine ""--  failures <- getFailMessages--  forM_ (zip [1..] failures) $ \x -> do-    formatFailure x-    writeLine ""--  when (hasBestEffortLocations failures) $ do-    withInfoColor $ writeLine "Source locations marked with \"best-effort\" are calculated heuristically and may be incorrect."-    writeLine ""--  unless (null failures) $ do-    write "Randomized with seed " >> usedSeed >>= writeLine . show-    writeLine ""-  where-    hasBestEffortLocations :: [FailureRecord] -> Bool-    hasBestEffortLocations = any p-      where-        p :: FailureRecord -> Bool-        p failure = (locationAccuracy <$> failureRecordLocation failure) == Just BestEffort--    formatFailure :: (Int, FailureRecord) -> FormatM ()-    formatFailure (n, FailureRecord mLoc path reason) = do-      write (show n ++ ") ")-      writeLine (formatRequirement path)-      withFailColor $ do-        unless (null err) $ do-          writeLine err-      forM_ mLoc $ \loc -> do-        writeLine ""-        withInfoColor $ writeLine (formatLoc loc)-      where-        err = either (("uncaught exception: " ++) . formatException) id reason-        formatLoc (Location file line _column accuracy) = "# " ++ file ++ ":" ++ show line ++ bestEffortMarking-          where-            bestEffortMarking = case accuracy of-              ExactLocation -> ""-              BestEffort -> " (best-effort)"--defaultFooter :: FormatM ()-defaultFooter = do--  writeLine =<< (++)-    <$> (printf "Finished in %1.4f seconds"-    <$> getRealTime) <*> (maybe "" (printf ", used %1.4f seconds of CPU time") <$> getCPUTime)--  fails   <- getFailCount-  pending <- getPendingCount-  total   <- getTotalCount--  let c | fails /= 0   = withFailColor-        | pending /= 0 = withPendingColor-        | otherwise    = withSuccessColor-  c $ do-    write $ pluralize total   "example"-    write (", " ++ pluralize fails "failure")-    unless (pending == 0) $-      write (", " ++ show pending ++ " pending")-  writeLine ""+module Test.Hspec.Formatters (module Test.Hspec.Core.Formatters) where+import           Test.Hspec.Core.Formatters

@@ -1,262 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Test.Hspec.Formatters.Internal (---- * Public API-  Formatter (..)-, FormatM--, getSuccessCount-, getPendingCount-, getFailCount-, getTotalCount--, FailureRecord (..)-, getFailMessages-, usedSeed--, getCPUTime-, getRealTime--, write-, writeLine-, newParagraph--, withInfoColor-, withSuccessColor-, withPendingColor-, withFailColor---- * Functions for internal use-, runFormatM-, increaseSuccessCount-, increasePendingCount-, increaseFailCount-, addFailMessage-, finally_-) where--import qualified System.IO as IO-import           System.IO (Handle)-import           Control.Monad-import           Control.Applicative-import           Control.Exception (SomeException, AsyncException(..), bracket_, try, throwIO)-import           System.Console.ANSI-import           Control.Monad.Trans.State hiding (gets, modify)-import           Control.Monad.IO.Class-import qualified System.CPUTime as CPUTime-import           Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)--import           Test.Hspec.Util (Path)-import           Test.Hspec.Compat-import           Test.Hspec.Core.Type (Progress, Location)---- | A lifted version of `Control.Monad.Trans.State.gets`-gets :: (FormatterState -> a) -> FormatM a-gets f = FormatM $ do-  f <$> (get >>= liftIO . readIORef)---- | A lifted version of `Control.Monad.Trans.State.modify`-modify :: (FormatterState -> FormatterState) -> FormatM ()-modify f = FormatM $ do-  get >>= liftIO . (`modifyIORef'` f)--data FormatterState = FormatterState {-  stateHandle     :: Handle-, stateUseColor   :: Bool-, produceHTML     :: Bool-, successCount    :: Int-, pendingCount    :: Int-, failCount       :: Int-, failMessages    :: [FailureRecord]-, stateUsedSeed   :: Integer-, cpuStartTime    :: Maybe Integer-, startTime       :: POSIXTime-}---- | The random seed that is used for QuickCheck.-usedSeed :: FormatM Integer-usedSeed = gets stateUsedSeed---- | The total number of examples encountered so far.-totalCount :: FormatterState -> Int-totalCount s = successCount s + pendingCount s + failCount s---- 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, MonadIO)--runFormatM :: Bool -> Bool -> Bool -> Integer -> Handle -> FormatM a -> IO a-runFormatM useColor produceHTML_ printCpuTime seed handle (FormatM action) = do-  time <- getPOSIXTime-  cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing-  st <- newIORef (FormatterState handle useColor produceHTML_ 0 0 0 [] seed cpuTime time)-  evalStateT action st---- | Increase the counter for successful examples-increaseSuccessCount :: FormatM ()-increaseSuccessCount = modify $ \s -> s {successCount = succ $ successCount s}---- | Increase the counter for pending examples-increasePendingCount :: FormatM ()-increasePendingCount = modify $ \s -> s {pendingCount = succ $ pendingCount s}---- | Increase the counter for failed examples-increaseFailCount :: FormatM ()-increaseFailCount = modify $ \s -> s {failCount = succ $ failCount s}---- | Get the number of successful examples encountered so far.-getSuccessCount :: FormatM Int-getSuccessCount = gets successCount---- | Get the number of pending examples encountered so far.-getPendingCount :: FormatM Int-getPendingCount = gets pendingCount---- | Get the number of failed examples encountered so far.-getFailCount :: FormatM Int-getFailCount = gets failCount---- | Get the total number of examples encountered so far.-getTotalCount :: FormatM Int-getTotalCount = gets totalCount---- | Append to the list of accumulated failure messages.-addFailMessage :: Maybe Location -> Path -> Either SomeException String -> FormatM ()-addFailMessage loc p m = modify $ \s -> s {failMessages = FailureRecord loc p m : failMessages s}---- | Get the list of accumulated failure messages.-getFailMessages :: FormatM [FailureRecord]-getFailMessages = reverse `fmap` gets failMessages--data FailureRecord = FailureRecord {-  failureRecordLocation :: Maybe Location-, failureRecordPath     :: Path-, failureRecordMessage  :: Either SomeException String-}--data Formatter = Formatter {--  headerFormatter :: FormatM ()---- | evaluated before each test group------ The given number indicates the position within the parent group.-, exampleGroupStarted :: [String] -> String -> FormatM ()--, exampleGroupDone    :: FormatM ()---- | used to notify the progress of the currently evaluated example------ /Note/: This is only called when interactive/color mode.-, exampleProgress     :: Handle -> Path -> Progress -> IO ()---- | evaluated after each successful example-, exampleSucceeded    :: Path -> FormatM ()---- | evaluated after each failed example-, exampleFailed       :: Path -> Either SomeException String -> FormatM ()---- | evaluated after each pending example-, 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 = writeLine ""-{-# DEPRECATED newParagraph "use `writeLine \"\"` instead" #-}---- | Append some output to the report.-write :: String -> FormatM ()-write s = do-  h <- gets stateHandle-  liftIO $ IO.hPutStr h s---- | The same as `write`, but adds a newline character.-writeLine :: String -> FormatM ()-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) "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) "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) "hspec-pending"---- | Set output color to cyan, run given action, and finally restore the--- default color.-withInfoColor :: FormatM a -> FormatM a-withInfoColor = withColor (SetColor Foreground Dull Cyan) "hspec-info"---- | Set a color, run an action, and finally reset colors.-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) = do-  useColor <- gets stateUseColor-  h        <- gets stateHandle--  FormatM . StateT $ \st -> do-    bracket_--      -- set color-      (when useColor $ hSetSGR h [color])--      -- reset colors-      (when useColor $ hSetSGR h [Reset])--      -- run action-      (runStateT action st)---- |--- @finally_ actionA actionB@ runs @actionA@ and then @actionB@.  @actionB@ is--- run even when a `UserInterrupt` occurs during @actionA@.-finally_ :: FormatM () -> FormatM () -> FormatM ()-finally_ (FormatM actionA) (FormatM actionB) = FormatM . StateT $ \st -> do-  r <- try (execStateT actionA st)-  case r of-    Left e -> do-      when (e == UserInterrupt) $-        runStateT actionB st >> return ()-      throwIO e-    Right st_ -> do-      runStateT actionB st_---- | Get the used CPU time since the test run has been started.-getCPUTime :: FormatM (Maybe Double)-getCPUTime = do-  t1  <- liftIO CPUTime.getCPUTime-  mt0 <- gets cpuStartTime-  return $ toSeconds <$> ((-) <$> pure t1 <*> mt0)-  where-    toSeconds x = fromIntegral x / (10.0 ^ (12 :: Integer))---- | Get the passed real time since the test run has been started.-getRealTime :: FormatM Double-getRealTime = do-  t1 <- liftIO getPOSIXTime-  t0 <- gets startTime-  return (realToFrac $ t1 - t0)

@@ -1,23 +0,0 @@-module Test.Hspec.HUnit (--- * Interoperability with HUnit-  fromHUnitTest-) where--import           Test.Hspec.Core.Type-import           Test.HUnit (Test (..))---- |--- 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 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>" e

@@ -1,178 +0,0 @@-module Test.Hspec.Options (-  Config(..)-, ColorMode (..)-, defaultConfig-, filterOr-, parseOptions-) where--import           Control.Applicative-import           Data.List-import           System.IO-import           System.Exit-import           System.Console.GetOpt--import           Test.Hspec.Formatters-import           Test.Hspec.Compat-import           Test.Hspec.Util--data Config = Config {-  configDryRun :: Bool-, configPrintCpuTime :: Bool-, configFastFail :: Bool---- |--- A predicate that is used to filter the spec before it is run.  Only examples--- that satisfy the predicate are run.-, configRerun :: Bool-, configFilterPredicate :: Maybe (Path -> Bool)-, configQuickCheckSeed :: Maybe Integer-, configQuickCheckMaxSuccess :: Maybe Int-, configQuickCheckMaxDiscardRatio :: Maybe Int-, configQuickCheckMaxSize :: Maybe Int-, configSmallCheckDepth :: Int-, configColorMode :: ColorMode-, configFormatter :: Maybe Formatter-, configHtmlOutput :: Bool-, configOutputFile :: Either Handle FilePath-}--defaultConfig :: Config-defaultConfig = Config {-  configDryRun = False-, configPrintCpuTime = False-, configFastFail = False-, configRerun = False-, configFilterPredicate = Nothing-, configQuickCheckSeed = Nothing-, configQuickCheckMaxSuccess = Nothing-, configQuickCheckMaxDiscardRatio = Nothing-, configQuickCheckMaxSize = Nothing-, configSmallCheckDepth = 5-, configColorMode = ColorAuto-, configFormatter = Nothing-, configHtmlOutput = False-, configOutputFile = Left stdout-}--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_--addMatch :: String -> Config -> Config-addMatch s c = c {configFilterPredicate = Just (filterPredicate s) `filterOr` configFilterPredicate c}--setDepth :: Int -> Config -> Config-setDepth n c = c {configSmallCheckDepth = n}--setMaxSuccess :: Int -> Config -> Config-setMaxSuccess n c = c {configQuickCheckMaxSuccess = Just n}--setMaxSize :: Int -> Config -> Config-setMaxSize n c = c {configQuickCheckMaxSize = Just n}--setMaxDiscardRatio :: Int -> Config -> Config-setMaxDiscardRatio n c = c {configQuickCheckMaxDiscardRatio = Just n}--setSeed :: Integer -> Config -> Config-setSeed n c = c {configQuickCheckSeed = Just n}--data ColorMode = ColorAuto | ColorNever | ColorAlways-  deriving (Eq, Show)--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--data Arg a = Arg {-  _argumentName   :: String-, _argumentParser :: String -> Maybe a-, _argumentSetter :: a -> Config -> Config-}--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 "o"  "out"               (Arg "FILE" return setOutputFile)   (h "write output to a file instead of STDOUT")-  , mkOption []   "depth"             (Arg "N" readMaybe setDepth)        (h "maximum depth of generated test values for SmallCheck properties")-  , mkOption "a"  "qc-max-success"    (Arg "N" readMaybe setMaxSuccess)   (h "maximum number of successful tests before a QuickCheck property succeeds")-  , mkOption ""   "qc-max-size"       (Arg "N" readMaybe setMaxSize)      (h "size to use for the biggest test cases")-  , mkOption ""   "qc-max-discard"    (Arg "N" readMaybe setMaxDiscardRatio) (h "maximum number of discarded tests per successful test before giving up")-  , 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 "rerun all examples that failed in the previously test run (only works in GHCi)")-  ]-  where-    h = unlines . addLineBreaks--    readFormatter :: String -> Maybe Formatter-    readFormatter = (`lookup` formatters)--    setFormatter :: Formatter -> Config -> Config-    setFormatter f c = c {configFormatter = Just f}--    setOutputFile :: String -> Config -> Config-    setOutputFile file c = c {configOutputFile = Right file}--    setPrintCpuTime x = x >>= \c -> return c {configPrintCpuTime = True}-    setDryRun       x = x >>= \c -> return c {configDryRun = True}-    setFastFail     x = x >>= \c -> return c {configFastFail = True}-    setRerun        x = x >>= \c -> return c {configRerun = True}-    setNoColor      x = x >>= \c -> return c {configColorMode = ColorNever}-    setColor        x = x >>= \c -> return c {configColorMode = 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 {configHtmlOutput = True}--parseOptions :: Config -> String -> [String] -> Either (ExitCode, String) Config-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")

@@ -1,5 +1,3 @@--- |--- Stability: provisional module Test.Hspec.QuickCheck ( -- * Params   modifyMaxSuccess@@ -10,9 +8,9 @@ , prop ) where -import           Test.QuickCheck import           Test.Hspec-import           Test.Hspec.Core (Params(..), modifyParams)+import           Test.QuickCheck+import           Test.Hspec.Core.QuickCheck  -- | -- > prop ".." $@@ -24,30 +22,3 @@ -- >   .. prop :: Testable prop => String -> prop -> Spec prop s = it s . property---- | Use a modified `maxSuccess` for given spec.-modifyMaxSuccess :: (Int -> Int) -> Spec -> Spec-modifyMaxSuccess = modifyArgs . modify-  where-    modify :: (Int -> Int) -> Args -> Args-    modify f args = args {maxSuccess = f (maxSuccess args)}---- | Use a modified `maxDiscardRatio` for given spec.-modifyMaxDiscardRatio :: (Int -> Int) -> Spec -> Spec-modifyMaxDiscardRatio = modifyArgs . modify-  where-    modify :: (Int -> Int) -> Args -> Args-    modify f args = args {maxDiscardRatio = f (maxDiscardRatio args)}---- | Use a modified `maxSize` for given spec.-modifyMaxSize :: (Int -> Int) -> Spec -> Spec-modifyMaxSize = modifyArgs . modify-  where-    modify :: (Int -> Int) -> Args -> Args-    modify f args = args {maxSize = f (maxSize args)}--modifyArgs :: (Args -> Args) -> Spec -> Spec-modifyArgs = modifyParams . modify-  where-    modify :: (Args -> Args) -> Params -> Params-    modify f p = p {paramsQuickCheckArgs = f (paramsQuickCheckArgs p)}

@@ -1,175 +1,2 @@--- |--- Stability: provisional-module Test.Hspec.Runner (--- * Running a spec-  hspec-, hspecWith-, hspecResult-, hspecWithResult---- * Types-, Summary (..)-, Config (..)-, ColorMode (..)-, Path-, defaultConfig-, configAddFilter-) where--import           Control.Monad-import           Control.Applicative-import           Data.Monoid-import           Data.Maybe-import           System.IO-import           System.Environment (getProgName, getArgs, withArgs)-import           System.Exit-import qualified Control.Exception as E--import           System.Console.ANSI (hHideCursor, hShowCursor)-import qualified Test.QuickCheck as QC-import           Control.Monad.IO.Class (liftIO)--import           Test.Hspec.Compat (lookupEnv)-import           Test.Hspec.Util (Path)-import           Test.Hspec.Core.Type-import           Test.Hspec.Config-import           Test.Hspec.Formatters-import           Test.Hspec.Formatters.Internal-import           Test.Hspec.FailureReport-import           Test.Hspec.Core.QuickCheckUtil--import           Test.Hspec.Runner.Tree-import           Test.Hspec.Runner.Eval---- | Filter specs by given predicate.------ The predicate takes a list of "describe" labels and a "requirement".-filterSpecs :: Config -> [Tree Item] -> [Tree Item]-filterSpecs c = go []-  where-    p :: Path -> Bool-    p = fromMaybe (const True) (configFilterPredicate c)--    go :: [String] -> [Tree Item] -> [Tree Item]-    go groups = mapMaybe (goSpec groups)--    goSpecs :: [String] -> [Tree Item] -> ([Tree Item] -> a) -> Maybe a-    goSpecs groups specs ctor = case go groups specs of-      [] -> Nothing-      xs -> Just (ctor xs)--    goSpec :: [String] -> Tree Item -> Maybe (Tree Item)-    goSpec groups spec = case spec of-      Leaf item -> guard (p (groups, itemRequirement item)) >> return spec-      Node group specs -> goSpecs (groups ++ [group]) specs (Node group)-      NodeWithCleanup action specs -> goSpecs groups specs (NodeWithCleanup action)--applyDryRun :: Config -> [Tree Item] -> [Tree Item]-applyDryRun c-  | configDryRun c = map (removeCleanup . fmap markSuccess)-  | otherwise = id-  where-    markSuccess :: Item -> Item-    markSuccess item = item {itemExample = evaluateExample Success}--    removeCleanup :: Tree Item -> Tree Item-    removeCleanup spec = case spec of-      Node x xs -> Node x (map removeCleanup xs)-      NodeWithCleanup _ xs -> NodeWithCleanup (return ()) (map removeCleanup xs)-      leaf@(Leaf _) -> leaf---- | Run given spec and write a report to `stdout`.--- Exit with `exitFailure` if at least one spec item fails.-hspec :: Spec -> IO ()-hspec = hspecWith defaultConfig---- Add a seed to given config if there is none.  That way the same seed is used--- for all properties.  This helps with --seed and --rerun.-ensureSeed :: Config -> IO Config-ensureSeed c = case configQuickCheckSeed c of-  Nothing -> do-    seed <- newSeed-    return c {configQuickCheckSeed = Just (fromIntegral seed)}-  _       -> return c---- | Run given spec with custom options.--- This is similar to `hspec`, but more flexible.-hspecWith :: Config -> Spec -> IO ()-hspecWith conf spec = do-  r <- hspecWithResult conf spec-  unless (summaryFailures r == 0) exitFailure---- | Run given spec and returns a summary of the test run.------ /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 = hspecWithResult defaultConfig---- | Run given spec with custom options and returns a summary of the test run.------ /Note/: `hspecWithResult` does not exit with `exitFailure` on failing spec--- items.  If you need this, you have to check the `Summary` yourself and act--- accordingly.-hspecWithResult :: Config -> Spec -> IO Summary-hspecWithResult conf spec = do-  prog <- getProgName-  args <- getArgs-  c <- getConfig conf prog args >>= ensureSeed-  withArgs [] {- do not leak command-line arguments to examples -} $ withHandle c $ \h -> do-    let formatter = fromMaybe specdoc (configFormatter c)-        seed = (fromJust . configQuickCheckSeed) c-        qcArgs = configQuickCheckArgs c--    useColor <- doesUseColor h c--    filteredSpec <- filterSpecs c . applyDryRun c <$> toTree spec--    withHiddenCursor useColor h $-      runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do-        runFormatter useColor h c formatter filteredSpec `finally_` do-          failedFormatter formatter--        footerFormatter formatter--        -- dump failure report-        xs <- map failureRecordPath <$> getFailMessages-        liftIO $ writeFailureReport FailureReport {-            failureReportSeed = seed-          , failureReportMaxSuccess = QC.maxSuccess qcArgs-          , failureReportMaxSize = QC.maxSize qcArgs-          , failureReportMaxDiscardRatio = QC.maxDiscardRatio qcArgs-          , failureReportPaths = xs-          }--        Summary <$> getTotalCount <*> getFailCount-  where-    withHiddenCursor :: Bool -> Handle -> IO a -> IO a-    withHiddenCursor useColor h-      | useColor  = E.bracket_ (hHideCursor h) (hShowCursor h)-      | otherwise = id--    doesUseColor :: Handle -> Config -> IO Bool-    doesUseColor h c = case configColorMode c of-      ColorAuto  -> (&&) <$> hIsTerminalDevice h <*> (not <$> isDumb)-      ColorNever -> return False-      ColorAlways -> return True--    withHandle :: Config -> (Handle -> IO a) -> IO a-    withHandle c action = case configOutputFile c of-      Left h -> action h-      Right path -> withFile path WriteMode action--isDumb :: IO Bool-isDumb = maybe False (== "dumb") <$> lookupEnv "TERM"---- | Summary of a test run.-data Summary = Summary {-  summaryExamples :: Int-, summaryFailures :: Int-} deriving (Eq, Show)--instance Monoid Summary where-  mempty = Summary 0 0-  (Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2)+module Test.Hspec.Runner (module Test.Hspec.Core.Runner) where+import           Test.Hspec.Core.Runner

@@ -1,152 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-module Test.Hspec.Runner.Eval (runFormatter) where--import           Control.Applicative-import           Control.Monad-import qualified Control.Exception as E-import           Control.Concurrent-import           System.IO (Handle)--import           Control.Monad.IO.Class (liftIO)--import           Test.Hspec.Util-import           Test.Hspec.Runner.Tree-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--type EvalTree = Tree (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))---- | Evaluate all examples of a given spec and produce a report.-runFormatter :: Bool -> Handle -> Config -> Formatter -> [Tree Item] -> FormatM ()-runFormatter useColor h c formatter specs = do-  headerFormatter formatter-  chan <- liftIO newChan-  reportProgress <- liftIO mkReportProgress-  run chan reportProgress c formatter (toEvalTree specs)-  where-    mkReportProgress :: IO (Path -> Progress -> IO ())-    mkReportProgress-      | useColor = every 0.05 $ exampleProgress formatter h-      | otherwise = return $ \_ _ -> return ()--    toEvalTree :: [Tree Item] -> [EvalTree]-    toEvalTree = map (fmap f)-      where-        f :: Item -> (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))-        f (Item requirement loc isParallelizable e) = (requirement, loc, parallelize isParallelizable $ e params id)--    params :: Params-    params = Params (configQuickCheckArgs c) (configSmallCheckDepth c)---- | Execute given action at most every specified number of seconds.-every :: POSIXTime -> (a -> b -> IO ()) -> IO (a -> b -> IO ())-every seconds action = do-  timer <- newTimer seconds-  return $ \a b -> do-    r <- timer-    when r (action a b)--type FormatResult = Either E.SomeException Result -> FormatM ()--parallelize :: Bool -> (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())-parallelize isParallelizable e-  | isParallelizable = runParallel e-  | otherwise = runSequentially e--runSequentially :: (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())-runSequentially e reportProgress formatResult = return $ do-  result <- liftIO $ evalExample (e reportProgress)-  formatResult result--data Report = ReportProgress Progress | ReportResult (Either E.SomeException Result)--runParallel :: (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())-runParallel e reportProgress formatResult = do-  mvar <- newEmptyMVar-  _ <- forkIO $ do-    let progressCallback = replaceMVar mvar . ReportProgress-    result <- evalExample (e progressCallback)-    replaceMVar mvar (ReportResult result)-  return $ 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 result--    replaceMVar :: MVar a -> a -> IO ()-    replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p--evalExample :: IO Result -> IO (Either E.SomeException Result)-evalExample e = safeTry $ forceResult <$> e--data Message = Done | Run (FormatM ())--run :: Chan Message -> (Path -> ProgressCallback) -> Config -> Formatter -> [EvalTree] -> FormatM ()-run chan reportProgress_ c formatter specs = do-  liftIO $ do-    forM_ specs (queueSpec [])-    writeChan chan Done-  processMessages (readChan chan) (configFastFail c)-  where-    defer :: FormatM () -> IO ()-    defer = writeChan chan . Run--    runCleanup :: IO () -> Path -> FormatM ()-    runCleanup action path = do-      r <- liftIO $ safeTry action-      either (failed Nothing path . Left) return r--    queueSpec :: [String] -> EvalTree -> IO ()-    queueSpec rGroups (Node group xs) = do-      defer (exampleGroupStarted formatter (reverse rGroups) group)-      forM_ xs (queueSpec (group : rGroups))-      defer (exampleGroupDone formatter)-    queueSpec rGroups (NodeWithCleanup action xs) = do-      forM_ xs (queueSpec rGroups)-      defer (runCleanup action (reverse rGroups, "afterAll-hook"))-    queueSpec rGroups (Leaf e) =-      queueExample (reverse rGroups) e--    queueExample :: [String] -> (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ())) -> IO ()-    queueExample groups (requirement, loc, e) = e reportProgress formatResult >>= defer-      where-        path :: Path-        path = (groups, requirement)--        reportProgress = reportProgress_ path--        formatResult :: Either E.SomeException Result -> FormatM ()-        formatResult 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 loc path (Right err)-            Left err         -> failed loc path (Left  err)--    failed loc path err = do-      increaseFailCount-      addFailMessage loc path err-      exampleFailed formatter path err--processMessages :: IO Message -> Bool -> FormatM ()-processMessages getMessage fastFail = go-  where-    go = liftIO getMessage >>= \m -> case m of-      Run action -> do-        action-        fails <- getFailCount-        unless (fastFail && fails /= 0) go-      Done -> return ()

@@ -1,50 +0,0 @@-{-# LANGUAGE CPP, DeriveFunctor #-}-module Test.Hspec.Runner.Tree where--import           Control.Applicative-import           Data.Foldable-import           Data.Traversable-import           Test.Hspec.Core.Type-import           Data.Monoid--data Tree a-  = Node !String [Tree a]-  | NodeWithCleanup (IO ()) [Tree a]-  | Leaf a-  deriving Functor--instance Foldable Tree where -- Note: GHC 7.0.1 fails to derive this instance-  foldMap = go-    where-      go :: Monoid m => (a -> m) -> Tree a -> m-      go f t = case t of-        Node _ xs -> foldMap (foldMap f) xs-        NodeWithCleanup _ xs -> foldMap (foldMap f) xs-        Leaf x -> f x--instance Traversable Tree where -- Note: GHC 7.0.1 fails to derive this instance-  sequenceA = go-    where-      go :: Applicative f => Tree (f a) -> f (Tree a)-      go t = case t of-        Node label xs -> Node label <$> sequenceA (map go xs)-        NodeWithCleanup action xs -> NodeWithCleanup action <$> sequenceA (map go xs)-        Leaf a -> Leaf <$> a--toTree :: Spec -> IO [Tree Item]-toTree spec = map f <$> runSpecM spec-  where-    f :: SpecTree -> Tree Item-    f x = case x of-      SpecGroup label xs -> Node label (map f xs)-      SpecWithCleanup cleanup xs -> NodeWithCleanup cleanup (map f xs)-      SpecItem item -> Leaf item--fromTree :: [Tree Item] -> Spec-fromTree = fromSpecList . map go-  where-    go :: Tree Item -> SpecTree-    go x = case x of-      Node label xs -> SpecGroup label (map go xs)-      NodeWithCleanup action xs -> SpecWithCleanup action (map go xs)-      Leaf item -> SpecItem item

@@ -1,14 +0,0 @@-module Test.Hspec.Timer where--import           Data.IORef-import           Data.Time.Clock.POSIX--newTimer :: POSIXTime -> IO (IO Bool)-newTimer delay = do-  ref <- getPOSIXTime >>= newIORef-  return $ do-    t0 <- readIORef ref-    t1 <- getPOSIXTime-    if delay < t1 - t0-      then writeIORef ref t1 >> return True-      else return False

@@ -1,109 +0,0 @@-module Test.Hspec.Util (-  pluralize-, formatException-, lineBreaksAt-, safeTry-, Path-, filterPredicate-, formatRequirement-, strip-) where--import           Data.List-import           Data.Char (isSpace)-import           GHC.IO.Exception-import qualified Control.Exception as E-import           Control.Concurrent.Async--import           Test.Hspec.Compat (showType)--pluralize :: Int -> String -> String-pluralize 1 s = "1 " ++ s-pluralize n s = show n ++ " " ++ s ++ "s"---- | Convert an exception to a string.------ This is different from `show`.  The type of the exception is included, e.g.--- `E.ArithException` is turned into:------ @--- "ArithException (divide by zero)"--- @------ For `IOException`s the `IOErrorType` is included.-formatException :: E.SomeException -> String-formatException err@(E.SomeException e) = case E.fromException err of-  Just ioe -> showType ioe ++ " of type " ++ showIOErrorType ioe ++ " (" ++ show ioe ++ ")"-  Nothing  -> showType e ++ " (" ++ show e ++ ")"-  where-    showIOErrorType :: IOException -> String-    showIOErrorType ioe = case ioe_type ioe of-      AlreadyExists -> "AlreadyExists"-      NoSuchThing -> "NoSuchThing"-      ResourceBusy -> "ResourceBusy"-      ResourceExhausted -> "ResourceExhausted"-      EOF -> "EOF"-      IllegalOperation -> "IllegalOperation"-      PermissionDenied -> "PermissionDenied"-      UserError -> "UserError"-      UnsatisfiedConstraints -> "UnsatisfiedConstraints"-      SystemError -> "SystemError"-      ProtocolError -> "ProtocolError"-      OtherError -> "OtherError"-      InvalidArgument -> "InvalidArgument"-      InappropriateType -> "InappropriateType"-      HardwareFault -> "HardwareFault"-      UnsupportedOperation -> "UnsupportedOperation"-      TimeExpired -> "TimeExpired"-      ResourceVanished -> "ResourceVanished"-      Interrupted -> "Interrupted"--safeTry :: IO a -> IO (Either E.SomeException a)-safeTry action = withAsync (action >>= E.evaluate) waitCatch---- |--- 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---- ensure that lines are not longer then given `n`, insert line breaks at word--- boundaries-lineBreaksAt :: Int -> String -> [String]-lineBreaksAt n input = case words input of-  []   -> []-  x:xs -> go (x, xs)-  where-    go :: (String, [String]) -> [String]-    go c = case c of-      (s, [])   -> [s]-      (s, y:ys) -> let r = s ++ " " ++ y in-        if length r <= n-          then go (r, ys)-          else s : go (y, ys)--strip :: String -> String-strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse

@@ -1,102 +1,17 @@ module Helper (   module Test.Hspec.Meta-, module Test.QuickCheck-, module Control.Applicative-, module System.IO.Silently-, sleep-, timeout-, defaultParams-, noOpProgressCallback-, captureLines-, normalizeSummary--, ignoreExitCode-, ignoreUserInterrupt-, throwException--, shouldStartWith-, shouldEndWith--, shouldUseArgs- , withFileContent ) where -import           Data.List-import           Data.Char-import           Data.IORef-import           Control.Monad-import           Control.Applicative-import           System.Environment (withArgs)-import           System.Exit-import           Control.Concurrent-import qualified Control.Exception as E-import qualified System.Timeout as System-import           System.IO+import           Control.Exception (finally) import           System.Directory-import           Data.Time.Clock.POSIX-import           System.IO.Silently-+import           System.IO import           Test.Hspec.Meta-import           Test.QuickCheck hiding (Result(..)) -import qualified Test.Hspec as H-import qualified Test.Hspec.Core as H (Params(..), Item(..), ProgressCallback, mapSpecItem)-import qualified Test.Hspec.Runner as H-import           Test.Hspec.Core.QuickCheckUtil (mkGen)--throwException :: IO ()-throwException = E.throwIO (E.ErrorCall "foobar")--ignoreExitCode :: IO () -> IO ()-ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return ()--ignoreUserInterrupt :: IO () -> IO ()-ignoreUserInterrupt action = E.catchJust (guard . (== E.UserInterrupt)) action return--captureLines :: IO a -> IO [String]-captureLines = fmap lines . capture_--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 = map f-  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 stdArgs {replay = Just (mkGen 23, 0), maxSuccess = 1000} (H.configSmallCheckDepth H.defaultConfig)--noOpProgressCallback :: H.ProgressCallback-noOpProgressCallback _ = return ()--sleep :: POSIXTime -> IO ()-sleep = threadDelay . floor . (* 1000000)--timeout :: POSIXTime -> IO a -> IO (Maybe a)-timeout = System.timeout . floor . (* 1000000)--shouldUseArgs :: [String] -> (Args -> Bool) -> Expectation-shouldUseArgs args p = do-  spy <- newIORef (H.paramsQuickCheckArgs defaultParams)-  let interceptArgs item = item {H.itemExample = \params action progressCallback -> writeIORef spy (H.paramsQuickCheckArgs params) >> H.itemExample item params action progressCallback}-      spec = H.mapSpecItem interceptArgs $-        H.it "foo" False-  (silence . ignoreExitCode . withArgs args . H.hspec) spec-  readIORef spy >>= (`shouldSatisfy` p)- withFileContent :: String -> (FilePath -> IO a) -> IO a withFileContent input action = do   dir <- getTemporaryDirectory   (file, h) <- openTempFile dir "temp"   hPutStr h input   hClose h-  action file `E.finally` removeFile file+  action file `finally` removeFile file

@@ -1,15 +0,0 @@-module Mock where--import           Control.Applicative-import           Data.IORef--newtype Mock = Mock (IORef Int)--newMock :: IO Mock-newMock = Mock <$> newIORef 0--mockAction :: Mock -> IO ()-mockAction (Mock ref) = modifyIORef ref succ--mockCounter  :: Mock -> IO Int-mockCounter  (Mock ref) = readIORef ref

@@ -1,33 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module Test.Hspec.CompatSpec (main, spec) where--import           Helper-import           System.SetEnv--import           Test.Hspec.Compat-import           Data.Typeable--data SomeType = SomeType-  deriving Typeable--main :: IO ()-main = hspec spec--spec :: Spec-spec = do-  describe "showType" $ do-    it "shows unqualified name of type" $ do-      showType SomeType `shouldBe` "SomeType"--  describe "showFullType (currently unused)" $ do-    it "shows fully qualified name of type" $ do-      showFullType SomeType `shouldBe` "Test.Hspec.CompatSpec.SomeType"--  describe "lookupEnv" $ do-    it "returns value of specified environment variable" $ do-      setEnv "FOO" "bar"-      lookupEnv "FOO" `shouldReturn` Just "bar"--    it "returns Nothing if specified environment variable is not set" $ do-      unsetEnv "FOO"-      lookupEnv "FOO" `shouldReturn` Nothing

@@ -1,31 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}-module Test.Hspec.Core.QuickCheckUtilSpec (main, spec) where--import           Helper--import           Test.QuickCheck-import           Test.Hspec.Core.QuickCheckUtil--main :: IO ()-main = hspec spec--spec :: Spec-spec = do-  describe "formatNumbers" $ do-    it "includes number of tests" $ do-      formatNumbers (failure 1 0) `shouldBe` "(after 1 test)"--    it "pluralizes number of tests" $ do-      formatNumbers (failure 3 0) `shouldBe` "(after 3 tests)"--    it "includes number of shrinks" $ do-      formatNumbers (failure 3 1) `shouldBe` "(after 3 tests and 1 shrink)"--    it "pluralizes number of shrinks" $ do-      formatNumbers (failure 3 3) `shouldBe` "(after 3 tests and 3 shrinks)"-  where-    failure tests shrinks = Failure {-      numTests = tests-    , numShrinks = shrinks-    }

@@ -1,136 +0,0 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}-module Test.Hspec.Core.TypeSpec (main, spec) where--import           Helper-import           Mock-import           Data.List-import           Data.IORef--import qualified Test.Hspec.Core.Type as H-import qualified Test.Hspec as H-import qualified Test.Hspec.Runner as H--main :: IO ()-main = hspec spec--evaluateExample :: H.Example e => e -> IO H.Result-evaluateExample e = H.evaluateExample e defaultParams id noOpProgressCallback--evaluateExampleWith :: H.Example e => (IO () -> IO ()) -> e -> IO H.Result-evaluateExampleWith action e = H.evaluateExample e defaultParams action noOpProgressCallback--spec :: Spec-spec = do-  describe "evaluateExample" $ do-    context "for Bool" $ do-      it "returns Success on True" $ do-        evaluateExample True `shouldReturn` H.Success--      it "returns Fail on False" $ do-        evaluateExample False `shouldReturn` H.Fail ""--      it "propagates exceptions" $ do-        evaluateExample (error "foobar" :: Bool) `shouldThrow` errorCall "foobar"--    context "for Expectation" $ do-      it "returns Success if all expectations hold" $ do-        evaluateExample (23 `shouldBe` (23 :: Int)) `shouldReturn` H.Success--      it "returns Fail if an expectation does not hold" $ do-        evaluateExample (23 `shouldBe` (42 :: Int)) `shouldReturn` H.Fail "expected: 42\n but got: 23"--      it "propagates exceptions" $ do-        evaluateExample (error "foobar" :: Expectation) `shouldThrow` errorCall "foobar"--      it "runs provided action around expectation" $ do-        ref <- newIORef (0 :: Int)-        let action :: IO () -> IO ()-            action e = do-              n <- readIORef ref-              e-              readIORef ref `shouldReturn` succ n-              modifyIORef ref succ-        evaluateExampleWith action (modifyIORef ref succ) `shouldReturn` H.Success-        readIORef ref `shouldReturn` 2--      context "when used with `pending`" $ do-        it "returns Pending" $ do-          evaluateExample (H.pending) `shouldReturn` H.Pending Nothing--      context "when used with `pendingWith`" $ do-        it "includes the optional reason" $ do-          evaluateExample (H.pendingWith "foo") `shouldReturn` H.Pending (Just "foo")--    context "for Property" $ do-      it "returns Success if property holds" $ do-        evaluateExample (property $ \n -> n == (n :: Int)) `shouldReturn` H.Success--      it "returns Fail if property does not hold" $ do-        H.Fail _ <- evaluateExample $ property $ \n -> n /= (n :: Int)-        return ()--      it "shows what falsified it" $ do-        H.Fail r <- evaluateExample $ property $ \ (x :: Int) (y :: Int) -> (x == 0 && y == 1) ==> False-        r `shouldBe` intercalate "\n"  [-            "Falsifiable (after 1 test): "-          , "0"-          , "1"-          ]--      it "runs provided action around each single check of the property" $ do-        ref <- newIORef (0 :: Int)-        let action :: IO () -> IO ()-            action e = do-              n <- readIORef ref-              e-              readIORef ref `shouldReturn` succ n-              modifyIORef ref succ-        H.Success <- evaluateExampleWith action (property $ modifyIORef ref succ)-        readIORef ref `shouldReturn` 2000--      it "pretty-prints exceptions" $ do-        H.Fail r <- evaluateExample $ property (\ (x :: Int) -> (x == 0) ==> (error "foobar" :: Bool))-        r `shouldBe` intercalate "\n" [-#if MIN_VERSION_QuickCheck(2,7,0)-            "uncaught exception: ErrorCall (foobar) (after 1 test)"-#else-            "Exception: 'foobar' (after 1 test): "-#endif-          , "0"-          ]--      context "when used with shouldBe" $ do-        it "shows what falsified it" $ do-          H.Fail r <- evaluateExample $ property $ \ (x :: Int) (y :: Int) -> (x == 0 && y == 1) ==> 23 `shouldBe` (42 :: Int)-          r `shouldBe` intercalate "\n" [-              "Falsifiable (after 1 test): "-            , "expected: 42"-            , " but got: 23"-            , "0"-            , "1"-            ]--      context "when used with `pending`" $ do-        it "returns Pending" $ do-          evaluateExample (property H.pending) `shouldReturn` H.Pending Nothing--      context "when used with `pendingWith`" $ do-        it "includes the optional reason" $ do-          evaluateExample (property $ H.pendingWith "foo") `shouldReturn` H.Pending (Just "foo")--  describe "Expectation" $ do-    context "as a QuickCheck property" $ do-      it "can be quantified" $ do-        e <- newMock-        silence . H.hspec $ do-          H.it "some behavior" $ property $ \xs -> do-            mockAction e-            (reverse . reverse) xs `shouldBe` (xs :: [Int])-        mockCounter e `shouldReturn` 100--      it "can be used with expectations/HUnit assertions" $ do-        silence . H.hspecResult $ do-          H.describe "readIO" $ do-            H.it "is inverse to show" $ property $ \x -> do-              (readIO . show) x `shouldReturn` (x :: Int)-        `shouldReturn` H.Summary 1 0

@@ -6,14 +6,13 @@ import           Data.String import           Data.String.Builder -import qualified Test.Hspec as H (it)-import           Test.Hspec.Core (Item(..), Location(..), LocationAccuracy(..))-import           Test.Hspec.Runner.Tree+import qualified Test.Hspec.Core.Spec as H+import           Test.Hspec.Core (Tree(..), Item(..), Location(..), LocationAccuracy(..), runSpecM) import qualified Test.Hspec.Discover as H  infix 1 `shouldHaveLocation` -shouldHaveLocation :: Item -> (String, Int) -> Expectation+shouldHaveLocation :: Item a -> (String, Int) -> Expectation item `shouldHaveLocation` (src, line) = itemLocation item `shouldBe` Just (Location src line 0 BestEffort)  main :: IO ()@@ -31,7 +30,7 @@             ""             strlit "baz"       withFileContent c $ \src -> do-        [Leaf item1, Leaf item2, Leaf item3] <- toTree . H.postProcessSpec src $ do+        [Leaf item1, Leaf item2, Leaf item3] <- runSpecM . H.postProcessSpec src $ do           H.it "foo" True           H.it "bar" True           H.it "baz" True@@ -46,7 +45,7 @@               strlit "foo"               strlit "foo"         withFileContent c $ \src -> do-          [Leaf item1, Leaf item2, Leaf item3] <- toTree . H.postProcessSpec src $ do+          [Leaf item1, Leaf item2, Leaf item3] <- runSpecM . H.postProcessSpec src $ do             H.it "foo" True             H.it "foo" True             H.it "foo" True@@ -60,7 +59,7 @@                 strlit "foo"                 strlit "foo"           withFileContent c $ \src -> do-            [Leaf item1, Leaf item2, Leaf item3] <- toTree . H.postProcessSpec src $ do+            [Leaf item1, Leaf item2, Leaf item3] <- runSpecM . H.postProcessSpec src $ do               H.it "foo" True               H.it "foo" True               H.it "foo" True

@@ -1,39 +0,0 @@-module Test.Hspec.FailureReportSpec (main, spec) where--import           Helper--import           System.IO-import           Test.Hspec.FailureReport-import           GHC.Paths (ghc)-import           System.Process-import           System.Exit--main :: IO ()-main = hspec spec--spec :: Spec-spec = do-  describe "writeFailureReport" $ do-    it "prints a warning on unexpected exceptions" $ do-      r <- hCapture_ [stderr] $ writeFailureReport (error "some error")-      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 --rerun would not be very useful.  So we add a-  -- test for that.-  describe "GHCi" $ do-    it "keeps environment variables on :reload" $ do-      let flags = ["-v0", "--interactive", "-ignore-dot-ghci"]-      (Just hIn, Just hOut, Nothing, processHandle) <- createProcess $ (proc ghc flags) {-          std_in = CreatePipe-        , std_out = CreatePipe-        }-      hPutStrLn hIn "import System.SetEnv"-      hPutStrLn hIn "setEnv \"FOO\" \"bar\""-      hPutStrLn hIn ":reload"-      hPutStrLn hIn "import System.Environment"-      hPutStrLn hIn "getEnv \"FOO\""-      hClose hIn-      r <- hGetContents hOut-      length r `seq` r `shouldBe` "\"bar\"\n"-      waitForProcess processHandle `shouldReturn` ExitSuccess

@@ -1,228 +0,0 @@-{-# LANGUAGE CPP #-}-module Test.Hspec.FormattersSpec (main, spec) where--import           Helper--import qualified Test.Hspec as H-import qualified Test.Hspec.Core as H (Result(..), Location(..), LocationAccuracy(..), Item(..), mapSpecItem)-import qualified Test.Hspec.Runner as H-import qualified Test.Hspec.Formatters as H--#ifndef mingw32_HOST_OS-import           System.Console.ANSI-#endif--main :: IO ()-main = hspec spec--testSpec :: H.Spec-testSpec = do-  H.describe "Example" $ do-    H.it "success"    (H.Success)-    H.it "fail 1"     (H.Fail "fail message")-    H.it "pending"    (H.pendingWith "pending message")-    H.it "fail 2"     (H.Fail "")-    H.it "exceptions" (undefined :: H.Result)-    H.it "fail 3"     (H.Fail "")--spec :: Spec-spec = do-  describe "silent" $ do-    let runSpec = fmap fst . capture . H.hspecWithResult H.defaultConfig {H.configFormatter = Just H.silent}-    it "produces no output" $ do-      runSpec testSpec `shouldReturn` ""--  describe "failed_examples" $ do-    failed_examplesSpec H.failed_examples--  describe "progress" $ do-    let runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormatter = Just H.progress}--    it "produces '..F...FF.F' style output" $ do-      r <- runSpec testSpec-      head r `shouldBe` ".F.FFF"--    context "same as failed_examples" $ do-      failed_examplesSpec H.progress--  describe "specdoc" $ do-    let runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormatter = Just H.specdoc}--    it "displays a header for each thing being described" $ do-      _:x:_ <- runSpec testSpec-      x `shouldBe` "Example"--    it "displays one row for each behavior" $ do-      r <- runSpec $ do-        H.describe "List as a Monoid" $ do-          H.describe "mappend" $ do-            H.it "is associative" True-          H.describe "mempty" $ do-            H.it "is a left identity" True-            H.it "is a right identity" True-        H.describe "Maybe as a Monoid" $ do-          H.describe "mappend" $ do-            H.it "is associative" True-          H.describe "mempty" $ do-            H.it "is a left identity" True-            H.it "is a right identity" True-      normalizeSummary r `shouldBe` [-          ""-        , "List as a Monoid"-        , "  mappend"-        , "    - is associative"-        , "  mempty"-        , "    - is a left identity"-        , "    - is a right identity"-        , "Maybe as a Monoid"-        , "  mappend"-        , "    - is associative"-        , "  mempty"-        , "    - is a left identity"-        , "    - is a right identity"-        , ""-        , "Finished in 0.0000 seconds"-        , "6 examples, 0 failures"-        ]--    it "outputs an empty line at the beginning (even for non-nested specs)" $ do-      r <- runSpec $ do-        H.it "example 1" True-        H.it "example 2" True-      normalizeSummary r `shouldBe` [-          ""-        , "- example 1"-        , "- example 2"-        , ""-        , "Finished in 0.0000 seconds"-        , "2 examples, 0 failures"-        ]--    it "displays a row for each successfull, failed, or pending example" $ do-      r <- runSpec testSpec-      r `shouldSatisfy` any (== "  - fail 1 FAILED [1]")-      r `shouldSatisfy` any (== "  - success")--    it "displays a '#' with an additional message for pending examples" $ do-      r <- runSpec testSpec-      r `shouldSatisfy` any (== "     # PENDING: pending message")--    context "with an empty group" $ do-      it "omits that group from the report" $ do-        r <- runSpec $ do-          H.describe "foo" $ do-            H.it "example 1" True-          H.describe "bar" $ do-            return ()-          H.describe "baz" $ do-            H.it "example 2" True--        normalizeSummary r `shouldBe` [-            ""-          , "foo"-          , "  - example 1"-          , "baz"-          , "  - example 2"-          , ""-          , "Finished in 0.0000 seconds"-          , "2 examples, 0 failures"-          ]--    context "same as failed_examples" $ do-      failed_examplesSpec H.progress--failed_examplesSpec :: H.Formatter -> Spec-failed_examplesSpec formatter = do-  let runSpec = captureLines . H.hspecWithResult H.defaultConfig {H.configFormatter = Just formatter}--  it "summarizes the time it takes to finish" $ do-    r <- runSpec (return ())-    normalizeSummary r `shouldSatisfy` any (== "Finished in 0.0000 seconds")--  context "displays a detailed list of failures" $ do-    it "prints all requirements that are not met" $ do-      r <- runSpec testSpec-      r `shouldSatisfy` any (== "1) Example fail 1")--    it "prints the exception type for requirements that fail due to an uncaught exception" $ do-      r <- runSpec $ do-        H.it "foobar" (undefined :: Bool)-      r `shouldContain` [-          "1) foobar"-        , "uncaught exception: ErrorCall (Prelude.undefined)"-        ]--    it "prints all descriptions when a nested requirement fails" $ do-      r <- runSpec $-        H.describe "foo" $ do-          H.describe "bar" $ do-            H.it "baz" False-      r `shouldSatisfy` any (== "1) foo.bar baz")---    context "when a failed example has a source location" $ do-      let bestEffortExplanation = "Source locations marked with \"best-effort\" are calculated heuristically and may be incorrect."--      context "when source location is exact" $ do-        it "includes that source locations" $ do-          let loc = H.Location "test/FooSpec.hs" 23 0 H.ExactLocation-              addLoc e = e {H.itemLocation = Just loc}-          r <- runSpec $ H.mapSpecItem addLoc $ do-            H.it "foo" False-          r `shouldSatisfy` any (== "# test/FooSpec.hs:23")--        it "does not include 'best-effort' explanation" $ do-          let loc = H.Location "test/FooSpec.hs" 23 0 H.ExactLocation-              addLoc e = e {H.itemLocation = Just loc}-          r <- runSpec $ H.mapSpecItem addLoc $ do-            H.it "foo" False-          r `shouldSatisfy` all (/= bestEffortExplanation)--      context "when source location is best-effort" $ do-        it "marks that source location as 'best-effort'" $ do-          let loc = H.Location "test/FooSpec.hs" 23 0 H.BestEffort-              addLoc e = e {H.itemLocation = Just loc}-          r <- runSpec $ H.mapSpecItem addLoc $ do-            H.it "foo" False-          r `shouldSatisfy` any (== "# test/FooSpec.hs:23 (best-effort)")--        it "includes 'best-effort' explanation" $ do-          let loc = H.Location "test/FooSpec.hs" 23 0 H.BestEffort-              addLoc e = e {H.itemLocation = Just loc}-          r <- runSpec $ H.mapSpecItem addLoc $ do-            H.it "foo" False-          r `shouldSatisfy` any (== bestEffortExplanation)--  it "summarizes the number of examples and failures" $ do-    r <- runSpec testSpec-    r `shouldSatisfy` any (== "6 examples, 4 failures, 1 pending")--  -- Windows has no support for ANSI escape codes.  The Console API is used for-  -- 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.hspecWithResult 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.hspecWithResult 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.hspecWithResult 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.hspecWithResult 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))-  where-    green  = setSGRCode [SetColor Foreground Dull Green]-    yellow = setSGRCode [SetColor Foreground Dull Yellow]-    red    = setSGRCode [SetColor Foreground Dull Red]-    reset  = setSGRCode [Reset]-#endif

@@ -1,45 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Test.Hspec.HUnitSpec (main, spec) where--import           Helper hiding (example)--import           Test.Hspec.Core (Item(..))-import           Test.Hspec.Runner.Tree-import           Test.Hspec.HUnit-import           Test.HUnit--main :: IO ()-main = hspec spec--shouldYield :: Test -> [Tree String] -> Expectation-a `shouldYield` b = map (Blind . fmap itemRequirement) <$> toTree (fromHUnitTest a) `shouldReturn` map Blind b--instance Eq a => Eq (Tree a) where-  x == y = case (x, y) of-    (Node s1 xs, Node s2 ys) -> s1 == s2 && xs == ys-    (Leaf x1, Leaf x2) -> x1 == x2-    _ -> False--spec :: Spec-spec = do-  describe "fromHUnitTest" $ do-    let e = TestCase $ pure ()--    it "works for a TestCase" $ do-      e `shouldYield` [Leaf "<unlabeled>"]--    it "works for a labeled TestCase" $ do-      TestLabel "foo" e-        `shouldYield` [Leaf "foo"]--    it "works for a TestCase with nested labels" $ do-      (TestLabel "foo" . TestLabel "bar") e-        `shouldYield` [Node "foo" [Leaf "bar"]]--    it "works for a flat TestList" $ do-      TestList [e, e, e]-        `shouldYield` [Leaf "<unlabeled>", Leaf "<unlabeled>", Leaf "<unlabeled>"]--    it "works for a nested TestList" $ do-      (TestLabel "foo" . TestLabel "bar" . TestList) [TestLabel "one" e, TestLabel "two" e, TestLabel "three" e]-        `shouldYield` [Node "foo" [Node "bar" [Leaf "one", Leaf "two", Leaf "three"]]]

@@ -1,44 +0,0 @@-module Test.Hspec.OptionsSpec (main, spec) where--import           Helper-import           System.Exit--import           Test.Hspec.Options hiding (parseOptions)-import qualified Test.Hspec.Options as Options--main :: IO ()-main = hspec spec--fromLeft :: Either a b -> a-fromLeft (Left a) = a-fromLeft _ = error "fromLeft: No left value!"--spec :: Spec-spec = do-  describe "parseOptions" $ do--    let parseOptions = Options.parseOptions defaultConfig "my-spec"--    it "sets configColorMode to ColorAuto" $ do-      configColorMode <$> parseOptions [] `shouldBe` Right ColorAuto--    context "with --no-color" $ do-      it "sets configColorMode to ColorNever" $ do-        configColorMode <$> parseOptions ["--no-color"] `shouldBe` Right ColorNever--    context "with --color" $ do-      it "sets configColorMode to ColorAlways" $ do-        configColorMode <$> parseOptions ["--color"] `shouldBe` Right ColorAlways--    context "with --out" $ do-      it "sets configOutputFile" $ do-        either (const Nothing) Just . configOutputFile <$> parseOptions ["--out", "foo"] `shouldBe` Right (Just "foo")--    context "with --qc-max-success" $ do-      context "when given an invalid argument" $ do-        it "returns an error message" $ do-          fromLeft (parseOptions ["--qc-max-success", "foo"]) `shouldBe` (ExitFailure 1, "my-spec: invalid argument `foo' for `--qc-max-success'\nTry `my-spec --help' for more information.\n")--    context "with --depth" $ do-      it "sets depth parameter for SmallCheck" $ do-        configSmallCheckDepth <$> parseOptions ["--depth", "23"] `shouldBe` Right 23

@@ -1,19 +0,0 @@-module Test.Hspec.QuickCheckSpec (main, spec) where--import           Helper--import qualified Test.Hspec as H-import qualified Test.Hspec.Runner as H-import qualified Test.Hspec.QuickCheck as H--main :: IO ()-main = hspec spec--spec :: Spec-spec = do-  describe "prop" $ do-    it "is a shortcut to use properties as examples" $ 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,399 +0,0 @@-module Test.Hspec.RunnerSpec (main, spec) where--import           Helper-import           System.IO (stderr)-import           Control.Monad-import           System.Environment (withArgs, withProgName, getArgs)-import           System.Exit-import           Control.Concurrent-import qualified Control.Exception as E-import           Mock-import           System.SetEnv-import           Test.Hspec.Compat--import           Test.Hspec.FailureReport (FailureReport(..))-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.Formatters as H (silent)-import qualified Test.Hspec.QuickCheck as H--import qualified Test.QuickCheck as QC--main :: IO ()-main = hspec spec--quickCheckOptions :: [([Char], Args -> Int)]-quickCheckOptions = [("--qc-max-success", QC.maxSuccess), ("--qc-max-size", QC.maxSize), ("--qc-max-discard", QC.maxDiscardRatio)]--runPropFoo :: [String] -> IO String-runPropFoo args = unlines . normalizeSummary . lines <$> do-  capture_ . ignoreExitCode . withArgs args . H.hspec .  H.modifyMaxSuccess (const 1000000) $ do-    H.it "foo" $ do-      property (/= (23 :: Int))--spec :: Spec-spec = do-  describe "hspec" $ do-    it "runs a spec" $ do-      silence . H.hspec $ do-        H.it "foobar" True-      `shouldReturn` ()--    it "exits with exitFailure if not all examples pass" $ do-      silence . H.hspec $ do-        H.it "foobar" False-      `shouldThrow` (== ExitFailure 1)--    it "allows output to stdout" $ do-      r <- captureLines . H.hspec $ do-        H.it "foobar" $ do-          putStrLn "baz"-      r `shouldSatisfy` elem "baz"--    it "prints an error message on unrecognized command-line options" $ do-      withProgName "myspec" . withArgs ["--foo"] $ do-        hSilence [stderr] (H.hspec $ pure ()) `shouldThrow` (== ExitFailure 1)-        fst `fmap` hCapture [stderr] (ignoreExitCode (H.hspec $ pure ())) `shouldReturn` unlines [-            "myspec: unrecognized option `--foo'"-          , "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-      lookupEnv "HSPEC_FAILURES" `shouldReturn` (Just . show) FailureReport {-          failureReportSeed = 23-        , failureReportMaxSuccess = 100-        , failureReportMaxSize = 100-        , failureReportMaxDiscardRatio = 10-        , 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-        r <- runPropFoo ["--seed", "42"]-        runPropFoo ["-r"] `shouldReturn` r--      forM_ quickCheckOptions $ \(flag, accessor) -> do-        it ("reuses same " ++ flag) $ do-          [flag, "23"] `shouldUseArgs` ((== 23) . accessor)-          ["--rerun"] `shouldUseArgs` ((== 23) . accessor)--      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-          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-          H.it "foobar" $ do-            getArgs `shouldReturn` []-        `shouldReturn` ()--    context "when interrupted with ctrl-c" $ do-      it "prints summary immediately" $ do-        mvar <- newEmptyMVar-        sync <- newEmptyMVar-        threadId <- forkIO $ do-          r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do-            H.it "foo" False-            H.it "bar" $ do-              putMVar sync ()-              threadDelay 1000000-            H.it "baz" True-          putMVar mvar r-        takeMVar sync-        throwTo threadId E.UserInterrupt-        r <- takeMVar mvar-        normalizeSummary r `shouldBe` [-            ""-          , "- foo FAILED [1]"-          , ""-          , "1) foo"-          , ""-          , "Randomized with seed 23"-          , ""-          ]--      it "throws UserInterrupt" $ do-        mvar <- newEmptyMVar-        sync <- newEmptyMVar-        threadId <- forkIO $ do-          silence . H.hspec $ do-            H.it "foo" $ do-              putMVar sync ()-              threadDelay 1000000-          `E.catch` putMVar mvar-        takeMVar sync-        throwTo threadId E.UserInterrupt-        takeMVar mvar `shouldReturn` E.UserInterrupt--    context "with --help" $ do-      let printHelp = withProgName "spec" . withArgs ["--help"] . H.hspec $ pure ()-      it "prints help" $ do-        r <- (captureLines . ignoreExitCode) printHelp-        r `shouldStartWith` ["Usage: spec [OPTION]..."]-        silence printHelp `shouldThrow` (== ExitSuccess)--      it "constrains lines to 80 characters" $ do-        r <- (captureLines . ignoreExitCode) printHelp-        r `shouldSatisfy` all ((<= 80) . length)-        r `shouldSatisfy` any ((78 <=) . length)--    context "with --dry-run" $ do-      let withDryRun = captureLines . withArgs ["--dry-run"] . H.hspec-      it "produces a report" $ do-        r <- withDryRun $ do-          H.it "foo" True-          H.it "bar" True-        normalizeSummary r `shouldBe` [-            ""-          , "- foo"-          , "- bar"-          , ""-          , "Finished in 0.0000 seconds"-          , "2 examples, 0 failures"-          ]--      it "does not verify anything" $ do-        e <- newMock-        _ <- withDryRun $ do-          H.it "foo" (mockAction e)-          H.it "bar" False-        mockCounter e `shouldReturn` 0--      it "ignores afterAll-hooks" $ do-        ref <- newIORef False-        _ <- withDryRun $ do-          H.afterAll (writeIORef ref True) $ do-            H.it "bar" True-        readIORef ref `shouldReturn` False--    context "with --fail-fast" $ do-      it "stops after first failure" $ do-        r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do-          H.it "foo" True-          H.it "bar" False-          H.it "baz" False-        normalizeSummary r `shouldBe` [-            ""-          , "- foo"-          , "- bar FAILED [1]"-          , ""-          , "1) bar"-          , ""-          , "Randomized with seed 23"-          , ""-          , "Finished in 0.0000 seconds"-          , "2 examples, 1 failure"-          ]--      it "works for nested specs" $ do-        r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do-          H.describe "foo" $ do-            H.it "bar" False-            H.it "baz" True-        normalizeSummary r `shouldBe` [-            ""-          , "foo"-          , "  - bar FAILED [1]"-          , ""-          , "1) foo bar"-          , ""-          , "Randomized with seed 23"-          , ""-          , "Finished in 0.0000 seconds"-          , "1 example, 1 failure"-          ]--    context "with --match" $ do-      it "only runs examples that match a given pattern" $ do-        e1 <- newMock-        e2 <- newMock-        e3 <- newMock-        silence . withArgs ["-m", "/bar/example"] . H.hspec $ do-          H.describe "foo" $ do-            H.describe "bar" $ do-              H.it "example 1" $ mockAction e1-              H.it "example 2" $ mockAction e2-            H.describe "baz" $ do-              H.it "example 3" $ mockAction e3-        (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 1, 0)--      it "can be given multiple times" $ do-        e1 <- newMock-        e2 <- newMock-        e3 <- newMock-        silence . withArgs ["-m", "foo", "-m", "baz"] . H.hspec $ do-          H.describe "foo" $ do-            H.it "example 1" $ mockAction e1-          H.describe "bar" $ do-            H.it "example 2" $ mockAction e2-          H.describe "baz" $ do-            H.it "example 3" $ mockAction e3-        (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 0, 1)--    context "with --format" $ do-      it "uses specified formatter" $ do-        r <- capture_ . ignoreExitCode . withArgs ["--format", "progress"] . H.hspec $ do-          H.it "foo" True-          H.it "bar" True-          H.it "baz" False-          H.it "qux" True-        r `shouldContain` "..F."--      context "when given an invalid argument" $ do-        it "prints an error message to stderr" $ do-          r <- hCapture_ [stderr] . ignoreExitCode . withArgs ["--format", "foo"] . H.hspec $ do-            H.it "foo" True-          r `shouldContain` "invalid argument `foo' for `--format'"--    context "with --qc-max-success" $ do-      it "tries QuickCheck properties specified number of times" $ do-        m <- newMock-        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-          ["--qc-max-success", "23"] `shouldUseArgs` ((== 23) . QC.maxSuccess)-          ["--rerun", "--qc-max-success", "42"] `shouldUseArgs` ((== 42) . QC.maxSuccess)--    context "with --qc-max-size" $ do-      it "passes specified size to QuickCheck properties" $ do-        ["--qc-max-size", "23"] `shouldUseArgs` ((== 23) . QC.maxSize)--    context "with --qc-max-discard" $ do-      it "uses specified discard ratio to QuickCheck properties" $ do-        ["--qc-max-discard", "23"] `shouldUseArgs` ((== 23) . QC.maxDiscardRatio)--    context "with --seed" $ do-      it "uses specified seed" $ do-        r <- runPropFoo ["--seed", "42"]-        runPropFoo ["--seed", "42"] `shouldReturn` r--      context "when run with --rerun" $ do-        it "takes precedence" $ do-          r <- runPropFoo ["--seed", "23"]-          _ <- runPropFoo ["--seed", "42"]-          runPropFoo ["--rerun", "--seed", "23"] `shouldReturn` r--      context "when given an invalid argument" $ do-        let run = withArgs ["--seed", "foo"] . H.hspec $ do-                    H.it "foo" True-        it "prints an error message to stderr" $ do-          r <- hCapture_ [stderr] (ignoreExitCode run)-          r `shouldContain` "invalid argument `foo' for `--seed'"--        it "exits with exitFailure" $ do-          hSilence [stderr] run `shouldThrow` (== ExitFailure 1)--    context "with --print-cpu-time" $ do-      it "includes used CPU time in summary" $ do-        r <- capture_ $ withArgs ["--print-cpu-time"] (H.hspec $ pure ())-        (normalizeSummary . lines) r `shouldContain` ["Finished in 0.0000 seconds, used 0.0000 seconds of CPU time"]--    context "with --html" $ do-      it "produces HTML output" $ do-        r <- capture_ . withArgs ["--html"] . H.hspec $ do-          H.it "foo" True-        r `shouldContain` "</span>"--      it "marks successful examples with CSS class hspec-success" $ do-        r <- capture_ . withArgs ["--html"] . H.hspec $ do-          H.it "foo" True-        r `shouldContain` "<span class=\"hspec-success\">- foo\n</span>"--      it "marks pending examples with CSS class hspec-pending" $ do-        r <- capture_ . withArgs ["--html"] . H.hspec $ do-          H.it "foo" H.pending-        r `shouldContain` "<span class=\"hspec-pending\">- foo"--      it "marks failed examples with CSS class hspec-failure" $ do-        r <- capture_ . ignoreExitCode . withArgs ["--html"] . H.hspec $ do-          H.it "foo" False-        r `shouldContain` "<span class=\"hspec-failure\">- foo"--  describe "hspecResult" $ do-    it "returns a summary of the test run" $ do-      silence . H.hspecResult $ do-        H.it "foo" True-        H.it "foo" False-        H.it "foo" False-        H.it "foo" True-        H.it "foo" True-      `shouldReturn` H.Summary 5 2--    it "treats uncaught exceptions as failure" $ do-      silence . H.hspecResult  $ do-        H.it "foobar" throwException-      `shouldReturn` H.Summary 1 1--    it "uses the specdoc formatter by default" $ do-      _:r:_ <- captureLines . H.hspecResult $ do-        H.describe "Foo.Bar" $ do-          H.it "some example" True-      r `shouldBe` "Foo.Bar"--    it "can use a custom formatter" $ do-      r <- capture_ . H.hspecWithResult H.defaultConfig {H.configFormatter = Just H.silent} $ do-        H.describe "Foo.Bar" $ do-          H.it "some example" True-      r `shouldBe` ""--    it "does not let escape error thunks from failure messages" $ 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,29 +0,0 @@-module Test.Hspec.TimerSpec (main, spec) where--import           Helper--import           Test.Hspec.Timer--main :: IO ()-main = hspec spec--spec :: Spec-spec = do-  describe "timer action returned by newTimer" $ do--    let dt = 0.01--    it "returns False" $ do-      timer <- newTimer dt-      timer `shouldReturn` False--    context "after specified time" $ do-      it "returns True" $ do-        timer <- newTimer dt-        sleep dt-        timer `shouldReturn` True-        timer `shouldReturn` False-        sleep dt-        sleep dt-        timer `shouldReturn` True-        timer `shouldReturn` False

@@ -1,106 +0,0 @@-module Test.Hspec.UtilSpec (main, spec) where--import           Helper-import           Control.Concurrent-import qualified Control.Exception as E--import           Test.Hspec.Util--main :: IO ()-main = hspec spec--spec :: Spec-spec = do-  describe "pluralize" $ do-    it "returns an amount and a word given an amount and word" $ do-      pluralize 1 "thing" `shouldBe` "1 thing"--    it "returns a singular word given the number 1" $ do-      pluralize 1 "thing" `shouldBe` "1 thing"--    it "returns a plural word given a number greater than 1" $ do-      pluralize 2 "thing" `shouldBe` "2 things"--    it "returns a plural word given the number 0" $ do-      pluralize 0 "thing" `shouldBe` "0 things"--  describe "formatException" $ do-    it "converts exception to string" $ do-      formatException (E.toException E.DivideByZero) `shouldBe` "ArithException (divide by zero)"--    context "when used with an IOException" $ do-      it "includes the IOErrorType" $ do-        Left e <- E.try (readFile "foo")-        formatException e `shouldBe` "IOException of type NoSuchThing (foo: openFile: does not exist (No such file or directory))"--  describe "lineBreaksAt" $ do-    it "inserts line breaks at word boundaries" $ do-      lineBreaksAt 20 "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod"-      `shouldBe` [-          "Lorem ipsum dolor"-        , "sit amet,"-        , "consectetur"-        , "adipisicing elit,"-        , "sed do eiusmod"-        ]--  describe "safeTry" $ do-    it "returns Right on success" $ do-      Right e <- safeTry (return 23 :: IO Int)-      e `shouldBe` 23--    it "returns Left on exception" $ do-      Left e <- safeTry throwException-      show e `shouldBe` "foobar"--    it "evaluates result to weak head normal form" $ do-      Left e <- safeTry (return undefined)-      show e `shouldBe` "Prelude.undefined"--    it "does not catch asynchronous exceptions" $ do-      mvar <- newEmptyMVar-      sync <- newEmptyMVar-      threadId <- forkIO $ do-        safeTry (putMVar sync () >> threadDelay 1000000) >> return ()-        `E.catch` putMVar mvar-      takeMVar sync-      throwTo threadId E.UserInterrupt-      readMVar mvar `shouldReturn` E.UserInterrupt--  describe "filterPredicate" $ do-    it "tries to match a pattern against a path" $ do-      let p = filterPredicate "foo/bar/example 1"-      p (["foo", "bar"], "example 1") `shouldBe` True-      p (["foo", "bar"], "example 2") `shouldBe` False--    it "is ambiguous" $ do-      let p = filterPredicate "foo/bar/baz"-      p (["foo", "bar"], "baz") `shouldBe` True-      p (["foo"], "bar/baz") `shouldBe` True--    it "succeeds on a partial match" $ do-      let p = filterPredicate "bar/baz"-      p (["foo", "bar", "baz"], "example 1") `shouldBe` True--    it "succeeds with a pattern that matches the message give in the failure list" $ do-      let p = filterPredicate "ModuleA.ModuleB.foo does something"-      p (["ModuleA", "ModuleB", "foo"], "does something") `shouldBe` True--  describe "formatRequirement" $ do-    it "creates a sentence from a subject and a requirement" $ do-      formatRequirement (["reverse"], "reverses a list") `shouldBe` "reverse reverses a list"--    it "creates a sentence from a subject and a requirement when the subject consits of multiple words" $ do-      formatRequirement (["The reverse function"], "reverses a list") `shouldBe` "The reverse function reverses a list"--    it "returns the requirement if no subject is given" $ do-      formatRequirement ([], "reverses a list") `shouldBe` "reverses a list"--    it "inserts context separated by commas" $ do-      formatRequirement (["reverse", "when applied twice"], "reverses a list") `shouldBe` "reverse, when applied twice, reverses a list"--    it "joins components of a subject with a dot" $ do-      formatRequirement (["Data", "List", "reverse"], "reverses a list") `shouldBe` "Data.List.reverse reverses a list"--    it "properly handles context after a subject that consists of several components" $ do-      formatRequirement (["Data", "List", "reverse", "when applied twice"], "reverses a list") `shouldBe` "Data.List.reverse, when applied twice, reverses a list"

@@ -1,201 +0,0 @@-module Test.HspecSpec (main, spec) where--import           Helper-import           Mock-import           Data.IORef-import           Data.List (isPrefixOf)--import           Test.Hspec.Core (Item(..), Result(..))-import qualified Test.Hspec as H-import qualified Test.Hspec.Runner as H (hspecResult)--import           Test.Hspec.Runner.Tree--main :: IO ()-main = hspec spec--spec :: Spec-spec = do-  describe "pending" $ do-    it "specifies a pending example" $ do-      r <- runSpec $ do-        H.it "foo" H.pending-      r `shouldSatisfy` any (== "     # PENDING: No reason given")--  describe "pendingWith" $ do-    it "specifies a pending example with a reason for why it's pending" $ do-      r <- runSpec $ do-        H.it "foo" $ do-          H.pendingWith "for some reason"-      r `shouldSatisfy` any (== "     # PENDING: for some reason")--  describe "describe" $ do-    let testSpec = do-          H.describe "some subject" $ do-            H.it "foo" True-            H.it "bar" True-            H.it "baz" True-    it "takes a description of what the behavior is for" $ do-      r <- runSpec testSpec-      r `shouldSatisfy` any (== "some subject")--    it "groups behaviors for what's being described" $ do-      r <- filter (isPrefixOf "  - ") `fmap` runSpec testSpec-      length r `shouldBe` 3--    it "can be nested" $ do-      [Node foo [Node bar [Leaf _]]] <- toTree $ do-        H.describe "foo" $ do-          H.describe "bar" $ do-            H.it "baz" True-      (foo, bar) `shouldBe` ("foo", "bar")--    context "when no description is given" $ do-      it "uses a default description" $ do-        [Node d _] <- toTree (H.describe "" (pure ()))-        d `shouldBe` "(no description given)"--  describe "it" $ do-    it "takes a description of a desired behavior" $ do-      [Leaf item] <- toTree (H.it "whatever" True)-      itemRequirement item `shouldBe` "whatever"--    it "takes an example of that behavior" $ do-      [Leaf item] <- toTree (H.it "whatever" True)-      itemExample item defaultParams id noOpProgressCallback `shouldReturn` Success--    context "when no description is given" $ do-      it "uses a default description" $ do-        [Leaf item] <- toTree (H.it "" True)-        itemRequirement item `shouldBe` "(unspecified behavior)"--  describe "example" $ do-    it "fixes the type of an expectation" $ do-      r <- runSpec $ do-        H.it "foo" $ H.example $ do-          pure ()-      r `shouldSatisfy` any (== "1 example, 0 failures")--  describe "parallel" $ do-    it "marks examples for parallel execution" $ do-      [Leaf item] <- toTree . H.parallel $ H.it "whatever" True-      itemIsParallelizable item `shouldBe` True--    it "is applied recursively" $ do-      [Node _ [Node _ [Leaf item]]] <- toTree . H.parallel $ do-        H.describe "foo" $ do-          H.describe "bar" $ do-            H.it "baz" True-      itemIsParallelizable item `shouldBe` True--  describe "before" $ do-    it "runs an action before each spec item" $ do-      mock <- newMock-      silence $ H.hspec $ H.before (mockAction mock) $ do-        H.it "foo" $ do-          mockCounter mock `shouldReturn` 1-        H.it "bar" $ do-          mockCounter mock `shouldReturn` 2-      mockCounter mock `shouldReturn` 2--    context "when used multiple times" $ do-      it "is evaluated outside in" $ do-        ref <- newIORef (0 :: Int)-        let action1 = do-              readIORef ref `shouldReturn` 0-              modifyIORef ref succ-            action2 = do-              readIORef ref `shouldReturn` 1-              modifyIORef ref succ-        silence $ H.hspec $ H.before action1 $ H.before action2 $ do-          H.it "foo" $ do-            readIORef ref `shouldReturn` 2--  describe "beforeAll" $ do-    it "runs an action before the first spec item" $ do-      ref <- newIORef []-      let append n = modifyIORef ref (++ return n)-      silence $ H.hspec $ H.beforeAll (append "beforeAll") $ do-        H.it "foo" $ do-          append "foo"-        H.it "bar" $ do-          append "bar"-      readIORef ref `shouldReturn` [-          "beforeAll"-        , "foo"-        , "bar"-        ]--    context "when used with an empty list of examples" $ do-      it "does not run specified action" $ do-        ref <- newIORef []-        let append n = modifyIORef ref (++ return n)-        silence $ H.hspec $ H.beforeAll (append "beforeAll") $ do-          return ()-        readIORef ref `shouldReturn` []--  describe "after" $ do-    it "runs an action after each spec item" $ do-      mock <- newMock-      silence $ H.hspec $ H.after (mockAction mock) $ do-        H.it "foo" $ do-          mockCounter mock `shouldReturn` 0-        H.it "bar" $ do-          mockCounter mock `shouldReturn` 1-      mockCounter mock `shouldReturn` 2--    it "guarantees that action is run" $ do-      mock <- newMock-      silence . ignoreExitCode $ H.hspec $ H.after (mockAction mock) $ do-        H.it "foo" $ do-          ioError $ userError "foo" :: IO ()-      mockCounter mock `shouldReturn` 1--  describe "afterAll" $ do-    it "runs an action after the last spec item" $ do-      ref <- newIORef []-      let append n = modifyIORef ref (++ return n)-      silence $ H.hspec $ H.afterAll (append "afterAll") $ do-        H.it "foo" $ do-          append "foo"-        H.it "bar" $ do-          append "bar"-      readIORef ref `shouldReturn` [-          "foo"-        , "bar"-        , "afterAll"-        ]--    context "when used with an empty list of examples" $ do-      it "does not run specified action" $ do-        ref <- newIORef []-        let append n = modifyIORef ref (++ return n)-        silence $ H.hspec $ H.afterAll (append "afterAll") $ do-          return ()-        readIORef ref `shouldReturn` []--    context "when action throws an exception" $ do-      it "reports a failure" $ do-        r <- runSpec $ do-          H.afterAll throwException $ do-            H.it "foo" True-        r `shouldSatisfy` any (== "- afterAll-hook FAILED [1]")--  describe "around" $ do-    it "wraps each spec item with an action" $ do-      ref <- newIORef (0 :: Int)-      let action :: IO () -> IO ()-          action e = do-            readIORef ref `shouldReturn` 0-            writeIORef ref 1-            e-            readIORef ref `shouldReturn` 2-            writeIORef ref 3-      silence $ H.hspec $ H.around action $ do-        H.it "foo" $ do-          readIORef ref `shouldReturn` 1-          writeIORef ref 2-      readIORef ref `shouldReturn` 3-  where-    runSpec :: H.Spec -> IO [String]-    runSpec = captureLines . H.hspecResult