packages feed

hspec2 (empty) → 0.0.0

raw patch · 46 files changed

+3724/−0 lines, 46 filesdep +HUnitdep +QuickCheckdep +ansi-terminalsetup-changed

Dependencies added: HUnit, QuickCheck, ansi-terminal, base, deepseq, directory, doctest, filepath, ghc-paths, hspec, hspec-expectations, hspec-meta, process, quickcheck-io, random, setenv, silently, time, transformers

Files

+ LICENSE view
@@ -0,0 +1,21 @@+Copyright (c) 2011-2014 Simon Hengel <sol@typeful.net>+Copyright (c) 2011-2012 Trystan Spangler <trystan.s@comcast.net>+Copyright (c) 2011-2011 Greg Weber <greg@gregweber.info>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ example/Spec.hs view
@@ -0,0 +1,16 @@+module Main (main, spec) where++import Test.Hspec+import Test.QuickCheck++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "reverse" $ do+    it "reverses a list" $ do+      reverse [1 :: Int, 2, 3] `shouldBe` [3, 2, 1]++    it "gives the original list, if applied twice" $ property $+      \xs -> (reverse . reverse) xs == (xs :: [Int])
+ hspec-discover/src/Config.hs view
@@ -0,0 +1,43 @@+module Config (+  Config (..)+, defaultConfig+, parseConfig+, usage+) where++import           Data.Maybe+import           System.Console.GetOpt++data Config = Config {+  configNested :: Bool+, configFormatter :: Maybe String+, configNoMain :: Bool+} deriving (Eq, Show)++defaultConfig :: Config+defaultConfig = Config False Nothing False++options :: [OptDescr (Config -> Config)]+options = [+    Option [] ["nested"]    (NoArg  $ \c -> c   {configNested = True}) ""+  , Option [] ["formatter"] (ReqArg (\s c -> c {configFormatter = Just s}) "FORMATTER") ""+  , Option [] ["no-main"]   (NoArg  $ \c -> c   {configNoMain = True}) ""+  ]++usage :: String -> String+usage prog = "\nUsage: " ++ prog ++ " SRC CUR DST [--formatter=FORMATTER] [--no-main]\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)
+ hspec-discover/src/Main.hs view
@@ -0,0 +1,8 @@+module Main (main) where++import           System.Environment++import           Run (run)++main :: IO ()+main = getArgs >>= run
+ hspec-discover/src/Run.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | A preprocessor that finds and combines specs.+module Run (+  run++-- exported for testing+, 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++type Spec = String++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 . " #-}"+  . showString ("module " ++ module_ ++" where\n")+  . importList nodes+  . maybe driver (driverWithFormatter (null nodes)) (configFormatter c)+  . formatSpecs nodes+  ) "\n"+  where+    driver =+        showString "import Test.Hspec\n"+      . case configNoMain c of+          False ->+              showString "main :: IO ()\n"+            . showString "main = hspec $ "+          True ->+              showString "spec :: Spec\n"+            . showString "spec = "+    module_ = if configNoMain c then pathToModule src else "Main"+    pathToModule f = let+        fileName = last $ splitDirectories f+        m:ms = takeWhile (/='.') fileName+     in+        toUpper m:ms+++driverWithFormatter :: Bool -> String -> ShowS+driverWithFormatter isEmpty f =+    (if isEmpty then id else "import Test.Hspec\n")+  . showString "import Test.Hspec.Runner\n"+  . showString "import qualified " . showString (moduleName f) . showString "\n"+  . showString "main :: IO ()\n"+  . showString "main = hspecWithFormatter " . showString f . showString " $ "++moduleName :: String -> String+moduleName = reverse . dropWhile (== '.') . dropWhile (/= '.') . reverse++-- | Generate imports for a list of specs.+importList :: [Spec] -> ShowS+importList = foldr (.) "" . map f+  where+    f :: Spec -> ShowS+    f name = "import qualified " . showString name . "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 name = "describe " . shows name . " " . showString name . "Spec.spec"++findSpecs :: FilePath -> IO [Spec]+findSpecs src = do+  let (dir, file) = splitFileName src+  mapMaybe fileToSpec . filter (/= file) <$> getFilesRecursive dir++fileToSpec :: FilePath -> Maybe String+fileToSpec f = intercalate "." . reverse <$> case reverse $ splitDirectories f of+  x:xs -> case stripSuffix "Spec.hs" x <|> stripSuffix "Spec.lhs" x of+    Nothing -> Nothing+    Just "" -> Nothing+    Just ys -> Just (ys : xs)+  _ -> 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)
+ hspec-discover/test-data/empty-dir/Foo/Bar/Baz/.placeholder view
+ hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs view
+ hspec-discover/test-data/nested-spec/Foo/BarSpec.hs view
+ hspec-discover/test-data/nested-spec/FooSpec.hs view
+ hspec-discover/test/ConfigSpec.hs view
@@ -0,0 +1,47 @@+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 [--formatter=FORMATTER] [--no-main]"+        ]++    it "returns error message on unexpected argument" $ do+      parse ["foo"]   `shouldBe` (Left . unlines) [+          "hspec-discover: unexpected argument `foo'"+        , ""+        , "Usage: hspec-discover SRC CUR DST [--formatter=FORMATTER] [--no-main]"+        ]++    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 [--formatter=FORMATTER] [--no-main]"+        ]++    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"})
+ hspec-discover/test/RunSpec.hs view
@@ -0,0 +1,100 @@+module RunSpec (main, spec) where++import           Test.Hspec.Meta++import           Control.Applicative+import           System.IO+import           System.Directory+import           System.FilePath+import           Data.List (intercalate, sort)++import           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\" #-}module Main where"+        , "import qualified Foo.Bar.BazSpec"+        , "import qualified Foo.BarSpec"+        , "import qualified FooSpec"+        , "import Test.Hspec"+        , "main :: IO ()"+        , "main = hspec $ describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec >> describe \"Foo.Bar\" Foo.BarSpec.spec >> 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\" #-}module Main where"+        , "import Test.Hspec"+        , "main :: IO ()"+        , "main = hspec $ 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 "Foo"++    it "rejects spec with empty name" $ do+      fileToSpec "Spec.hs" `shouldBe` Nothing++    it "works for lhs files" $ do+      fileToSpec "FooSpec.lhs" `shouldBe` Just "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+        fileToSpec ("Foo" </> "Bar" </> "BazSpec.hs") `shouldBe` Just "Foo.Bar.Baz"++      it "rejects spec with empty name" $ do+        fileToSpec ("Foo" </> "Bar" </> "Spec.hs") `shouldBe` Nothing++  describe "findSpecs" $ do+    it "finds specs" $ do+      findSpecs "hspec-discover/test-data/nested-spec/Spec.hs" `shouldReturn` ["Foo.Bar.Baz","Foo.Bar","Foo"]++  describe "driverWithFormatter" $ do+    it "generates a test driver that uses a custom formatter" $ do+      driverWithFormatter False "Some.Module.formatter" "" `shouldBe` intercalate "\n" [+          "import Test.Hspec"+        , "import Test.Hspec.Runner"+        , "import qualified Some.Module"+        , "main :: IO ()"+        , "main = hspecWithFormatter Some.Module.formatter $ "+        ]++  describe "moduleName" $ do+    it "returns the module name of an fully qualified identifier" $ do+      moduleName "Some.Module.someId" `shouldBe` "Some.Module"++  describe "importList" $ do+    it "generates imports for a list of specs" $ do+      importList ["Foo", "Bar"] "" `shouldBe` unlines [+          "import qualified FooSpec"+        , "import qualified BarSpec"+        ]
+ hspec-discover/test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-}
+ hspec2.cabal view
@@ -0,0 +1,170 @@+name:             hspec2+version:          0.0.0+license:          MIT+license-file:     LICENSE+copyright:        (c) 2011-2014 Simon Hengel,+                  (c) 2011-2012 Trystan Spangler,+                  (c) 2011 Greg Weber+maintainer:       Simon Hengel <sol@typeful.net>+build-type:       Simple+cabal-version:    >= 1.8+category:         Testing+stability:        experimental+bug-reports:      https://github.com/hspec/hspec/issues+homepage:         http://hspec.github.io/+synopsis:         Alpha version of Hspec 2.0+description:      This is an alpha release of Hspec 2.0.+                  If you are looking for a stable solution for testing Haskell+                  code, use the 1.x series of Hspec: http://hspec.github.io/++-- find hspec-discover/test-data/ -type f+extra-source-files:+  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+  exposed: False+  ghc-options:+      -Wall+  hs-source-dirs:+      src+  build-depends:+      base          == 4.*+    , random        == 1.0.*+    , setenv+    , ansi-terminal >= 0.5+    , time+    , transformers  >= 0.2.2.0 && < 0.4.0+    , deepseq+    , HUnit         >= 1.2.5+    , QuickCheck    >= 2.5.1+    , quickcheck-io+    , hspec-expectations == 0.5.0.*+  exposed-modules:+      Test.Hspec+      Test.Hspec.Core+      Test.Hspec.Runner+      Test.Hspec.Formatters+      Test.Hspec.HUnit+      Test.Hspec.QuickCheck+  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++test-suite spec+  type:+      exitcode-stdio-1.0+  hs-source-dirs:+      src, test+  main-is:+      Spec.hs+  other-modules:+      Mock+      Helper+      Test.HspecSpec+      Test.Hspec.CompatSpec+      Test.Hspec.Core.TypeSpec+      Test.Hspec.FailureReportSpec+      Test.Hspec.FormattersSpec+      Test.Hspec.HUnitSpec+      Test.Hspec.OptionsSpec+      Test.Hspec.QuickCheckSpec+      Test.Hspec.RunnerSpec+      Test.Hspec.TimerSpec+      Test.Hspec.UtilSpec+  ghc-options:+      -Wall -Werror+  build-depends:+      base          == 4.*+    , random        == 1.0.*+    , setenv+    , silently      >= 1.2.4+    , ansi-terminal+    , time+    , transformers+    , deepseq+    , HUnit+    , QuickCheck+    , quickcheck-io+    , hspec-expectations++    , hspec-meta >= 1.8.0+    , process+    , ghc-paths++test-suite doctests+  main-is:+      doctests.hs+  type:+      exitcode-stdio-1.0+  ghc-options:+      -Wall -Werror -threaded+  hs-source-dirs:+      test+  build-depends:+      base    == 4.*+    , doctest >= 0.9.4.1++test-suite example+  type:+      exitcode-stdio-1.0+  main-is:+      Spec.hs+  hs-source-dirs:+      example+  ghc-options:+      -Wall -Werror+  build-depends:+      base    == 4.*+    , hspec+    , QuickCheck++-- hspec-discover+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-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
+ src/Test/Hspec.hs view
@@ -0,0 +1,103 @@+-- |+-- Stability: stable+--+-- Hspec is a testing library for Haskell.+--+-- This is the library reference for Hspec.+-- The <http://hspec.github.io/ User's Manual> contains more in-depth+-- documentation.+module Test.Hspec (+-- * Types+  Spec+, SpecWith+, Example++-- * Setting expectations+, module Test.Hspec.Expectations++-- * Defining a spec+, describe+, context+, it+, example+, pending+, pendingWith+, before+, after+, after_+, around+, around_+, parallel++-- * Running a spec+, hspec+) where++import           Control.Exception (finally)++import           Test.Hspec.Core.Type hiding (describe, it)+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 -> SpecWith a -> SpecWith a+describe label action = fromSpecList [Core.describe label (runSpecM action)]++-- | An alias for `describe`.+context :: String -> SpecWith a -> SpecWith a+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 e => String -> e -> SpecWith (Arg e)+it label action = fromSpecList [Core.it label action]++-- | This is a type restricted version of `id`.  It can be used to get better+-- error messages on type mismatches.+--+-- Compare e.g.+--+-- > it "exposes some behavior" $ example $ do+-- >   putStrLn+--+-- with+--+-- > it "exposes some behavior" $ do+-- >   putStrLn+example :: Expectation -> Expectation+example = id++-- | Run examples of given spec in parallel.+parallel :: SpecWith a -> SpecWith a+parallel = mapSpecItem $ \item -> item {itemIsParallelizable = True}++-- | Run a custom action before every spec item.+before :: IO a -> SpecWith a -> Spec+before action = around (action >>=)++-- | Run a custom action after every spec item.+after :: (a -> IO ()) -> SpecWith a -> SpecWith a+after a2 = mapSpecItem $ \item -> item {itemExample = \params a1 -> itemExample item params (\f -> a1 (\a -> f a `finally` a2 a))}++-- | Run a custom action after every spec item.+after_ :: IO () -> Spec -> Spec+after_ action = after $ \() -> action++-- | Run a custom action before and/or after every spec item.+around :: ((a -> IO ()) -> IO ()) -> SpecWith a -> Spec+around a2 = mapSpecItem $ \item -> item {itemExample = \params a1 -> itemExample item params (\x -> a1 $ \() -> a2 x)}++-- | Run a custom action before and/or after every spec item.+around_ :: (IO () -> IO ()) -> Spec -> Spec+around_ action = around $ action . ($ ())
+ src/Test/Hspec/Compat.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Compat (+  showType+, showFullType+, readMaybe+, lookupEnv+, module Data.IORef+#if !MIN_VERSION_base(4,6,0)+, modifyIORef'+#endif+) where++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
+ src/Test/Hspec/Config.hs view
@@ -0,0 +1,118 @@+module Test.Hspec.Config (+  Config (..)+, defaultConfig+, getConfig+, configAddFilter+, configSetSeed+) where++import           Control.Applicative+import           Data.List+import           Data.Maybe+import           System.IO+import           System.Exit+import qualified Test.QuickCheck as QC+import           Test.Hspec.Formatters++import           Test.Hspec.Util++-- for Monad (Either e) when base < 4.3+import           Control.Monad.Trans.Error ()++import           Test.Hspec.Options+import           Test.Hspec.FailureReport++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.+, configFilterPredicate :: Maybe (Path -> Bool)+, configQuickCheckArgs  :: QC.Args+, configSmallCheckDepth :: Int+, configColorMode       :: ColorMode+, configFormatter       :: Formatter+, configHtmlOutput      :: Bool+, configHandle          :: Either Handle FilePath+}++defaultConfig :: Config+defaultConfig = Config False False False Nothing QC.stdArgs 5 ColorAuto specdoc False (Left stdout)++-- | Add a filter predicate to config.  If there is already a filter predicate,+-- then combine them with `||`.+configAddFilter :: (Path -> Bool) -> Config -> Config+configAddFilter p1 c = c {+    configFilterPredicate = Just p1 `filterOr` configFilterPredicate c+  }++filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool)+filterOr p1_ p2_ = case (p1_, p2_) of+  (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path+  _ -> p1_ <|> p2_++configSetSeed :: Integer -> Config -> Config+configSetSeed n c = c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.replay = Just (stdGenFromInteger n, 0)}}++mkConfig :: Maybe FailureReport -> Options -> Config+mkConfig mFailureReport opts = Config {+    configDryRun          = optionsDryRun opts+  , configPrintCpuTime    = optionsPrintCpuTime opts+  , configFastFail        = optionsFastFail opts+  , configFilterPredicate = matchFilter `filterOr` rerunFilter+  , configQuickCheckArgs  = qcArgs+  , configSmallCheckDepth = fromMaybe (configSmallCheckDepth defaultConfig) (optionsDepth opts)+  , configColorMode       = optionsColorMode opts+  , configFormatter       = optionsFormatter opts+  , configHtmlOutput      = optionsHtmlOutput opts+  , configHandle          = maybe (configHandle defaultConfig) Right (optionsOutputFile opts)+  }+  where+    qcArgs = (+        maybe id setSeed mSeed+      . maybe id setMaxDiscardRatio mMaxDiscardRatio+      . maybe id setMaxSize mMaxSize+      . maybe id setMaxSuccess mMaxSuccess) QC.stdArgs++    mSeed = optionsSeed opts <|> (failureReportSeed <$> mFailureReport)+    mMaxSuccess = optionsMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport)+    mMaxSize = optionsMaxSize opts <|> (failureReportMaxSize <$> mFailureReport)+    mMaxDiscardRatio = optionsMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport)++    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 (stdGenFromInteger n, 0)}++    matchFilter = case optionsMatch opts of+      [] -> Nothing+      xs -> Just $ foldl1' (\p0 p1 path -> p0 path || p1 path) (map filterPredicate xs)++    rerunFilter = flip elem . failureReportPaths <$> mFailureReport++getConfig :: Options -> String -> [String] -> IO Config+getConfig opts_ prog args = do+  case parseOptions opts_ prog args of+    Left (err, msg) -> exitWithMessage err msg+    Right opts -> do+      r <- if optionsRerun opts then readFailureReport else return Nothing+      return (mkConfig r opts)++exitWithMessage :: ExitCode -> String -> IO a+exitWithMessage err msg = do+  hPutStr h msg+  exitWith err+  where+    h = case err of+      ExitSuccess -> stdout+      _           -> stderr
+ src/Test/Hspec/Core.hs view
@@ -0,0 +1,32 @@+-- |+-- 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 (..)+, Item (..)+, mapSpecItem+, modifyParams+, describe+, it+) where++import           Test.Hspec.Core.Type++modifyParams :: (Params -> Params) -> SpecWith a -> SpecWith a+modifyParams f = mapSpecItem $ \item -> item {itemExample = \p -> (itemExample item) (f p)}
+ src/Test/Hspec/Core/QuickCheckUtil.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.QuickCheckUtil where++import Data.IORef+import Test.QuickCheck hiding (Result(..))+import Test.QuickCheck as QC+import Test.QuickCheck.Property hiding (Result(..))+import Test.QuickCheck.Gen+import qualified Test.QuickCheck.Property as QCP+import Test.QuickCheck.IO ()++aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property+aroundProperty action p = MkGen $ \r n -> aroundProp action $ \a -> (unGen $ p a) r n++aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop+aroundProp action p = MkProp $ aroundRose action (\a -> unProp $ p a)++aroundRose :: ((a -> IO ()) -> IO ()) -> (a -> Rose QCP.Result) -> Rose QCP.Result+aroundRose action r = ioRose $ do+  ref <- newIORef (return QCP.succeeded)+  action $ \a -> reduceRose (r a) >>= writeIORef ref+  readIORef ref++isUserInterrupt :: QC.Result -> Bool+isUserInterrupt r = case r of+#if MIN_VERSION_QuickCheck(2,6,0)+  QC.Failure {QC.interrupted = x} -> x+#else+  QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True+#endif+  _ -> False
+ src/Test/Hspec/Core/Type.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable, TypeFamilies #-}+module Test.Hspec.Core.Type (+  Spec+, SpecWith+, SpecM (..)+, runSpecM+, fromSpecList+, SpecTree (..)+, Item (..)+, mapSpecItem+, Example (..)+, Result (..)+, Params (..)+, Progress+, ProgressCallback++, describe+, it+, forceResult++, pending+, pendingWith+) where++import qualified Control.Exception as E+import           Control.Applicative+import           Control.Monad (when)+import           Control.Monad.Trans.Writer (Writer, execWriter, tell)+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 = SpecWith ()++type SpecWith a = SpecM a ()++-- | A writer monad for `SpecTree` forests.+newtype SpecM a r = SpecM (Writer [SpecTree a] r)+  deriving (Functor, Applicative, Monad)++-- | Convert a `Spec` to a forest of `SpecTree`s.+runSpecM :: SpecWith a -> [SpecTree a]+runSpecM (SpecM specs) = execWriter specs++-- | Create a `Spec` from a forest of `SpecTree`s.+fromSpecList :: [SpecTree a] -> SpecWith a+fromSpecList = SpecM . tell++-- | 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+}++-- | Internal representation of a spec.+data SpecTree a =+    SpecGroup String [SpecTree a]+  | SpecItem String (Item a)++data Item a = Item {+  itemIsParallelizable :: Bool+, itemExample :: Params -> ((a -> IO ()) -> IO ()) -> ProgressCallback -> IO Result+}++mapSpecItem :: (Item a -> Item b) -> SpecWith a -> SpecWith b+mapSpecItem f = fromSpecList . map go . runSpecM+  where+    go spec = case spec of+      SpecItem r item -> SpecItem r (f item)+      SpecGroup d es -> SpecGroup d (map go es)++-- | The @describe@ function combines a list of specs into a larger spec.+describe :: String -> [SpecTree a] -> SpecTree a+describe s = SpecGroup msg+  where+    msg+      | null s = "(no description given)"+      | otherwise = s++-- | Create a spec item.+it :: Example e => String -> e -> SpecTree (Arg e)+it s e = SpecItem msg $ Item False (evaluateExample e)+  where+    msg+      | null s = "(unspecified behavior)"+      | otherwise = s++-- | A type class for examples.+class Example e where+  type Arg e+  evaluateExample :: e -> Params -> ((Arg e -> IO ()) -> IO ()) -> ProgressCallback -> IO Result++instance Example Bool where+  type Arg Bool = ()+  evaluateExample b _ _ _ = if b then return Success else return (Fail "")++instance Example Expectation where+  type Arg Expectation = ()+  evaluateExample e = evaluateExample (\() -> e)++instance Example (a -> Expectation) where+  type Arg (a -> Expectation) = a+  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+  type Arg Result = ()+  evaluateExample r _ _ _ = return r++instance Example QC.Property where+  type Arg QC.Property = ()+  evaluateExample e = evaluateExample (\() -> e)++instance Example (a -> QC.Property) where+  type Arg (a -> QC.Property) = a+  evaluateExample p c action progressCallback = do+    r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty action p)+    when (isUserInterrupt r) $ do+      E.throwIO E.UserInterrupt++    return $+      case r of+        QC.Success {}               -> Success+        QC.Failure {QC.output = m}  -> fromMaybe (Fail $ sanitizeFailureMessage m) (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 :: String -> String+      sanitizeFailureMessage = strip . addFalsifiable . stripFailed++      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+        | prefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m+        | otherwise = Nothing+        where+          n = length prefix+          prefix = "*** 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
+ src/Test/Hspec/FailureReport.hs view
@@ -0,0 +1,36 @@+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
+ src/Test/Hspec/Formatters.hs view
@@ -0,0 +1,234 @@+{-# 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+, 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.Compat+import           Text.Printf+import           Control.Monad (unless, forM_)+import           Control.Applicative+import qualified Control.Exception as E+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++  , 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 = \n nesting name -> do++    -- separate groups with an empty line+    unless (n == 0) $ do+      newParagraph++    writeLine (indentationFor nesting ++ name)++, exampleGroupDone = do+    newParagraph++, 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+  newParagraph++  failures <- getFailMessages++  forM_ (zip [1..] failures) $ \x -> do+    formatFailure x+    writeLine ""+  unless (null failures) $ do+    write "Randomized with seed " >> usedSeed >>= writeLine . show+    writeLine ""+  where+    formatFailure :: (Int, FailureRecord) -> FormatM ()+    formatFailure (n, FailureRecord path reason) = do+      write (show n ++ ") ")+      writeLine (formatRequirement path)+      withFailColor $ do+        unless (null err) $ do+          writeLine err+      where+        err = either (("uncaught exception: " ++) . formatException) id reason++-- | Convert an exception to a string.+--+-- The type of the exception is included.  Here is an example:+--+-- >>> import Control.Applicative+-- >>> import Control.Exception+-- >>> either formatException show <$> (try . evaluate) (1 `div` 0)+-- "ArithException (divide by zero)"+formatException :: E.SomeException -> String+formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")"++defaultFooter :: FormatM ()+defaultFooter = do++  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 ""
+ src/Test/Hspec/Formatters/Internal.hs view
@@ -0,0 +1,263 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Test.Hspec.Formatters.Internal (++-- * Public API+  Formatter (..)+, FormatM++, getSuccessCount+, getPendingCount+, getFailCount+, getTotalCount++, FailureRecord (..)+, getFailMessages+, usedSeed++, getCPUTime+, getRealTime++, write+, writeLine+, newParagraph++, 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 (when, unless)+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)++-- | 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+, lastIsEmptyLine :: Bool    -- True, if last line was empty+, 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_ False 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 :: Path -> Either SomeException String -> FormatM ()+addFailMessage p m = modify $ \s -> s {failMessages = FailureRecord p m : failMessages s}++-- | Get the list of accumulated failure messages.+getFailMessages :: FormatM [FailureRecord]+getFailMessages = reverse `fmap` gets failMessages++data FailureRecord = FailureRecord {+  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 :: Int -> [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 = do+  f <- gets lastIsEmptyLine+  unless f $ do+    writeLine ""+    setLastIsEmptyLine True++setLastIsEmptyLine :: Bool -> FormatM ()+setLastIsEmptyLine f = modify $ \s -> s {lastIsEmptyLine = f}++-- | Append some output to the report.+write :: String -> FormatM ()+write s = do+  h <- gets stateHandle+  liftIO $ IO.hPutStr h s+  setLastIsEmptyLine False++-- | The same as `write`, but adds a newline character.+writeLine :: String -> FormatM ()+writeLine s = 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 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)
+ src/Test/Hspec/HUnit.hs view
@@ -0,0 +1,23 @@+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)  -> it s e+      TestLabel s (TestList xs) -> describe s (map go xs)+      TestLabel s x             -> describe s [go x]+      TestList xs               -> describe "<unlabeled>" (map go xs)+      TestCase e                -> it  "<unlabeled>" e
+ src/Test/Hspec/Options.hs view
@@ -0,0 +1,157 @@+module Test.Hspec.Options (+  Options (..)+, ColorMode (..)+, defaultOptions+, parseOptions++-- exported to silence warnings+, Arg (..)+) where++import           Data.List+import           System.Exit+import           System.Console.GetOpt+import           Test.Hspec.Formatters++import           Test.Hspec.Compat+import           Test.Hspec.Util++-- for Monad (Either e) when base < 4.3+import           Control.Monad.Trans.Error ()++data Options = Options {+  optionsDryRun       :: Bool+, optionsPrintCpuTime :: Bool+, optionsRerun        :: Bool+, optionsFastFail     :: Bool+, optionsMatch        :: [String]+, optionsMaxSuccess   :: Maybe Int+, optionsDepth        :: Maybe Int+, optionsSeed         :: Maybe Integer+, optionsMaxSize      :: Maybe Int+, optionsMaxDiscardRatio :: Maybe Int+, optionsColorMode    :: ColorMode+, optionsFormatter    :: Formatter+, optionsHtmlOutput   :: Bool+, optionsOutputFile   :: Maybe FilePath+}++addMatch :: String -> Options -> Options+addMatch s c = c {optionsMatch = s : optionsMatch c}++setDepth :: Int -> Options -> Options+setDepth n c = c {optionsDepth = Just n}++setMaxSuccess :: Int -> Options -> Options+setMaxSuccess n c = c {optionsMaxSuccess = Just n}++setMaxSize :: Int -> Options -> Options+setMaxSize n c = c {optionsMaxSize = Just n}++setMaxDiscardRatio :: Int -> Options -> Options+setMaxDiscardRatio n c = c {optionsMaxDiscardRatio = Just n}++setSeed :: Integer -> Options -> Options+setSeed n c = c {optionsSeed = Just n}++data ColorMode = ColorAuto | ColorNever | ColorAlways+  deriving (Eq, Show)++defaultOptions :: Options+defaultOptions = Options False False False False [] Nothing Nothing Nothing Nothing Nothing ColorAuto specdoc False Nothing++formatters :: [(String, Formatter)]+formatters = [+    ("specdoc", specdoc)+  , ("progress", progress)+  , ("failed-examples", failed_examples)+  , ("silent", silent)+  ]++formatHelp :: String+formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters)++type Result = Either NoConfig Options++data NoConfig = Help | InvalidArgument String String++data Arg a = Arg {+  argumentName   :: String+, argumentParser :: String -> Maybe a+, argumentSetter :: a -> Options -> Options+}++mkOption :: [Char] -> String -> Arg a -> String -> OptDescr (Result -> Result)+mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help+  where+    arg :: String -> Result -> Result+    arg input x = x >>= \c -> case parser input of+      Just n -> Right (setter n c)+      Nothing -> Left (InvalidArgument name input)++addLineBreaks :: String -> [String]+addLineBreaks = lineBreaksAt 44++options :: [OptDescr (Result -> Result)]+options = [+    Option   []  ["help"]             (NoArg (const $ Left Help))         (h "display this help and exit")+  , mkOption "m"  "match"             (Arg "PATTERN" return addMatch)     (h "only run examples that match given PATTERN")+  , Option   []  ["color"]            (NoArg setColor)                    (h "colorize the output")+  , Option   []  ["no-color"]         (NoArg setNoColor)                  (h "do not colorize the output")+  , mkOption "f"  "format"            (Arg "FORMATTER" readFormatter setFormatter) formatHelp+  , mkOption "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 -> Options -> Options+    setFormatter f c = c {optionsFormatter = f}++    setOutputFile :: String -> Options -> Options+    setOutputFile file c = c {optionsOutputFile = Just file}++    setPrintCpuTime x = x >>= \c -> return c {optionsPrintCpuTime = True}+    setDryRun       x = x >>= \c -> return c {optionsDryRun       = True}+    setFastFail     x = x >>= \c -> return c {optionsFastFail     = True}+    setRerun        x = x >>= \c -> return c {optionsRerun = True}+    setNoColor      x = x >>= \c -> return c {optionsColorMode = ColorNever}+    setColor        x = x >>= \c -> return c {optionsColorMode = ColorAlways}++undocumentedOptions :: [OptDescr (Result -> Result)]+undocumentedOptions = [+    -- for compatibility with test-framework+    mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default"++    -- undocumented for now, as we probably want to change this to produce a+    -- standalone HTML report in the future+  , Option []  ["html"]                    (NoArg setHtml)                    "produce HTML output"++    -- now a noop+  , Option "v" ["verbose"]                 (NoArg id)                         "do not suppress output to stdout when evaluating examples"+  ]+  where+    setHtml :: Result -> Result+    setHtml x = x >>= \c -> return c {optionsHtmlOutput = True}++parseOptions :: Options -> String -> [String] -> Either (ExitCode, String) Options+parseOptions c prog args = case getOpt Permute (options ++ undocumentedOptions) args of+    (opts, [], []) -> case foldl' (flip id) (Right c) opts of+        Left Help                         -> Left (ExitSuccess, usageInfo ("Usage: " ++ prog ++ " [OPTION]...\n\nOPTIONS") options)+        Left (InvalidArgument flag value) -> tryHelp ("invalid argument `" ++ value ++ "' for `--" ++ flag ++ "'\n")+        Right x -> Right x+    (_, _, err:_)  -> tryHelp err+    (_, arg:_, _)  -> tryHelp ("unexpected argument `" ++ arg ++ "'\n")+  where+    tryHelp msg = Left (ExitFailure 1, prog ++ ": " ++ msg ++ "Try `" ++ prog ++ " --help' for more information.\n")
+ src/Test/Hspec/QuickCheck.hs view
@@ -0,0 +1,59 @@+-- |+-- Stability: provisional+module Test.Hspec.QuickCheck (+-- * Params+  modifyMaxSuccess+, modifyMaxDiscardRatio+, modifyMaxSize+-- * Re-exports from QuickCheck+-- |+-- Previous versions of Hspec provided a distinct `property` combinator, but+-- it's now possible to use QuickCheck's `property` instead.  For backward+-- compatibility we now re-export QuickCheck's `property`, but it is advisable+-- to import it from "Test.QuickCheck" instead.+, property+-- * Shortcuts+, prop+) where++import           Test.QuickCheck+import           Test.Hspec+import           Test.Hspec.Core (Params(..), modifyParams)++-- |+-- > prop ".." $+-- >   ..+--+-- is a shortcut for+--+-- > it ".." $ property $+-- >   ..+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)}
+ src/Test/Hspec/Runner.hs view
@@ -0,0 +1,168 @@+-- |+-- Stability: provisional+module Test.Hspec.Runner (+-- * Running a spec+  hspec+, hspecResult+, hspecWith++-- * Types+, Summary (..)+, Config (..)+, ColorMode (..)+, Path+, defaultConfig+, configAddFilter++-- * Internals+, hspecWithFormatter+) 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           System.Random (newStdGen)+import           Control.Monad.IO.Class (liftIO)++import           Test.Hspec.Compat (lookupEnv)+import           Test.Hspec.Util (Path, stdGenToInteger)+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.Options (Options(..), ColorMode(..), defaultOptions)+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 :: (Path -> Bool) -> [Tree a] -> [Tree a]+filterSpecs p = goSpecs []+  where+    goSpecs groups = mapMaybe (goSpec groups)++    goSpec groups spec = case spec of+      Leaf requirement _ -> guard (p (groups, requirement)) >> return spec+      Node group specs -> case goSpecs (groups ++ [group]) specs of+        [] -> Nothing+        xs -> Just (Node group xs)++-- | Run given spec and write a report to `stdout`.+-- Exit with `exitFailure` if at least one spec item fails.+hspec :: Spec -> IO ()+hspec = hspecWithOptions defaultOptions++-- | This function is used by @hspec-discover@.  It is not part of the public+-- API and may change at any time.+hspecWithFormatter :: IsFormatter a => a -> Spec -> IO ()+hspecWithFormatter formatter spec = do+  f <- toFormatter formatter+  hspecWithOptions defaultOptions {optionsFormatter = f} spec++-- Add a StdGen to configQuickCheckArgs if there is none.  That way the same+-- seed is used for all properties.  This helps with --seed and --rerun.+ensureStdGen :: Config -> IO Config+ensureStdGen c = case QC.replay qcArgs of+  Nothing -> do+    stdGen <- newStdGen+    return c {configQuickCheckArgs = qcArgs {QC.replay = Just (stdGen, 0)}}+  _       -> return c+  where+    qcArgs = configQuickCheckArgs c++-- | Run given spec with custom options.+-- This is similar to `hspec`, but more flexible.+hspecWithOptions :: Options -> Spec -> IO ()+hspecWithOptions opts spec = do+  prog <- getProgName+  args <- getArgs+  c <- getConfig opts prog args+  withArgs [] {- do not leak command-line arguments to examples -} $ do+    r <- hspecWith c spec+    unless (summaryFailures r == 0) exitFailure++-- | Run given spec and returns a summary of the test run.+--+-- /Note/: `hspecResult` does not exit with `exitFailure` on failing spec+-- items.  If you need this, you have to check the `Summary` yourself and act+-- accordingly.+hspecResult :: Spec -> IO Summary+hspecResult = hspecWith defaultConfig++-- | Run given spec with custom options and returns a summary of the test run.+--+-- /Note/: `hspecWith` does not exit with `exitFailure` on failing spec+-- items.  If you need this, you have to check the `Summary` yourself and act+-- accordingly.+hspecWith :: Config -> Spec -> IO Summary+hspecWith c_ spec_ = withHandle c_ $ \h -> do+  c <- ensureStdGen c_+  let formatter = configFormatter c+      seed = (stdGenToInteger . fst . fromJust . QC.replay . configQuickCheckArgs) c+      spec+        | configDryRun c = mapSpecItem markSuccess spec_+        | otherwise      = spec_++  useColor <- doesUseColor h c++  withHiddenCursor useColor h $+    runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do+      runFormatter useColor h c formatter (maybe id filterSpecs (configFilterPredicate c) $ (map toTree . runSpecM) spec) `finally_` do+        failedFormatter formatter++      footerFormatter formatter++      -- dump failure report+      xs <- map failureRecordPath <$> getFailMessages+      liftIO $ writeFailureReport FailureReport {+          failureReportSeed = seed+        , failureReportMaxSuccess = QC.maxSuccess (configQuickCheckArgs c)+        , failureReportMaxSize = QC.maxSize (configQuickCheckArgs c)+        , failureReportMaxDiscardRatio = QC.maxDiscardRatio (configQuickCheckArgs c)+        , 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 configHandle c of+      Left h -> action h+      Right path -> withFile path WriteMode action++isDumb :: IO Bool+isDumb = maybe False (== "dumb") <$> lookupEnv "TERM"++markSuccess :: Item () -> Item ()+markSuccess item = item {itemExample = evaluateExample Success}++-- | 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)
+ src/Test/Hspec/Runner/Eval.hs view
@@ -0,0 +1,145 @@+{-# 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 (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 specs+  where+    mkReportProgress :: IO (Path -> Progress -> IO ())+    mkReportProgress+      | useColor = every 0.05 $ exampleProgress formatter h+      | otherwise = return $ \_ _ -> return ()++    specs = map (fmap (parallelize . fmap (applyNoOpAround . applyParams) . unwrapItem)) specs_++    unwrapItem :: Item () -> (Bool, Params -> ((() -> IO ()) -> IO ()) -> ProgressCallback -> IO Result)+    unwrapItem (Item isParallelizable e) = (isParallelizable, e)++    applyParams :: (Params -> a) -> a+    applyParams = ($ params)+      where+        params = Params (configQuickCheckArgs c) (configSmallCheckDepth c)++    applyNoOpAround :: (((() -> IO ()) -> IO ()) -> b) -> b+    applyNoOpAround = ($ ($ ()))++-- | 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_ (zip [0..] specs) (queueSpec [])+    writeChan chan Done+  processMessages (readChan chan) (configFastFail c)+  where+    defer :: FormatM () -> IO ()+    defer = writeChan chan . Run++    queueSpec :: [String] -> (Int, EvalTree) -> IO ()+    queueSpec rGroups (n, Node group xs) = do+      defer (exampleGroupStarted formatter n (reverse rGroups) group)+      forM_ (zip [0..] xs) (queueSpec (group : rGroups))+      defer (exampleGroupDone formatter)+    queueSpec rGroups (_, Leaf requirement e) =+      queueExample (reverse rGroups, requirement) e++    queueExample :: Path -> (ProgressCallback -> FormatResult -> IO (FormatM ())) -> IO ()+    queueExample path e = e reportProgress formatResult >>= defer+      where+        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 (Right err)+            Left err         -> failed (Left  err)+          where+            failed err = do+              increaseFailCount+              addFailMessage 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 ()
+ src/Test/Hspec/Runner/Tree.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE DeriveFunctor #-}+module Test.Hspec.Runner.Tree where++import           Test.Hspec.Core.Type++data Tree a+  = Node String [Tree a]+  | Leaf String a+  deriving (Eq, Show, Functor)++toTree :: SpecTree () -> Tree (Item ())+toTree spec = case spec of+  SpecGroup label specs -> Node label (map toTree specs)+  SpecItem r item -> Leaf r item
+ src/Test/Hspec/Timer.hs view
@@ -0,0 +1,14 @@+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
+ src/Test/Hspec/Util.hs view
@@ -0,0 +1,106 @@+module Test.Hspec.Util (+  pluralize+, lineBreaksAt+, safeTry+, Path+, filterPredicate+, formatRequirement+, strip+, stdGenToInteger+, stdGenFromInteger+) where++import           Data.Int (Int32)+import           Data.List+import           Data.Char (isSpace)+import           Control.Applicative+import qualified Control.Exception as E+import           System.Random (StdGen)++-- | Create a more readable display of a quantity of something.+--+-- Examples:+--+-- >>> pluralize 0 "example"+-- "0 examples"+--+-- >>> pluralize 1 "example"+-- "1 example"+--+-- >>> pluralize 2 "example"+-- "2 examples"+pluralize :: Int -> String -> String+pluralize 1 s = "1 " ++ s+pluralize n s = show n ++ " " ++ s ++ "s"++safeTry :: IO a -> IO (Either E.SomeException a)+safeTry action = (Right <$> (action >>= E.evaluate)) `E.catches` [+  -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT+  -- (ctrl-c).  All AsyncExceptions are re-thrown (not just UserInterrupt)+  -- because all of them indicate severe conditions and should not occur during+  -- normal operation.+    E.Handler $ \e -> E.throwIO (e :: E.AsyncException)++  , E.Handler $ \e -> (return . Left) (e :: E.SomeException)+  ]++-- |+-- A tuple that represents the location of an example within a spec.+--+-- It consists of a list of group descriptions and a requirement description.+type Path = ([String], String)++-- | A predicate that can be used to filter specs.+filterPredicate :: String -> Path -> Bool+filterPredicate pattern path@(groups, requirement) =+     pattern `isInfixOf` plain+  || pattern `isInfixOf` formatted+  where+    plain = intercalate "/" (groups ++ [requirement])+    formatted = formatRequirement path++-- |+-- Try to create a proper English sentence from a path by applying some+-- heuristics.+formatRequirement :: Path -> String+formatRequirement (groups, requirement) = groups_ ++ requirement+  where+    groups_ = case break (any isSpace) groups of+      ([], ys) -> join ys+      (xs, ys) -> join (intercalate "." xs : ys)++    join xs = case xs of+      [x] -> x ++ " "+      ys  -> concatMap (++ ", ") ys++-- 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++-- | Converts a 'StdGen' into an 'Integer'. Assumes+--   StdGens to be encoded as two positive 'Int32's and+--   $show (StdGen a b) = show a ++ " " ++ show b$.+stdGenToInteger :: StdGen -> Integer+stdGenToInteger stdGen =+  let [a, b] = map read . words $ show stdGen+  in b * fromIntegral (maxBound :: Int32) + a++-- | Inverse of 'stdGenToInteger'.+stdGenFromInteger :: Integer -> StdGen+stdGenFromInteger n =+  let (a, b) = quotRem n (fromIntegral (maxBound :: Int32))+  in read (show b ++ " " ++ show a)
+ test/Helper.hs view
@@ -0,0 +1,85 @@+module Helper (+  module Test.Hspec.Meta+, module Test.QuickCheck+, module Control.Applicative+, module System.IO.Silently+, sleep+, timeout+, defaultParams+, noOpProgressCallback+, captureLines+, normalizeSummary++, ignoreExitCode+, ignoreUserInterrupt++, shouldStartWith+, shouldEndWith++, shouldUseArgs+) 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           Data.Time.Clock.POSIX+import           System.IO.Silently++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++ignoreExitCode :: IO () -> IO ()+ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return ()++ignoreUserInterrupt :: IO () -> IO ()+ignoreUserInterrupt action = action `E.catch` \e -> unless (e == E.UserInterrupt) (E.throwIO e)++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 xs = map f xs+  where+    f x | "Finished in " `isPrefixOf` x = map g x+        | otherwise = x+    g x | isNumber x = '0'+        | otherwise  = x++defaultParams :: H.Params+defaultParams = H.Params (H.configQuickCheckArgs H.defaultConfig) (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)
+ test/Mock.hs view
@@ -0,0 +1,15 @@+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
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-}
+ test/Test/Hspec/CompatSpec.hs view
@@ -0,0 +1,33 @@+{-# 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
+ test/Test/Hspec/Core/TypeSpec.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE TypeFamilies #-}+module Test.Hspec.Core.TypeSpec (main, spec) where++import           Helper+import           Mock+import           Data.List+import           Data.IORef+import           Control.Exception (AsyncException(..), throwIO)++import qualified Test.Hspec.Core.Type as H hiding (describe, it)+import qualified Test.Hspec as H+import qualified Test.Hspec.Runner as H++main :: IO ()+main = hspec spec++evaluateExample :: (H.Example e,  H.Arg e ~ ()) => e -> IO H.Result+evaluateExample e = H.evaluateExample e (defaultParams {H.paramsQuickCheckArgs = (H.paramsQuickCheckArgs defaultParams) {replay = Just (read "", 0)}}) ($ ()) noOpProgressCallback++evaluateExampleWith :: (H.Example e, H.Arg e ~ ()) => (IO () -> IO ()) -> e -> IO H.Result+evaluateExampleWith action e = H.evaluateExample e (defaultParams {H.paramsQuickCheckArgs = (H.paramsQuickCheckArgs defaultParams) {replay = Just (read "", 0)}}) (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 y -> x + y == (x * y :: Int)+        r `shouldBe` intercalate "\n" [+            "Falsifiable (after 1 test and 2 shrinks): "+          , "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` 200++      context "when used with shouldBe" $ do+        it "shows what falsified it" $ do+          H.Fail r <- evaluateExample $ property $ \x y -> x + y `shouldBe` (x * y :: Int)+          r `shouldBe` intercalate "\n" [+              "Falsifiable (after 1 test and 2 shrinks): "+            , "expected: 0"+            , " but got: 1"+            , "0"+            , "1"+            ]++      it "propagates UserInterrupt" $ do+        let p = property (throwIO UserInterrupt :: Expectation)+        evaluateExample p `shouldThrow` (== UserInterrupt)++      it "propagates exceptions" $ do+        pendingWith "this probably needs a patch to QuickCheck"+        -- evaluateExample (property $ (error "foobar" :: Int -> Bool)) `shouldThrow` errorCall "foobar"++      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
+ test/Test/Hspec/FailureReportSpec.hs view
@@ -0,0 +1,39 @@+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
+ test/Test/Hspec/FormattersSpec.hs view
@@ -0,0 +1,220 @@+{-# 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(..))+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.hspecWith H.defaultConfig {H.configFormatter = 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.hspecWith H.defaultConfig {H.configFormatter = 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.hspecWith H.defaultConfig {H.configFormatter = 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 "prints an empty line before each group" $ do+      r <- runSpec $ do+        H.describe "foo" $ do+          H.it "example 1" True+          H.it "example 2" True+          H.describe "bar" $ do+            H.it "example 3" True+            H.it "example 4" True+      normalizeSummary r `shouldBe` [+          ""+        , "foo"+        , "  - example 1"+        , "  - example 2"+        , ""+        , "  bar"+        , "    - example 3"+        , "    - example 4"+        , ""+        , "Finished in 0.0000 seconds"+        , "4 examples, 0 failures"+        ]++    it "prints an empty line after each group" $ do+      r <- runSpec $ do+        H.describe "foo" $ do+          H.describe "bar" $ do+            H.it "example 1" True+            H.it "example 2" True+          H.it "example 3" True+          H.it "example 4" True+      normalizeSummary r `shouldBe` [+          ""+        , "foo"+        , "  bar"+        , "    - example 1"+        , "    - example 2"+        , ""+        , "  - example 3"+        , "  - example 4"+        , ""+        , "Finished in 0.0000 seconds"+        , "4 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 "same as failed_examples" $ do+      failed_examplesSpec H.progress++failed_examplesSpec :: H.Formatter -> Spec+failed_examplesSpec formatter = do+  let runSpec = captureLines . H.hspecWith H.defaultConfig {H.configFormatter = 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")++  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.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do+      H.it "foobar" True+    r `shouldSatisfy` any (== (green ++ "1 example, 0 failures" ++ reset))++  it "shows summary in yellow if there are pending examples" $ do+    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do+      H.it "foobar" H.pending+    r `shouldSatisfy` any (== (yellow ++ "1 example, 0 failures, 1 pending" ++ reset))++  it "shows summary in red if there are failures" $ do+    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do+      H.it "foobar" False+    r `shouldSatisfy` any (== (red ++ "1 example, 1 failure" ++ reset))++  it "shows summary in red if there are both failures and pending examples" $ do+    r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.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
+ test/Test/Hspec/HUnitSpec.hs view
@@ -0,0 +1,49 @@+module Test.Hspec.HUnitSpec (main, spec) where++import           Helper++import           Test.Hspec.Core.Type (SpecTree(..), runSpecM)+import           Test.Hspec.HUnit+import           Test.HUnit++main :: IO ()+main = hspec spec++-- SpecTree does not have an Eq nor a Show instance, hence we map it to `Tree`.+data Tree = Group String [Tree] | Example String+  deriving (Eq, Show)++shouldYield :: Test -> [Tree] -> Expectation+a `shouldYield` b = (convert . runSpecM . fromHUnitTest) a `shouldBe` b+  where+    convert :: [SpecTree ()] -> [Tree]+    convert = map go+      where+        go :: SpecTree () -> Tree+        go x = case x of+          SpecGroup s xs  -> Group s (map go xs)+          SpecItem requirement _ -> Example requirement++spec :: Spec+spec = do+  describe "fromHUnitTest" $ do+    let e = TestCase $ pure ()++    it "works for a TestCase" $ do+      e `shouldYield` [Example "<unlabeled>"]++    it "works for a labeled TestCase" $ do+      TestLabel "foo" e+        `shouldYield` [Example "foo"]++    it "works for a TestCase with nested labels" $ do+      (TestLabel "foo" . TestLabel "bar") e+        `shouldYield` [Group "foo" [Example "bar"]]++    it "works for a flat TestList" $ do+      TestList [e, e, e]+        `shouldYield` [Example "<unlabeled>", Example "<unlabeled>", Example "<unlabeled>"]++    it "works for a nested TestList" $ do+      (TestLabel "foo" . TestLabel "bar" . TestList) [TestLabel "one" e, TestLabel "two" e, TestLabel "three" e]+        `shouldYield` [Group "foo" [Group "bar" [Example "one", Example "two", Example "three"]]]
+ test/Test/Hspec/OptionsSpec.hs view
@@ -0,0 +1,44 @@+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 defaultOptions "my-spec"++    it "sets optionsColorMode to ColorAuto" $ do+      optionsColorMode <$> parseOptions [] `shouldBe` Right ColorAuto++    context "with --no-color" $ do+      it "sets optionsColorMode to ColorNever" $ do+        optionsColorMode <$> parseOptions ["--no-color"] `shouldBe` Right ColorNever++    context "with --color" $ do+      it "sets optionsColorMode to ColorAlways" $ do+        optionsColorMode <$> parseOptions ["--color"] `shouldBe` Right ColorAlways++    context "with --out" $ do+      it "sets optionsOutputFile" $ do+        optionsOutputFile <$> 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+        optionsDepth <$> parseOptions ["--depth", "23"] `shouldBe` Right (Just 23)
+ test/Test/Hspec/QuickCheckSpec.hs view
@@ -0,0 +1,19 @@+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
+ test/Test/Hspec/RunnerSpec.hs view
@@ -0,0 +1,393 @@+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 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.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)]++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+        let runSpec_ = (captureLines . ignoreExitCode . H.hspec) $ do+              H.it "foo" $ property $ (/= (26 :: Integer))++        r0 <- withArgs ["--seed", "2413421499272008081"] runSpec_+        r0 `shouldContain` [+            "Falsifiable (after 66 tests): "+          , "26"+          ]++        r1 <- withArgs ["-r"] runSpec_+        r1 `shouldContain` [+            "Falsifiable (after 66 tests): "+          , "26"+          ]++      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+        r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do+          H.it "foo" False+          H.it "bar" $ do+            E.throwIO E.UserInterrupt :: IO ()+          H.it "baz" True+        normalizeSummary r `shouldBe` [+            ""+          , "- foo FAILED [1]"+          , ""+          , "1) foo"+          , ""+          , "Randomized with seed 23"+          , ""+          ]++      it "throws UserInterrupt" $ do+        silence . H.hspec $ do+          H.it "foo" $ do+            E.throwIO E.UserInterrupt :: IO ()+        `shouldThrow` (== 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+      it "produces a report" $ do+        r <- captureLines . withArgs ["--dry-run"] . H.hspec $ 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+        _ <- captureLines . withArgs ["--dry-run"] . H.hspec $ do+          H.it "foo" (mockAction e)+          H.it "bar" False+        mockCounter e `shouldReturn` 0++    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 <- captureLines . ignoreExitCode . withArgs ["--seed", "2413421499272008081"] . H.hspec $ do+            H.it "foo" $+              property (/= (26 :: Integer))+        r `shouldContain` [+            "Falsifiable (after 66 tests): "+          , "26"+          ]++      context "when run with --rerun" $ do+        it "takes precedence" $ do+          let runSpec args = capture_ . ignoreExitCode . withArgs args . H.hspec $ do+                H.it "foo" $+                  property $ \n -> ((17 + 31 * n) `mod` 50) /= (23 :: Integer)+          r0 <- runSpec ["--seed", "23"]+          r0 `shouldContain` "(after 88 tests)"++          r1 <- runSpec ["--seed", "42"]+          r1 `shouldContain` "(after 48 tests)"++          r2 <- runSpec ["--rerun", "--seed", "23"]+          r2 `shouldContain` "(after 88 tests)"++      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" (E.throwIO (E.ErrorCall "foobar") >> pure ())+      `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.hspecWith H.defaultConfig {H.configFormatter = 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)
+ test/Test/Hspec/TimerSpec.hs view
@@ -0,0 +1,29 @@+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
+ test/Test/Hspec/UtilSpec.hs view
@@ -0,0 +1,108 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Test.Hspec.UtilSpec (main, spec) where++import           Helper+import           Data.Int (Int32)+import           System.Random (StdGen)+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 "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 (E.throwIO E.DivideByZero :: IO Int)+      show e `shouldBe` "divide by zero"++    it "evaluates result to weak head normal form" $ do+      Left e <- safeTry (return undefined)+      show e `shouldBe` "Prelude.undefined"++    it "re-throws AsyncException" $ do+      safeTry (E.throwIO E.UserInterrupt :: IO Int) `shouldThrow` (== 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"++  describe "stdGenToInteger" $ do+    it "is inverse to stdGenFromInteger" $ property $+      \(NonNegative i) -> (stdGenToInteger . stdGenFromInteger) i `shouldBe` i++  describe "stdGenFromInteger" $ do+    it "is inverse to stdGenToInteger" $ property $+      \stdGen -> (stdGenFromInteger . stdGenToInteger) stdGen `shouldBe` stdGen++instance Eq StdGen where+  a == b = show a == show b++instance Arbitrary StdGen where+  arbitrary = do+    (Positive a, Positive b) <- arbitrary+    return $ read (show (a :: Int32) ++ " " ++ show (b :: Int32))
+ test/Test/HspecSpec.hs view
@@ -0,0 +1,226 @@+module Test.HspecSpec (main, spec) where++import           Helper+import           Data.IORef+import           Data.List (isPrefixOf)++import           Test.Hspec.Core (SpecTree(..), Item(..), Result(..), runSpecM)+import qualified Test.Hspec as H+import qualified Test.Hspec.Runner as H (hspecResult)++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+      let [SpecGroup foo [SpecGroup bar [SpecItem baz _]]] = runSpecM $ do+            H.describe "foo" $ do+              H.describe "bar" $ do+                H.it "baz" True+      (foo, bar, baz) `shouldBe` ("foo", "bar", "baz")++    context "when no description is given" $ do+      it "uses a default description" $ do+        let [SpecGroup d _] = runSpecM (H.describe "" (pure ()))+        d `shouldBe` "(no description given)"++  describe "it" $ do+    it "takes a description of a desired behavior" $ do+      let [SpecItem requirement _] = runSpecM (H.it "whatever" True)+      requirement `shouldBe` "whatever"++    it "takes an example of that behavior" $ do+      let [SpecItem _ item] = runSpecM (H.it "whatever" True)+      itemExample item defaultParams ($ ()) noOpProgressCallback `shouldReturn` Success++    context "when no description is given" $ do+      it "uses a default description" $ do+        let [SpecItem requirement _] = runSpecM (H.it "" True)+        requirement `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+      let [SpecItem _ item] = runSpecM . H.parallel $ H.it "whatever" True+      itemIsParallelizable item `shouldBe` True++    it "is applied recursively" $ do+      let [SpecGroup _ [SpecGroup _ [SpecItem _ item]]] = runSpecM . 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 every spec item" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+      silence $ H.hspec $ H.before (append "before") $ do+        H.it "foo" $ do+          append "foo"+        H.it "bar" $ do+          append "bar"+      readIORef ref `shouldReturn` [+          "before"+        , "foo"+        , "before"+        , "bar"+        ]++    context "when used multiple times" $ do+      it "is evaluated outside in" $ do+        ref <- newIORef ([] :: [String])+        let append n = modifyIORef ref (++ return n)+        silence $ H.hspec $ H.before (append "before outer") $  H.before (append "before inner") $ do+          H.it "foo" $ do+            append "foo"+        readIORef ref `shouldReturn` [+            "before outer"+          , "before inner"+          , "foo"+          ]++    context "when used with an action that returns a value" $ do+      it "passes that value to the spec item" $ do+        property $ \n -> do+          silence $ H.hspec $ H.before (return n) $ do+            H.it "foo" $ \m -> do+              m `shouldBe` (n :: Int)++    context "when used with a QuickCheck property" $ do+      it "runs action before every check of the property" $ do+        ref <- newIORef ([] :: [String])+        let append n = modifyIORef ref (++ return n)+        silence $ H.hspec $ H.before (append "before") $ do+          H.it "foo" $ property $ append "foo"+        readIORef ref `shouldReturn` (take 200 . cycle) ["before", "foo"]++  describe "after" $ do+    it "must be used with a before action" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+      silence $ H.hspec $ H.before (return "from before") $ H.after append $ do+        H.it "foo" $ \_ -> do+          append "foo"+      readIORef ref `shouldReturn` [+          "foo"+        , "from before"+        ]++  describe "after_" $ do+    it "runs an action after every spec item" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+      silence $ H.hspec $ H.after_ (append "after") $ do+        H.it "foo" $ do+          append "foo"+        H.it "bar" $ do+          append "bar"+      readIORef ref `shouldReturn` [+          "foo"+        , "after"+        , "bar"+        , "after"+        ]++    it "guarantees that action is run" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+      silence . ignoreExitCode $ H.hspec $ H.after_ (append "after") $ do+        H.it "foo" $ do+          ioError $ userError "foo" :: IO ()+          append "foo"+      readIORef ref `shouldReturn` ["after"]++    context "when used multiple times" $ do+      it "is evaluated inside out" $ do+        ref <- newIORef ([] :: [String])+        let append n = modifyIORef ref (++ return n)+        silence $ H.hspec $ H.after_ (append "after outer") $  H.after_ (append "after inner") $ do+          H.it "foo" $ do+            append "foo"+        readIORef ref `shouldReturn` [+            "foo"+          , "after inner"+          , "after outer"+          ]++  describe "around" $ do+    it "wraps every spec item with an action" $ do+      property $ \n -> do+        silence $ H.hspec $ H.around ($ n) $ do+          H.it "foo" $ \m -> do+            m `shouldBe` (n :: Int)++  describe "around_" $ do+    it "wraps every spec item with an action" $ do+      ref <- newIORef ([] :: [String])+      let append n = modifyIORef ref (++ return n)+          action e = append "before" >> e >> append "after"+      silence $ H.hspec $ H.around_ action $ do+        H.it "foo" $ do+          append "foo"+        H.it "bar" $ do+          append "bar"+      readIORef ref `shouldReturn` [+          "before"+        , "foo"+        , "after"+        , "before"+        , "bar"+        , "after"+        ]++    context "when used multiple times" $ do+      it "is evaluated outside in" $ do+        ref <- newIORef ([] :: [String])+        let append n = modifyIORef ref (++ return n)+            actionOuter e = append "before outer" >> e >> append "after outer"+            actionInner e = append "before inner" >> e >> append "after inner"+        silence $ H.hspec $ H.around_ actionOuter $ H.around_ actionInner $ do+          H.it "foo" $ do+            append "foo"+        readIORef ref `shouldReturn` [+            "before outer"+          , "before inner"+          , "foo"+          , "after inner"+          , "after outer"+          ]+  where+    runSpec :: H.Spec -> IO [String]+    runSpec = captureLines . H.hspecResult
+ test/doctests.hs view
@@ -0,0 +1,6 @@+module Main where++import           Test.DocTest++main :: IO ()+main = doctest ["-isrc", "-optP-include", "-optPdist/build/autogen/cabal_macros.h", "src/Test/Hspec/Util.hs", "src/Test/Hspec/Formatters.hs"]