packages feed

hspec-meta 2.3.2 → 2.4.4

raw patch · 31 files changed

+1881/−710 lines, 31 filesdep +arrayPVP ok

version bump matches the API change (PVP)

Dependencies added: array

API changes (from Hackage documentation)

+ Test.Hspec.Meta: xcontext :: String -> SpecWith a -> SpecWith a
+ Test.Hspec.Meta: xdescribe :: String -> SpecWith a -> SpecWith a
+ Test.Hspec.Meta: xit :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
+ Test.Hspec.Meta: xspecify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
- Test.Hspec.Meta: specify :: Example a => String -> a -> SpecWith (Arg a)
+ Test.Hspec.Meta: specify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)

Files

+ CHANGES.markdown view
@@ -0,0 +1,484 @@+## Changes in 2.4.3+  - Read command-line options from environment variable `HSPEC_OPTIONS`++## Changes in 2.4.2+  - Use `--diff` by default+  - Add `--failure-report` (see #266)++## Changes in 2.4.1+  - Compatibility with HUnit < 1.3++## Changes in 2.4.0+  - Read command-line options from config files `~/.hspec` and `.hspec`+  - Add support for `--diff`+  - Add `xit`, `xspecify`, `xdescribe` and `xcontext` (see #252)+  - Add `--rerun-all-on-success`+  - Report exceptions in `beforeAll` operations only once+  - Add indentation when actual/expected contain newlines (see #263)+  - More graceful shutdown on ctrl-c (see #270)+  - Run around-hook for Bool and Result (see #252)+  - Include `CHANGES.markdown` in package tarball++Internal changes:++  - Rename `Fail` constructor of `Result`-type to `Failure`+  - Add `FailureReason` type+  - Add `Test.Hspec.Core.Spec.safeEvaluateExample`++## Changes in 2.3.2+  - Compatibility with HUnit 1.5++## Changes in 2.3.1+  - Fix build for HUnit < 1.4++## Changes in 2.3.0+  - Proper support for GHC 8 call stacks++## Changes in 2.2.4+  - Compatibility with QuickCheck-2.9++## Changes in 2.2.3+  - Make sure that `cabal haddock` works for `hspec-discover`+  - Forward compatibility for HUnit 1.4+  - Fix tests for GHC 8.0.1-rc1++## Changes in 2.2.2+  - Fix compilation for GHC 8.0.1-rc1++## Changes in 2.2.1+  - Make sure that Vim's default `errorformat` recognizes exact locations+  - GHCJS compatibility++## Changes in 2.2.0+  - Add source locations to test `Result`++## Changes in 2.1.10+  - GHC 7.0.* compatibility++## Changes in 2.1.9+  - Make use of GHC 7.10.2 source locations+  - Add `--jobs`++## Changes in 2.1.8+  - Depend on `hspec-expectations-0.7.0"++## Changes in 2.1.7+  - Add `beforeAll_`++## Changes in 2.1.6+  - If there were no previous failures, run all spec items on `--rerun`++## Changes in 2.1.5+  - Compatibility with QuickCheck-2.8++## Changes in 2.1.4+  - Make `hspec-discover` ignore modules with invalid module names, this fixes+    issues with `flycheck`'s temporary files++## Changes in 2.1.3+  - Format source locations like gcc does++## Changes in 2.1.2+  - Re-export `before_` from `Test.Hspec`++## Changes in 2.1.1+  - Add `before_`+  - Add command-line option `--skip`++## Changes in 2.1.0+  - Generalize `after_`, `afterAll_` and `around_`++## Changes in 2.0.2+  - Indent error messages for failed examples (fixes #186)+  - Export `defaultParams` from `Test.Hspec.Core.Example`+  - Bring back `Test.Hspec.HUnit` and deprecate it to provide a smother upgrade+    path++## Changes in 2.0.1+  - Add missing extra source files to for `hspec-discover`++## Changes in 2.0.0+  - Split package into `hspec`, `hspec-core` and `hspec-discover`+  - Allow hooks (`before`, `around`, etc.) to pass arguments to spec items+  - Do not print `-` in front of spec items with `specdoc` formatter+  - Move `Test.Hspec.HUnit` to `hspec-contrib`++## Changes in 1.12.4+  - Add `specGroup` and `specItem` to `Test.Hspec.Core`+  - Deprecate `Test.Hspec.Core.it` and `Test.Hspec.Core.describe`++## Changes in 1.12.3+  - Make `hspec-discover` work with `-XNoImplicitPrelude`++## Changes in 1.12.2+  - Include `IOErrorType` when printing uncaught `IOException`s (see #204)++## Changes in 1.12.1+  - Add `--module-name` option to `hspec-discover` (see #168)++## Changes in 1.12.0+  - Add optional source location to spec items+  - Move item requirement text from `SpecItem` constructor to `Item` data type+  - Remove `BuildSpecs` constructor from `SpecTree`, having `runIO` this is not+    really needed+  - Add `mapSpecTree` to `Test.Hspec.Core`+  - Add `afterAll` (see #188)+  - Do not return `Result` from `hspecWith` and accept command-line options+    (the old behavior is still available as `hspecWithResult`)+  - Rename `configHandle` to `configOutputFile`+  - Omit empty `describe` groups from report+  - Do not pass position to `Formatter.exampleGroupStarted` (we can not support+    this with the upcomming cleanup actions #188)+  - Do not print empty lines before/after spec groups+  - Deprecate `Test.Hspec.Formatters.newParagraph`++## Changes in 1.11.4+  - Make test suite independent from QuickCheck seed (see #187)++## Changes in 1.11.3+  - Depend on `hspec-expectations-0.6.1`++## Changes in 1.11.2+  - Add `beforeAll`++## Changes in 1.11.1+ - Add `specify` as an alias for `it`++## Changes in 1.11.0+ - Add `BuildSpecs` constructor to internal `SpecTree` data structure.  This+   allows you to do `IO` while constructing the spec tree.+ - Add `runIO`++## Changes in 1.10.0+ - Do not use exception type to distinguish between synchronous/asynchronous+   exceptions (thanks to Michael Snoyman)+ - Remove `Example` instance for `Test.HUnit.Test` (#101), use+   `Test.Hspec.HUnit.fromHUnitTest` instead.+ - Do not reexport `property` from `Test.Hspec.QuickCheck`+ - Move `ProgressCallback` out of `Params`+ - Add show instance for `Params`+ - Move requirement text from `Item` to `SpecItem` constructor+ - Remove deprecated modules and functions++## Changes in 1.9.5+ - Make sure that ctrl-c works properly with GHC 7.8.* and QuickCheck-2.6++## Changes in 1.9.4+ - Compatibility with transformers-0.4.0.0++## Changes in 1.9.3+ - Make internal Tree data structure more strict (#169)++## Changes in 1.9.2+ - Print type of exceptions that are raised from QuickCheck properties (#94)++## Changes in 1.9.1+ - Bring back compatibility with older versions of QuickCheck (#166)++## Changes in 1.9.0+ - Depend on QuickCheck 2.7++## Changes in 1.8.3+ - Do not use color if `TERM=dumb` (see #158)++## Changes in 1.8.2+ - `hspec-discover` now accepts `--no-main` which results in a top-level spec+   being generated instead of a test driver (thanks @DanielG)+ - Make sure that `after` is run on failing tests (see #159)++## Changes in 1.8.1+ - Add `shouldMatchList`++## Changes in 1.8.0+ - Run `before`/`after`/`around` for each single check of a QuickCheck property+ - Add `Test.Hspec.Core.mapSpecItem`+ - Add `modifyMaxSuccess`, `modifyMaxDiscardRatio` and `modifyMaxSize` to+   `Test.Hspec.QuickCheck`+ - Don't fail if callback is not called in `around`+ - `hspec-discover`: Remove `--nested` option+ - `hspec-discover`: Ignore `Spec.hs`/`Spec.lhs`++## Changes in 1.7.2+ - Add `after` and `around`++## Changes in 1.7.1+ - Add `shouldContain` (thanks to Alfredo Di Napoli)+ - When printing progress, skip total if it is 0+ - Do not colorize the description/requirement in failure list++## Changes in 1.7.0+ - Add `--depth` for use with `hspec-smallcheck`++## Change in 1.6.2+ - Add `before`+ - Add `--qc-max-discard` and `--qc-max-size`++## Changes in 1.6.1+ - Allow to specify the output file with `--out`++## Changes in 1.6.0+ - Add support for parallelization+ - Change license to MIT+ - Add MonadIO instance for FormatM+ - Add support for custom formatters to hspec-discover+ - Add hspecResult+ - Rename `--re-run` to `--rerun` + add documentation (#95)+ - Remove `configVerbose`+ - Use same `--qc-max-success` on `--rerun` (#125)+ - Add command-line option `--no-color`, `--color` does not accept arguments+   anymore (#130)++## Changes in 1.5.4+ - Make sure that QuickCheck is never chatty+ - Make sure progress for QuickCheck examples is shown++## Changes in 1.5.3+ - Print "Randomized with seed ..." only once++## Changes in 1.5.2+ - Add `--seed`, it can be used to specify the seed for QuickCheck properties+ - Reuse previous seed on `--re-run`++## Changes in 1.5.1+ - Depend on quickcheck-io++## Changes in 1.5.0+ - Allow to use expectations as QuickCheck properties (#80)+ - Do not suppress output to `stdout`+ - Change type of `pending` to `Expectation`, add `pendingWith` (#121)+ - Add the `example` function, it fixes the type of an Expectation (#86)+ - Rename `--fast-fail` to `--fail-fast` (for consistency with RSpec)+ - Do not clutter Cabal test suite logs with QuickCheck output (#112)+ - Skip redundant output from QuickCheck failure messages (#102)++## Changes in 1.4.5+ - hspec-discover now discovers .lhs files, too++## Changes in 1.4.4+ - Visually distinguish error message from requirements in the summary (#100)+ - Export `formatException` from `Test.Hspec.Formatters`+ - Add `--fast-fail` (#82)+ - Print a summary on UserInterrupt/ctrl-c (#107)++## Changes in 1.4.3+ - Add `--dry-run` (#111)++## Changes in 1.4.2+ - Properly handle ctrl-c while running QuickCheck properties (#93)+ - Default to `--color=always` when `--color` is used without argument (#106)+ - treat `--qc-max-success` as an alias for `--maximum-generated-tests`++## Changes in 1.4.1+ - Used CPU time is now only included in the test summary if run with+   `--print-cpu-time`.++## Changes in 1.4.0+ - We now have a manual at http://hspec.github.io/.  The sources are in+   `doc/`.  It's still work in progress.  Contributions are very welcome!+ - The Haddock documentation now indicates the stability of each exposed+   module.  `Test.Hspec` is now considered stable.+ - `hspec` now supports command-line options+   - `--color` can be used to enable/disable colored output+   - `--format` can be used to pick a specific formatter+   - `--html` can be used to produce an HTML report+   - `--maximum-generated-tests` can be used to specify QuickCheck's+     `maxSuccess`+   - `--match` only runs spec items that match a given string+   - `--re-run` only runs spec items that previously failed.  This is+     undocumented,+     experimental and only works within GHCi (use `:reload` / `:main`)!+ - Runner functions exported from `Test.Hspec.Runner` new expect a monadic+   spec.+ - `fromHUnitTest` has been added.  It can be used to run existing HUnit test+   suites with Hspec.+ - The `Example` instance for HUnit `Test`s has been deprecated.+   `fromHUnitTest` can be used instead.  The primary motivation is, that+   `fromHUnitTest` gives more detailed reporting for nested HUnit test suites.+ - `Test.Hspec.Monadic` has been deprecated, all functionality is available+   through one of `Test.Hspec`, `Test.Hspec.Core` or `Test.Hspec.Runner`.+ - More of Hspec's internals are now exposed from `Test.Hspec.Core`+ - All runner functions for the core spec type (aka as non-monadic spec) have+   been deprecated, use e.g. `Test.Hspec.hspec . fromSpecList` instead.  The+   motivation is to provide an API that does not expose colliding names.+ - Some other stuff from `Test.Hspec.Core` that collides with other parts of+   the API has been deprecated.  Compatible alternatives are given in each+   deprecation message.+ - The default formatter now produces less whitespace (#73) + other minor+   improvements+ - The formatter API has been revamped.+ - The exception type is now printed if an example fails due to an exception+   (#50)+ - The number of pending examples is now printed after each test run (#85)+ - `--verbose` has been added (#87)++## Changes in 1.3.0++ - `Test.Hspec` now re-exports the monadic API.  If you still use the+   non-monadic API, you can use `Test.Hspec.Core` as a drop-in replacement.++ - `hspec-expectations`, a set of combinators that allow to express+   expectations about the outcome of code examples, is now included with Hspec.+   Have a look at the [README of `hspec-expectations`]+   (https://github.com/sol/hspec-expectations#readme)+   for a short introduction.++ - `hspec-discover`, a mechanism for automatic spec discovery, is now an+   official part of Hspec.+   Have a look at [`hspec-discover`'s README]+   (https://github.com/hspec/hspec/tree/master/hspec-discover#readme)+   for a short introduction.++## Changes in 1.2.0++ - `hspec` has been removed, and `hspecX` has been renamed to `hspec` (see+   [#71](https://github.com/hspec/hspec/issues/71))++ - `hHspec` now returns a summary of the test run.++ - The time reporting after a test run is not colored anymore.++## Changes in 1.1.3++ - `Test.Hspec` warns now about future changes: It will re-export+   `Test.Hspec.Monadic` in the future.  If you still use the non-monadic API,+   you can either use `Test.Hspec.Core` as a drop-in replacement, or migrate your+   code to the monadic API.++   The monadic API is more stable and easier to use.  Now is a good time to+   switch!++ - `Test.Hspec.Core` is now a proper superset of `Test.Hspec`++## Changes in 1.1.2++ * All descriptions of nested examples are now included in summary for failing+   examples++ * `context` is now an alias for `describe`++## Changes in 1.1.1++ * Specs from Test.Hspec.Monadic has been renamed to Spec.  For backward+   compatibility Specs is still kept as an alias.++## Changes in 1.1.0++### The reason for pending examples is now optional++With this change, both of the following code snippets work.++```haskell+it "some behavior" $+  pending  -- no reason given+```++```haskell+it "some other behavior" $+  pending "some reason"+```++### Hspec does not rely on ExistentialQuantification anymore++### The type used to represent specs is now abstract++This should give more useful error messages when adapting old specs that use+the non-monadic API for `hspec-1.0`/`hspec-1.1`.++### Several internal types and functions have been deprecated++Those are internal functions, and they will be removed/hidden with the next+release.  If you use any of those, update your code.  If you really need them,+[open a ticket](https://github.com/hspec/hspec/issues) and describe your use+case.++## Changes in 1.0.0++### Hspec now re-uses QuickCheck's property function++`Test.Hspec.QuickCheck.property` is now simply a re-exports of+`Test.QuickCheck.property`.  This has the advantage that you do not get a name+collision if you import both, `Test.Hspec.QuickCheck` and `Test.QuickCheck`.++### Better support for nested specs++*NOTE: This is a breaking change to the non-monadic API.  The monadic API is+not affected.*++In some situations parent descriptions for nested specs were not included in+the generated report.  Solving this required a change to the data structure+that is used to represent specs (it was not a proper tree, now it is).++#### Updating specs that use the non-monadic API++The runner functions (`hspec`, `hspecB` and `hspecX`) now take a list of+descriptions.++The following works with `hspec-0.9`, but not with `hspec-1.0`.++```haskell+main = hspecX $+  describe "reverse" [+    it "reverses a list" $+      reverse [1, 2, 3] == [3, 2, 1],++    it "gives the original list, if applied twice" $ property $+      \xs -> reverse (reverse xs) == (xs :: [Int])+  ]++```++For `hspec-1.0`, you need to wrap it into a list.++```haskell+main = hspecX [+    describe "reverse" [+      it "reverses a list" $+        reverse [1, 2, 3] == [3, 2, 1],++      it "gives the original list, if applied twice" $ property $+        \xs -> reverse (reverse xs) == (xs :: [Int])+    ]+  ]+```++Specs consisting of several *desribes*, combined with `descriptions`, continue+to work unchanged.  But `descriptions` is now a noop, and it will be removed in+a future release.  So it is a good idea to drop it.++The following works with both `hspec-0.9` and `hspec-1.0`.++```haskell+main = hspecX $ descriptions [  -- descriptions is redundant+    describe "Foo" [+      it "has some behavior" True+    ]+  , describe "Bar" [+      it "has some behavior" True+    ]+  ]+```++But the following is recommended instead.++```haskell+main = hspecX [+    describe "Foo" [+      it "has some behavior" True+    ]+  , describe "Bar" [+      it "has some behavior" True+    ]+  ]+```++### A new monadic API for custom Formatters++For all the details, have a look at the [docs]+(http://hackage.haskell.org/packages/archive/hspec/latest/doc/html/Test-Hspec-Formatters.html).+++### The total time required to run a spec is now included in the summary++In addition to the used CPU time, the total time required to run a spec is now+include in the summary.  This is useful for specs that do non-CPU-intensive+stuff, or fork subprocesses.
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2011-2015 Simon Hengel <sol@typeful.net>+Copyright (c) 2011-2017 Simon Hengel <sol@typeful.net> Copyright (c) 2011-2012 Trystan Spangler <trystan.s@comcast.net> Copyright (c) 2011-2011 Greg Weber <greg@gregweber.info>
− changelog 
@@ -1,1 +0,0 @@-See https://github.com/hspec/hspec/blob/master/CHANGES.markdown
− hspec-core/src/Test/Hspec/Compat.hs 
@@ -1,106 +0,0 @@-{-# LANGUAGE CPP #-}-module Test.Hspec.Compat (-  getDefaultConcurrentJobs-, showType-, showFullType-, readMaybe-, lookupEnv-, module Data.IORef--, module Prelude-, module Control.Applicative-, module Data.Foldable-, module Data.Traversable-, module Data.Monoid--#if !MIN_VERSION_base(4,6,0)-, modifyIORef'-#endif-) where--import           Control.Applicative-import           Data.Foldable-import           Data.Traversable-import           Data.Monoid--import           Prelude hiding (-    all-  , and-  , any-  , concat-  , concatMap-  , elem-  , foldl-  , foldl1-  , foldr-  , foldr1-  , mapM-  , mapM_-  , maximum-  , minimum-  , notElem-  , or-  , product-  , sequence-  , sequence_-  , sum-  )--import           Data.Typeable (Typeable, typeOf, typeRepTyCon)-import           Text.Read-import           Data.IORef-import           System.Environment--import           Data.Typeable.Internal (tyConModule, tyConName)-import           Control.Concurrent--#if !MIN_VERSION_base(4,6,0)-import qualified Text.ParserCombinators.ReadP as P---- |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-  show t--showFullType :: Typeable a => a -> String-showFullType a = let t = typeRepTyCon (typeOf a) in-  tyConModule t ++ "." ++ tyConName t--getDefaultConcurrentJobs :: IO Int-getDefaultConcurrentJobs = getNumCapabilities
− hspec-core/src/Test/Hspec/Config.hs 
@@ -1,86 +0,0 @@-module Test.Hspec.Config (-  Config (..)-, ColorMode(..)-, defaultConfig-, getConfig-, configAddFilter-, configQuickCheckArgs-) where--import           Control.Applicative-import           System.IO-import           System.Exit-import qualified Test.QuickCheck as QC--import           Test.Hspec.Core.Util-import           Test.Hspec.Options-import           Test.Hspec.FailureReport-import           Test.Hspec.Core.QuickCheckUtil (mkGen)-import           Test.Hspec.Core.Example (Params(..), defaultParams)---- | Add a filter predicate to config.  If there is already a filter predicate,--- then combine them with `||`.-configAddFilter :: (Path -> Bool) -> Config -> Config-configAddFilter p1 c = c {-    configFilterPredicate = Just p1 `filterOr` configFilterPredicate c-  }--mkConfig :: Maybe FailureReport -> Config -> Config-mkConfig mFailureReport opts = opts {-    configFilterPredicate = matchFilter `filterOr` rerunFilter-  , configQuickCheckSeed = mSeed-  , configQuickCheckMaxSuccess = mMaxSuccess-  , configQuickCheckMaxDiscardRatio = mMaxDiscardRatio-  , configQuickCheckMaxSize = mMaxSize-  }-  where--    mSeed = configQuickCheckSeed opts <|> (failureReportSeed <$> mFailureReport)-    mMaxSuccess = configQuickCheckMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport)-    mMaxSize = configQuickCheckMaxSize opts <|> (failureReportMaxSize <$> mFailureReport)-    mMaxDiscardRatio = configQuickCheckMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport)--    matchFilter = configFilterPredicate opts--    rerunFilter = case failureReportPaths <$> mFailureReport of-      Just [] -> Nothing-      Just xs -> Just (`elem` xs)-      Nothing -> Nothing--configQuickCheckArgs :: Config -> QC.Args-configQuickCheckArgs c = qcArgs-  where-    qcArgs = (-        maybe id setSeed (configQuickCheckSeed c)-      . maybe id setMaxDiscardRatio (configQuickCheckMaxDiscardRatio c)-      . maybe id setMaxSize (configQuickCheckMaxSize c)-      . maybe id setMaxSuccess (configQuickCheckMaxSuccess c)) (paramsQuickCheckArgs defaultParams)--    setMaxSuccess :: Int -> QC.Args -> QC.Args-    setMaxSuccess n args = args {QC.maxSuccess = n}--    setMaxSize :: Int -> QC.Args -> QC.Args-    setMaxSize n args = args {QC.maxSize = n}--    setMaxDiscardRatio :: Int -> QC.Args -> QC.Args-    setMaxDiscardRatio n args = args {QC.maxDiscardRatio = n}--    setSeed :: Integer -> QC.Args -> QC.Args-    setSeed n args = args {QC.replay = Just (mkGen (fromIntegral n), 0)}--getConfig :: Config -> String -> [String] -> IO Config-getConfig opts_ prog args = do-  case parseOptions opts_ prog args of-    Left (err, msg) -> exitWithMessage err msg-    Right opts -> do-      r <- if configRerun opts then readFailureReport else return Nothing-      return (mkConfig r opts)--exitWithMessage :: ExitCode -> String -> IO a-exitWithMessage err msg = do-  hPutStr h msg-  exitWith err-  where-    h = case err of-      ExitSuccess -> stdout-      _           -> stderr
+ hspec-core/src/Test/Hspec/Core/Compat.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.Compat (+  getDefaultConcurrentJobs+, showType+, showFullType+, readMaybe+, lookupEnv+, module Data.IORef++, module Prelude+, module Control.Applicative+, module Data.Foldable+, module Data.Traversable+, module Data.Monoid++#if !MIN_VERSION_base(4,6,0)+, modifyIORef'+#endif+) where++import           Control.Applicative+import           Data.Foldable+import           Data.Traversable+import           Data.Monoid++import           Prelude hiding (+    all+  , and+  , any+  , concat+  , concatMap+  , elem+  , foldl+  , foldl1+  , foldr+  , foldr1+  , mapM+  , mapM_+  , maximum+  , minimum+  , notElem+  , or+  , product+  , sequence+  , sequence_+  , sum+  )++import           Data.Typeable (Typeable, typeOf, typeRepTyCon)+import           Text.Read+import           Data.IORef+import           System.Environment++import           Data.Typeable (tyConModule, tyConName)+import           Control.Concurrent++#if !MIN_VERSION_base(4,6,0)+import qualified Text.ParserCombinators.ReadP as P++-- |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+  show t++showFullType :: Typeable a => a -> String+showFullType a = let t = typeRepTyCon (typeOf a) in+  tyConModule t ++ "." ++ tyConName t++getDefaultConcurrentJobs :: IO Int+getDefaultConcurrentJobs = getNumCapabilities
+ hspec-core/src/Test/Hspec/Core/Config.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.Config (+  Config (..)+, ColorMode(..)+, defaultConfig+, getConfig+, configAddFilter+, configQuickCheckArgs+#ifdef TEST+, readConfigFiles+#endif+) where++import           Prelude ()++import           Control.Exception+import           Control.Monad+import           Data.Maybe+import           System.IO+import           System.IO.Error+import           System.Exit+import           System.FilePath+import           System.Directory+import qualified Test.QuickCheck as QC++import           Test.Hspec.Core.Util+import           Test.Hspec.Core.Compat+import           Test.Hspec.Core.Options+import           Test.Hspec.Core.FailureReport+import           Test.Hspec.Core.QuickCheckUtil (mkGen)+import           Test.Hspec.Core.Example (Params(..), defaultParams)++-- | Add a filter predicate to config.  If there is already a filter predicate,+-- then combine them with `||`.+configAddFilter :: (Path -> Bool) -> Config -> Config+configAddFilter p1 c = c {+    configFilterPredicate = Just p1 `filterOr` configFilterPredicate c+  }++mkConfig :: Maybe FailureReport -> Config -> Config+mkConfig mFailureReport opts = opts {+    configFilterPredicate = matchFilter `filterOr` rerunFilter+  , configQuickCheckSeed = mSeed+  , configQuickCheckMaxSuccess = mMaxSuccess+  , configQuickCheckMaxDiscardRatio = mMaxDiscardRatio+  , configQuickCheckMaxSize = mMaxSize+  }+  where++    mSeed = configQuickCheckSeed opts <|> (failureReportSeed <$> mFailureReport)+    mMaxSuccess = configQuickCheckMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport)+    mMaxSize = configQuickCheckMaxSize opts <|> (failureReportMaxSize <$> mFailureReport)+    mMaxDiscardRatio = configQuickCheckMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport)++    matchFilter = configFilterPredicate opts++    rerunFilter = case failureReportPaths <$> mFailureReport of+      Just [] -> Nothing+      Just xs -> Just (`elem` xs)+      Nothing -> Nothing++configQuickCheckArgs :: Config -> QC.Args+configQuickCheckArgs c = qcArgs+  where+    qcArgs = (+        maybe id setSeed (configQuickCheckSeed c)+      . maybe id setMaxDiscardRatio (configQuickCheckMaxDiscardRatio c)+      . maybe id setMaxSize (configQuickCheckMaxSize c)+      . maybe id setMaxSuccess (configQuickCheckMaxSuccess c)) (paramsQuickCheckArgs defaultParams)++    setMaxSuccess :: Int -> QC.Args -> QC.Args+    setMaxSuccess n args = args {QC.maxSuccess = n}++    setMaxSize :: Int -> QC.Args -> QC.Args+    setMaxSize n args = args {QC.maxSize = n}++    setMaxDiscardRatio :: Int -> QC.Args -> QC.Args+    setMaxDiscardRatio n args = args {QC.maxDiscardRatio = n}++    setSeed :: Integer -> QC.Args -> QC.Args+    setSeed n args = args {QC.replay = Just (mkGen (fromIntegral n), 0)}++getConfig :: Config -> String -> [String] -> IO (Maybe FailureReport, Config)+getConfig opts_ prog args = do+  configFiles <- do+    ignore <- ignoreConfigFile opts_ args+    case ignore of+      True -> return []+      False -> readConfigFiles+  envVar <- fmap words <$> lookupEnv envVarName+  case parseOptions opts_ prog configFiles envVar args of+    Left (err, msg) -> exitWithMessage err msg+    Right opts -> do+      r <- if configRerun opts then readFailureReport opts else return Nothing+      return (r, mkConfig r opts)++readConfigFiles :: IO [ConfigFile]+readConfigFiles = do+  global <- readGlobalConfigFile+  local <- readLocalConfigFile+  return $ catMaybes [global, local]++readGlobalConfigFile :: IO (Maybe ConfigFile)+readGlobalConfigFile = do+  mHome <- tryJust (guard . isDoesNotExistError) getHomeDirectory+  case mHome of+    Left _ -> return Nothing+    Right home -> readConfigFile (home </> ".hspec")++readLocalConfigFile :: IO (Maybe ConfigFile)+readLocalConfigFile = do+  mName <- tryJust (guard . isDoesNotExistError) (canonicalizePath ".hspec")+  case mName of+    Left _ -> return Nothing+    Right name -> readConfigFile name++readConfigFile :: FilePath -> IO (Maybe ConfigFile)+readConfigFile name = do+  exists <- doesFileExist name+  if exists then Just . (,) name . words <$> readFile name else return Nothing++exitWithMessage :: ExitCode -> String -> IO a+exitWithMessage err msg = do+  hPutStr h msg+  exitWith err+  where+    h = case err of+      ExitSuccess -> stdout+      _           -> stderr
hspec-core/src/Test/Hspec/Core/Example.hs view
@@ -9,6 +9,8 @@ , Result (..) , Location (..) , LocationAccuracy (..)+, FailureReason (..)+, safeEvaluateExample ) where  import           Data.Maybe (fromMaybe)@@ -20,6 +22,7 @@ #endif  import qualified Control.Exception as E+import           Control.DeepSeq import           Data.Typeable (Typeable) import qualified Test.QuickCheck as QC import           Test.Hspec.Expectations (Expectation)@@ -29,14 +32,12 @@  import           Test.Hspec.Core.QuickCheckUtil import           Test.Hspec.Core.Util-import           Test.Hspec.Compat+import           Test.Hspec.Core.Compat  -- | A type class for examples class Example e where   type Arg e-#if __GLASGOW_HASKELL__ >= 704   type Arg e = ()-#endif   evaluateExample :: e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result  data Params = Params {@@ -57,9 +58,18 @@ type ActionWith a = a -> IO ()  -- | The result of running an example-data Result = Success | Pending (Maybe String) | Fail (Maybe Location) String+data Result = Success | Pending (Maybe String) | Failure (Maybe Location) FailureReason   deriving (Eq, Show, Read, Typeable) +data FailureReason = NoReason | Reason String | ExpectedButGot (Maybe String) String String+    deriving (Eq, Show, Read, Typeable)++instance NFData FailureReason where+  rnf reason = case reason of+    NoReason -> ()+    Reason r -> r `deepseq` ()+    ExpectedButGot p e a  -> p `deepseq` e `deepseq` a `deepseq` ()+ instance E.Exception Result  -- | @Location@ is used to represent source locations.@@ -79,10 +89,46 @@   BestEffort   deriving (Eq, Show, Read) +safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO (Either E.SomeException Result)+safeEvaluateExample example params around progress = do+  r <- safeTry $ forceResult <$> evaluateExample example params around progress+  return $ case r of+    Left e | Just result <- E.fromException e -> Right result+    Left e | Just hunit <- E.fromException e -> Right (hunitFailureToResult hunit)+    _ -> r+  where+    forceResult :: Result -> Result+    forceResult r = case r of+      Success -> r+      Pending m -> m `deepseq` r+      Failure _ m -> m `deepseq` r++instance Example Result where+  type Arg Result = ()+  evaluateExample e = evaluateExample (\() -> e)++instance Example (a -> Result) where+  type Arg (a -> Result) = a+  evaluateExample example _params action _callback = do+    ref <- newIORef Success+    action (writeIORef ref . example)+    readIORef ref+ instance Example Bool where   type Arg Bool = ()-  evaluateExample b _ _ _ = if b then return Success else return (Fail Nothing "")+  evaluateExample e = evaluateExample (\() -> e) +instance Example (a -> Bool) where+  type Arg (a -> Bool) = a+  evaluateExample p _params action _callback = do+    ref <- newIORef Success+    action $ \a -> example a >>= writeIORef ref+    readIORef ref+    where+      example a+        | p a = return Success+        | otherwise = return (Failure Nothing NoReason)+ instance Example Expectation where   type Arg Expectation = ()   evaluateExample e = evaluateExample (\() -> e)@@ -92,9 +138,11 @@ #if MIN_VERSION_HUnit(1,3,0)   HUnit.HUnitFailure mLoc err -> #if MIN_VERSION_HUnit(1,5,0)-      Fail location (HUnit.formatFailureReason err)+      case err of+        HUnit.Reason reason -> Failure location (Reason reason)+        HUnit.ExpectedButGot preface expected actual -> Failure location (ExpectedButGot preface expected actual) #else-      Fail location err+      Failure location (Reason err) #endif     where       location = case mLoc of@@ -105,19 +153,12 @@         Just loc -> Just $ Location (HUnit.locationFile loc) (HUnit.locationLine loc) (HUnit.locationColumn loc) ExactLocation #endif #else-  HUnit.HUnitFailure err -> Fail Nothing err+  HUnit.HUnitFailure err -> Failure Nothing (Reason err) #endif  instance Example (a -> Expectation) where   type Arg (a -> Expectation) = a-  evaluateExample e _ action _ = (action e >> return Success) `E.catches` [-      E.Handler (return . hunitFailureToResult)-    , E.Handler (return :: Result -> IO Result)-    ]--instance Example Result where-  type Arg Result = ()-  evaluateExample r _ _ _ = return r+  evaluateExample e _ action _ = action e >> return Success  instance Example QC.Property where   type Arg QC.Property = ()@@ -130,11 +171,11 @@     return $       case r of         QC.Success {}               -> Success-        QC.Failure {QC.output = m}  -> fromMaybe (Fail Nothing $ sanitizeFailureMessage r) (parsePending m)-        QC.GaveUp {QC.numTests = n} -> Fail Nothing ("Gave up after " ++ pluralize n "test" )-        QC.NoExpectedFailure {}     -> Fail Nothing ("No expected failure")+        QC.Failure {QC.output = m}  -> fromMaybe (Failure Nothing . Reason $ sanitizeFailureMessage r) (parsePending m)+        QC.GaveUp {QC.numTests = n} -> Failure Nothing (Reason $ "Gave up after " ++ pluralize n "test" )+        QC.NoExpectedFailure {}     -> Failure Nothing (Reason $ "No expected failure") #if MIN_VERSION_QuickCheck(2,8,0)-        QC.InsufficientCoverage {}  -> Fail Nothing ("Insufficient coverage")+        QC.InsufficientCoverage {}  -> Failure Nothing (Reason $ "Insufficient coverage") #endif     where       qcProgressCallback = QCP.PostTest QCP.NotCounterexample $@@ -144,10 +185,12 @@       sanitizeFailureMessage r = let m = QC.output r in strip $ #if MIN_VERSION_QuickCheck(2,7,0)         case QC.theException r of-          Just e -> let numbers = formatNumbers r in-            "uncaught exception: " ++ formatException e ++ " " ++ numbers ++ "\n" ++ case lines m of-              x:xs | x == (exceptionPrefix ++ show e ++ "' " ++ numbers ++ ": ") -> unlines xs-              _ -> m+          Just e -> case E.fromException e :: Maybe (HUnit.HUnitFailure) of+            Just _ -> (addFalsifiable . stripFailed) m+            Nothing -> let numbers = formatNumbers r in+              "uncaught exception: " ++ formatException e ++ " " ++ numbers ++ "\n" ++ case lines m of+                x:xs | x == (exceptionPrefix ++ show e ++ "' " ++ numbers ++ ": ") -> unlines xs+                _ -> m           Nothing -> #endif             (addFalsifiable . stripFailed) m
+ hspec-core/src/Test/Hspec/Core/FailureReport.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.FailureReport (+  FailureReport (..)+, writeFailureReport+, readFailureReport+) where++#ifndef __GHCJS__+import           System.SetEnv+import           Test.Hspec.Core.Util (safeTry)+#endif+import           Control.Monad+import           System.IO+import           System.Directory+import           Test.Hspec.Core.Compat+import           Test.Hspec.Core.Util (Path)+import           Test.Hspec.Core.Options (Config(..))++data FailureReport = FailureReport {+  failureReportSeed :: Integer+, failureReportMaxSuccess :: Int+, failureReportMaxSize :: Int+, failureReportMaxDiscardRatio :: Int+, failureReportPaths :: [Path]+} deriving (Eq, Show, Read)++writeFailureReport :: Config -> FailureReport -> IO ()+writeFailureReport config report = case configFailureReport config of+  Just file -> writeFile file (show report)+  Nothing -> do+#ifdef __GHCJS__+    -- ghcjs currently does not support setting environment variables+    -- (https://github.com/ghcjs/ghcjs/issues/263). Since writing a failure report+    -- into the environment is a non-essential feature we just disable this to be+    -- able to run hspec test-suites with ghcjs at all. Should be reverted once+    -- the issue is fixed.+    return ()+#else+    -- on Windows this can throw an exception when the input is too large, hence+    -- we use `safeTry` here+    safeTry (setEnv "HSPEC_FAILURES" $ show report) >>= either onError return+    where+      onError err = do+        hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")")+#endif++readFailureReport :: Config -> IO (Maybe FailureReport)+readFailureReport config = case configFailureReport config of+  Just file -> do+    exists <- doesFileExist file+    if exists+      then do+        r <- readFile file+        let report = readMaybe r+        when (report == Nothing) $ do+          hPutStrLn stderr ("WARNING: Could not read failure report from file " ++ show file ++ "!")+        return report+      else return Nothing+  Nothing -> 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+      report -> return report
hspec-core/src/Test/Hspec/Core/Formatters.hs view
@@ -19,6 +19,7 @@ -- Actions live in the `FormatM` monad.  It provides access to the runner state -- and primitives for appending to the generated report. , Formatter (..)+, FailureReason (..) , FormatM  -- ** Accessing the runner state@@ -37,7 +38,6 @@ -- ** Appending to the gerenated report , write , writeLine-, newParagraph  -- ** Dealing with colors , withInfoColor@@ -45,12 +45,15 @@ , withPendingColor , withFailColor +, extraChunk+, missingChunk+ -- ** Helpers , formatException ) where  import           Prelude ()-import           Test.Hspec.Compat+import           Test.Hspec.Core.Compat hiding (First)  import           Data.Maybe import           Test.Hspec.Core.Util@@ -64,8 +67,9 @@ -- -- Everything imported here has to be re-exported, so that users can implement -- their own formatters.-import Test.Hspec.Core.Formatters.Internal (+import Test.Hspec.Core.Formatters.Monad (     Formatter (..)+  , FailureReason (..)   , FormatM    , getSuccessCount@@ -82,14 +86,18 @@    , write   , writeLine-  , newParagraph    , withInfoColor   , withSuccessColor   , withPendingColor   , withFailColor++  , extraChunk+  , missingChunk   ) +import           Test.Hspec.Core.Formatters.Diff+ silent :: Formatter silent = Formatter {   headerFormatter     = return ()@@ -103,7 +111,6 @@ , footerFormatter     = return () } - specdoc :: Formatter specdoc = silent { @@ -186,11 +193,37 @@         withInfoColor $ writeLine (formatLoc loc)       write ("  " ++ show n ++ ") ")       writeLine (formatRequirement path)-      withFailColor $ do-        forM_ (lines err) $ \x -> do-          writeLine ("       " ++ x)+      case reason of+        Left e -> withFailColor . indent $ (("uncaught exception: " ++) . formatException) e+        Right NoReason -> return ()+        Right (Reason err) -> withFailColor $ indent err+        Right (ExpectedButGot preface expected actual) -> do+          mapM_ indent preface++          let chunks = diff expected actual++          withFailColor $ write (indentation ++ "expected: ")+          forM_ chunks $ \chunk -> case chunk of+            Both a _ -> indented write a+            First a -> indented extraChunk a+            Second _ -> return ()+          writeLine ""++          withFailColor $ write (indentation ++ " but got: ")+          forM_ chunks $ \chunk -> case chunk of+            Both a _ -> indented write a+            First _ -> return ()+            Second a -> indented missingChunk a+          writeLine ""+          where+            indented output text = case break (== '\n') text of+              (xs, "") -> output xs+              (xs, _ : ys) -> output (xs ++ "\n") >> write (indentation ++ "          ") >> indented output ys       where-        err = either (("uncaught exception: " ++) . formatException) id reason+        indentation = "       "+        indent message = do+          forM_ (lines message) $ \line -> do+            writeLine (indentation ++ line)         formatLoc (Location file line _column accuracy) = "  " ++ file ++ ":" ++ show line ++ ":" ++ message           where             message = case accuracy of@@ -204,19 +237,19 @@ defaultFooter = do    writeLine =<< (++)-    <$> (printf "Finished in %1.4f seconds"-    <$> getRealTime) <*> (maybe "" (printf ", used %1.4f seconds of CPU time") <$> getCPUTime)+    <$> (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 ""+  let+    output =+         pluralize total   "example"+      ++ ", " ++ pluralize fails "failure"+      ++ if pending == 0 then "" else ", " ++ show pending ++ " pending"+    c | fails /= 0   = withFailColor+      | pending /= 0 = withPendingColor+      | otherwise    = withSuccessColor+  c $ writeLine output
+ hspec-core/src/Test/Hspec/Core/Formatters/Diff.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.Formatters.Diff (+  Diff (..)+, diff+#ifdef TEST+, partition+, breakList+#endif+) where++import           Data.Char+import           Data.Algorithm.Diff++diff :: String -> String -> [Diff String]+diff expected actual = map (fmap concat) $ getGroupedDiff (partition expected) (partition actual)++partition :: String -> [String]+partition = mergeBackslashes . breakList isAlphaNum+  where+    mergeBackslashes xs = case xs of+      ['\\'] : (y : ys) : zs -> ['\\', y] : ys : mergeBackslashes zs+      z : zs -> z : mergeBackslashes zs+      [] -> []++breakList :: (a -> Bool) -> [a] -> [[a]]+breakList _ [] = []+breakList p xs = case break p xs of+  (y, ys) -> map return y ++ case span p ys of+    (z, zs) -> z `cons` breakList p zs+  where+    cons x+      | null x = id+      | otherwise = (x :)
+ hspec-core/src/Test/Hspec/Core/Formatters/Free.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveFunctor #-}+module Test.Hspec.Core.Formatters.Free where++import           Prelude ()+import           Test.Hspec.Core.Compat++data Free f a = Free (f (Free f a)) | Pure a+  deriving Functor++instance Functor f => Applicative (Free f) where+  pure = Pure+  Pure f <*> Pure a = Pure (f a)+  Pure f <*> Free m = Free (fmap f <$> m)+  Free m <*> b = Free (fmap (<*> b) m)++instance Functor f => Monad (Free f) where+  return = pure+  Pure a >>= f = f a+  Free m >>= f = Free (fmap (>>= f) m)++liftF :: Functor f => f a -> Free f a+liftF command = Free (fmap Pure command)
hspec-core/src/Test/Hspec/Core/Formatters/Internal.hs view
@@ -1,33 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Test.Hspec.Core.Formatters.Internal (---- * Public API-  Formatter (..)-, FormatM--, getSuccessCount-, getPendingCount-, getFailCount-, getTotalCount--, FailureRecord (..)-, getFailMessages-, usedSeed--, getCPUTime-, getRealTime--, write-, writeLine-, newParagraph--, withInfoColor-, withSuccessColor-, withPendingColor-, withFailColor---- * Functions for internal use+  FormatM , runFormatM+, interpret , increaseSuccessCount , increasePendingCount , increaseFailCount@@ -36,7 +11,7 @@ ) where  import           Prelude ()-import           Test.Hspec.Compat+import           Test.Hspec.Core.Compat  import qualified System.IO as IO import           System.IO (Handle)@@ -49,8 +24,31 @@ import           Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)  import           Test.Hspec.Core.Util (Path)-import           Test.Hspec.Core.Spec (Progress, Location)+import           Test.Hspec.Core.Spec (Location)+import           Test.Hspec.Core.Example (FailureReason(..)) +import qualified Test.Hspec.Core.Formatters.Monad as M+import           Test.Hspec.Core.Formatters.Monad (Environment(..), interpretWith, FailureRecord(..))++interpret :: M.FormatM a -> FormatM a+interpret = interpretWith Environment {+  environmentGetSuccessCount = getSuccessCount+, environmentGetPendingCount = getPendingCount+, environmentGetFailCount = getFailCount+, environmentGetFailMessages = getFailMessages+, environmentUsedSeed = usedSeed+, environmentGetCPUTime = getCPUTime+, environmentGetRealTime = getRealTime+, environmentWrite = write+, environmentWithFailColor = withFailColor+, environmentWithSuccessColor = withSuccessColor+, environmentWithPendingColor = withPendingColor+, environmentWithInfoColor = withInfoColor+, environmentExtraChunk = extraChunk+, environmentMissingChunk = missingChunk+, environmentLiftIO = liftIO+}+ -- | A lifted version of `Control.Monad.Trans.State.gets` gets :: (FormatterState -> a) -> FormatM a gets f = FormatM $ do@@ -64,6 +62,7 @@ data FormatterState = FormatterState {   stateHandle     :: Handle , stateUseColor   :: Bool+, stateUseDiff    :: Bool , produceHTML     :: Bool , successCount    :: Int , pendingCount    :: Int@@ -78,20 +77,16 @@ 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+runFormatM :: Bool -> Bool -> Bool -> Bool -> Integer -> Handle -> FormatM a -> IO a+runFormatM useColor useDiff produceHTML_ printCpuTime seed handle (FormatM action) = do   time <- getPOSIXTime   cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing-  st <- newIORef (FormatterState handle useColor produceHTML_ 0 0 0 [] seed cpuTime time)+  st <- newIORef (FormatterState handle useColor useDiff produceHTML_ 0 0 0 [] seed cpuTime time)   evalStateT action st  -- | Increase the counter for successful examples@@ -118,74 +113,20 @@ getFailCount :: FormatM Int getFailCount = gets failCount --- | Get the total number of examples encountered so far.-getTotalCount :: FormatM Int-getTotalCount = gets totalCount- -- | Append to the list of accumulated failure messages.-addFailMessage :: Maybe Location -> Path -> Either SomeException String -> FormatM ()+addFailMessage :: Maybe Location -> Path -> Either SomeException FailureReason -> FormatM () addFailMessage loc p m = modify $ \s -> s {failMessages = FailureRecord loc p m : failMessages s}  -- | Get the list of accumulated failure messages. getFailMessages :: FormatM [FailureRecord] getFailMessages = reverse `fmap` gets failMessages -data FailureRecord = FailureRecord {-  failureRecordLocation :: Maybe Location-, failureRecordPath     :: Path-, failureRecordMessage  :: Either SomeException String-}--data Formatter = Formatter {--  headerFormatter :: FormatM ()---- | evaluated before each test group------ The given number indicates the position within the parent group.-, exampleGroupStarted :: [String] -> String -> FormatM ()--, exampleGroupDone    :: FormatM ()---- | used to notify the progress of the currently evaluated example------ /Note/: This is only called when interactive/color mode.-, exampleProgress     :: Handle -> Path -> Progress -> IO ()---- | evaluated after each successful example-, exampleSucceeded    :: Path -> FormatM ()---- | evaluated after each failed example-, exampleFailed       :: Path -> Either SomeException String -> FormatM ()---- | evaluated after each pending example-, examplePending      :: Path -> Maybe String -> FormatM ()---- | evaluated after a test run-, failedFormatter     :: FormatM ()---- | evaluated after `failuresFormatter`-, footerFormatter     :: FormatM ()-}----- | Append an empty line to the report.------ Calling this multiple times has the same effect as calling it once.-newParagraph :: FormatM ()-newParagraph = writeLine ""-{-# DEPRECATED newParagraph "use @writeLine \"\"@ instead" #-}- -- | Append some output to the report. write :: String -> FormatM () write s = do   h <- gets stateHandle   liftIO $ IO.hPutStr h s --- | The same as `write`, but adds a newline character.-writeLine :: String -> FormatM ()-writeLine s = write s >> write "\n"- -- | Set output color to red, run given action, and finally restore the default -- color. withFailColor :: FormatM a -> FormatM a@@ -231,6 +172,22 @@        -- run action       (runStateT action st)++-- | Output given chunk in red.+extraChunk :: String -> FormatM ()+extraChunk s = do+  useDiff <- gets stateUseDiff+  case useDiff of+    True -> withFailColor $ write s+    False -> write s++-- | Output given chunk in green.+missingChunk :: String -> FormatM ()+missingChunk s = do+  useDiff <- gets stateUseDiff+  case useDiff of+    True -> withSuccessColor $ write s+    False -> write s  -- | -- @finally_ actionA actionB@ runs @actionA@ and then @actionB@.  @actionB@ is
+ hspec-core/src/Test/Hspec/Core/Formatters/Monad.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ExistentialQuantification #-}+module Test.Hspec.Core.Formatters.Monad (+  Formatter (..)+, FailureReason (..)+, FormatM++, getSuccessCount+, getPendingCount+, getFailCount+, getTotalCount++, FailureRecord (..)+, getFailMessages+, usedSeed++, getCPUTime+, getRealTime++, write+, writeLine++, withInfoColor+, withSuccessColor+, withPendingColor+, withFailColor++, extraChunk+, missingChunk++, Environment(..)+, interpretWith+) where++import           Prelude ()+import           Test.Hspec.Core.Compat++import           System.IO (Handle)+import           Control.Exception+import           Control.Monad.IO.Class++import           Test.Hspec.Core.Formatters.Free++import           Test.Hspec.Core.Example (FailureReason(..))+import           Test.Hspec.Core.Util (Path)+import           Test.Hspec.Core.Spec (Progress, Location)++data Formatter = Formatter {++  headerFormatter :: FormatM ()++-- | evaluated before each test group+--+-- The given number indicates the position within the parent group.+, exampleGroupStarted :: [String] -> String -> FormatM ()++, exampleGroupDone    :: FormatM ()++-- | used to notify the progress of the currently evaluated example+--+-- /Note/: This is only called when interactive/color mode.+, exampleProgress     :: Handle -> Path -> Progress -> IO ()++-- | evaluated after each successful example+, exampleSucceeded    :: Path -> FormatM ()++-- | evaluated after each failed example+, exampleFailed       :: Path -> Either SomeException FailureReason -> FormatM ()++-- | evaluated after each pending example+, examplePending      :: Path -> Maybe String -> FormatM ()++-- | evaluated after a test run+, failedFormatter     :: FormatM ()++-- | evaluated after `failuresFormatter`+, footerFormatter     :: FormatM ()+}++data FailureRecord = FailureRecord {+  failureRecordLocation :: Maybe Location+, failureRecordPath     :: Path+, failureRecordMessage  :: Either SomeException FailureReason+}++data FormatF next =+    GetSuccessCount (Int -> next)+  | GetPendingCount (Int -> next)+  | GetFailCount (Int -> next)+  | GetFailMessages ([FailureRecord] -> next)+  | UsedSeed (Integer -> next)+  | GetCPUTime (Maybe Double -> next)+  | GetRealTime (Double -> next)+  | Write String next+  | forall a. WithFailColor (FormatM a) (a -> next)+  | forall a. WithSuccessColor (FormatM a) (a -> next)+  | forall a. WithPendingColor (FormatM a) (a -> next)+  | forall a. WithInfoColor (FormatM a) (a -> next)+  | ExtraChunk String next+  | MissingChunk String next+  | forall a. LiftIO (IO a) (a -> next)++instance Functor FormatF where -- deriving this instance would require GHC >= 7.10.1+  fmap f x = case x of+    GetSuccessCount next -> GetSuccessCount (fmap f next)+    GetPendingCount next -> GetPendingCount (fmap f next)+    GetFailCount next -> GetFailCount (fmap f next)+    GetFailMessages next -> GetFailMessages (fmap f next)+    UsedSeed next -> UsedSeed (fmap f next)+    GetCPUTime next -> GetCPUTime (fmap f next)+    GetRealTime next -> GetRealTime (fmap f next)+    Write s next -> Write s (f next)+    WithFailColor action next -> WithFailColor action (fmap f next)+    WithSuccessColor action next -> WithSuccessColor action (fmap f next)+    WithPendingColor action next -> WithPendingColor action (fmap f next)+    WithInfoColor action next -> WithInfoColor action (fmap f next)+    ExtraChunk s next -> ExtraChunk s (f next)+    MissingChunk s next -> MissingChunk s (f next)+    LiftIO action next -> LiftIO action (fmap f next)++type FormatM = Free FormatF++instance MonadIO FormatM where+  liftIO s = liftF (LiftIO s id)++data Environment m = Environment {+  environmentGetSuccessCount :: m Int+, environmentGetPendingCount :: m Int+, environmentGetFailCount :: m Int+, environmentGetFailMessages :: m [FailureRecord]+, environmentUsedSeed :: m Integer+, environmentGetCPUTime :: m (Maybe Double)+, environmentGetRealTime :: m Double+, environmentWrite :: String -> m ()+, environmentWithFailColor :: forall a. m a -> m a+, environmentWithSuccessColor :: forall a. m a -> m a+, environmentWithPendingColor :: forall a. m a -> m a+, environmentWithInfoColor :: forall a. m a -> m a+, environmentExtraChunk :: String -> m ()+, environmentMissingChunk :: String -> m ()+, environmentLiftIO :: forall a. IO a -> m a+}++interpretWith :: forall m a. Monad m => Environment m -> FormatM a -> m a+interpretWith Environment{..} = go+  where+    go :: forall b. FormatM b -> m b+    go m = case m of+      Pure value -> return value+      Free action -> case action of+        GetSuccessCount next -> environmentGetSuccessCount >>= go . next+        GetPendingCount next -> environmentGetPendingCount >>= go . next+        GetFailCount next -> environmentGetFailCount >>= go . next+        GetFailMessages next -> environmentGetFailMessages >>= go . next+        UsedSeed next -> environmentUsedSeed >>= go . next+        GetCPUTime next -> environmentGetCPUTime >>= go . next+        GetRealTime next -> environmentGetRealTime >>= go . next+        Write s next -> environmentWrite s >> go next+        WithFailColor inner next -> environmentWithFailColor (go inner) >>= go . next+        WithSuccessColor inner next -> environmentWithSuccessColor (go inner) >>= go . next+        WithPendingColor inner next -> environmentWithPendingColor (go inner) >>= go . next+        WithInfoColor inner next -> environmentWithInfoColor (go inner) >>= go . next+        ExtraChunk s next -> environmentExtraChunk s >> go next+        MissingChunk s next -> environmentMissingChunk s >> go next+        LiftIO inner next -> environmentLiftIO inner >>= go . next++-- | Get the number of successful examples encountered so far.+getSuccessCount :: FormatM Int+getSuccessCount = liftF (GetSuccessCount id)++-- | Get the number of pending examples encountered so far.+getPendingCount :: FormatM Int+getPendingCount = liftF (GetPendingCount id)++-- | Get the number of failed examples encountered so far.+getFailCount :: FormatM Int+getFailCount = liftF (GetFailCount id)++-- | Get the total number of examples encountered so far.+getTotalCount :: FormatM Int+getTotalCount = sum <$> sequence [getSuccessCount, getFailCount, getPendingCount]++-- | Get the list of accumulated failure messages.+getFailMessages :: FormatM [FailureRecord]+getFailMessages = liftF (GetFailMessages id)++-- | The random seed that is used for QuickCheck.+usedSeed :: FormatM Integer+usedSeed = liftF (UsedSeed id)++-- | Get the used CPU time since the test run has been started.+getCPUTime :: FormatM (Maybe Double)+getCPUTime = liftF (GetCPUTime id)++-- | Get the passed real time since the test run has been started.+getRealTime :: FormatM Double+getRealTime = liftF (GetRealTime id)++-- | Append some output to the report.+write :: String -> FormatM ()+write s = liftF (Write s ())++-- | The same as `write`, but adds a newline character.+writeLine :: String -> FormatM ()+writeLine s = write s >> write "\n"++-- | Set output color to red, run given action, and finally restore the default+-- color.+withFailColor :: FormatM a -> FormatM a+withFailColor s = liftF (WithFailColor s id)++-- | Set output color to green, run given action, and finally restore the+-- default color.+withSuccessColor :: FormatM a -> FormatM a+withSuccessColor s = liftF (WithSuccessColor s id)++-- | Set output color to yellow, run given action, and finally restore the+-- default color.+withPendingColor :: FormatM a -> FormatM a+withPendingColor s = liftF (WithPendingColor s id)++-- | Set output color to cyan, run given action, and finally restore the+-- default color.+withInfoColor :: FormatM a -> FormatM a+withInfoColor s = liftF (WithInfoColor s id)++-- | Output given chunk in red.+extraChunk :: String -> FormatM ()+extraChunk s = liftF (ExtraChunk s ())++-- | Output given chunk in green.+missingChunk :: String -> FormatM ()+missingChunk s = liftF (MissingChunk s ())
hspec-core/src/Test/Hspec/Core/Hooks.hs view
@@ -14,10 +14,12 @@ , aroundWith ) where -import           Control.Exception (finally)+import           Control.Exception (SomeException, finally, throwIO, try) import           Control.Concurrent.MVar -import           Test.Hspec.Core.Spec+import           Test.Hspec.Core.Example+import           Test.Hspec.Core.Tree+import           Test.Hspec.Core.Spec.Monad  -- | Run a custom action before every spec item. before :: IO a -> SpecWith a -> Spec@@ -34,22 +36,30 @@ -- | Run a custom action before the first spec item. beforeAll :: IO a -> SpecWith a -> Spec beforeAll action spec = do-  mvar <- runIO (newMVar Nothing)+  mvar <- runIO (newMVar Empty)   before (memoize mvar action) spec  -- | Run a custom action before the first spec item. beforeAll_ :: IO () -> SpecWith a -> SpecWith a beforeAll_ action spec = do-  mvar <- runIO (newMVar Nothing)+  mvar <- runIO (newMVar Empty)   before_ (memoize mvar action) spec -memoize :: MVar (Maybe a) -> IO a -> IO a-memoize mvar action = modifyMVar mvar $ \ma -> case ma of-  Just a -> return (ma, a)-  Nothing -> do-    a <- action-    return (Just a, a)+data Memoized a =+    Empty+  | Memoized a+  | Failed SomeException +memoize :: MVar (Memoized a) -> IO a -> IO a+memoize mvar action = do+  result <- modifyMVar mvar $ \ma -> case ma of+    Empty -> do+      a <- try action+      return (either Failed Memoized a, a)+    Memoized a -> return (ma, Right a)+    Failed _ -> throwIO (Pending (Just "exception in beforeAll-hook (see previous failure)"))+  either throwIO return result+ -- | Run a custom action after every spec item. after :: ActionWith a -> SpecWith a -> SpecWith a after action = aroundWith $ \e x -> e x `finally` action x@@ -76,10 +86,8 @@  -- | Run a custom action before and/or after every spec item. aroundWith :: (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b-aroundWith action = mapAround (. action)--mapAround :: ((ActionWith b -> IO ()) -> ActionWith a -> IO ()) -> SpecWith a -> SpecWith b-mapAround f = mapSpecItem (untangle f) $ \i@Item{itemExample = e} -> i{itemExample = (. f) . e}+aroundWith action = mapSpecItem action (modifyAroundAction action) -untangle  :: ((ActionWith b -> IO ()) -> ActionWith a -> IO ()) -> ActionWith a -> ActionWith b-untangle f g = \b -> f ($ b) g+modifyAroundAction :: (ActionWith a -> ActionWith b) -> Item a -> Item b+modifyAroundAction action item@Item{itemExample = e} =+  item{ itemExample = \params aroundAction -> e params (aroundAction . action) }
+ hspec-core/src/Test/Hspec/Core/Options.hs view
@@ -0,0 +1,283 @@+module Test.Hspec.Core.Options (+  Config(..)+, ColorMode (..)+, defaultConfig+, filterOr+, parseOptions+, ConfigFile+, ignoreConfigFile+, envVarName+) where++import           Prelude ()+import           Control.Monad+import           Test.Hspec.Core.Compat++import           System.IO+import           System.Exit+import           System.Console.GetOpt++import           Test.Hspec.Core.Formatters+import           Test.Hspec.Core.Util+import           Test.Hspec.Core.Example (Params(..), defaultParams)+import           Data.Functor.Identity+import           Data.Maybe++type ConfigFile = (FilePath, [String])++type EnvVar = [String]++envVarName :: String+envVarName = "HSPEC_OPTIONS"++data Config = Config {+  configIgnoreConfigFile :: Bool+, configDryRun :: Bool+, configPrintCpuTime :: Bool+, configFastFail :: Bool+, configFailureReport :: Maybe FilePath+, configRerun :: Bool+, configRerunAllOnSuccess :: 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)+, configSkipPredicate :: Maybe (Path -> Bool)+, configQuickCheckSeed :: Maybe Integer+, configQuickCheckMaxSuccess :: Maybe Int+, configQuickCheckMaxDiscardRatio :: Maybe Int+, configQuickCheckMaxSize :: Maybe Int+, configSmallCheckDepth :: Int+, configColorMode :: ColorMode+, configDiff :: Bool+, configFormatter :: Maybe Formatter+, configHtmlOutput :: Bool+, configOutputFile :: Either Handle FilePath+, configConcurrentJobs :: Maybe Int+}++defaultConfig :: Config+defaultConfig = Config {+  configIgnoreConfigFile = False+, configDryRun = False+, configPrintCpuTime = False+, configFastFail = False+, configFailureReport = Nothing+, configRerun = False+, configRerunAllOnSuccess = False+, configFilterPredicate = Nothing+, configSkipPredicate = Nothing+, configQuickCheckSeed = Nothing+, configQuickCheckMaxSuccess = Nothing+, configQuickCheckMaxDiscardRatio = Nothing+, configQuickCheckMaxSize = Nothing+, configSmallCheckDepth = paramsSmallCheckDepth defaultParams+, configColorMode = ColorAuto+, configDiff = True+, configFormatter = Nothing+, configHtmlOutput = False+, configOutputFile = Left stdout+, configConcurrentJobs = Nothing+}++filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool)+filterOr p1_ p2_ = case (p1_, p2_) of+  (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path+  _ -> p1_ <|> p2_++addMatch :: String -> Config -> Config+addMatch s c = c {configFilterPredicate = Just (filterPredicate s) `filterOr` configFilterPredicate c}++addSkip :: String -> Config -> Config+addSkip s c = c {configSkipPredicate = Just (filterPredicate s) `filterOr` configSkipPredicate c}++setDepth :: Int -> Config -> Config+setDepth n c = c {configSmallCheckDepth = n}++setMaxSuccess :: Int -> Config -> Config+setMaxSuccess n c = c {configQuickCheckMaxSuccess = Just n}++setMaxSize :: Int -> Config -> Config+setMaxSize n c = c {configQuickCheckMaxSize = Just n}++setMaxDiscardRatio :: Int -> Config -> Config+setMaxDiscardRatio n c = c {configQuickCheckMaxDiscardRatio = Just n}++setSeed :: Integer -> Config -> Config+setSeed n c = c {configQuickCheckSeed = Just n}++data ColorMode = ColorAuto | ColorNever | ColorAlways+  deriving (Eq, Show)++formatters :: [(String, Formatter)]+formatters = [+    ("specdoc", specdoc)+  , ("progress", progress)+  , ("failed-examples", failed_examples)+  , ("silent", silent)+  ]++formatHelp :: String+formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters)++type Result m = Either InvalidArgument (m Config)++data InvalidArgument = InvalidArgument String String++data Arg a = Arg {+  _argumentName   :: String+, _argumentParser :: String -> Maybe a+, _argumentSetter :: a -> Config -> Config+}++mkOption :: Monad m => [Char] -> String -> Arg a -> String -> OptDescr (Result m -> Result m)+mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help+  where+    arg input x = x >>= \c -> case parser input of+      Just n -> Right (setter n `liftM` c)+      Nothing -> Left (InvalidArgument name input)++addLineBreaks :: String -> [String]+addLineBreaks = lineBreaksAt 40++h :: String -> String+h = unlines . addLineBreaks++commandLineOptions :: [OptDescr (Result Maybe -> Result Maybe)]+commandLineOptions = [+    Option   []  ["help"]             (NoArg (const $ Right Nothing))     (h "display this help and exit")+  , Option   []  ["ignore-dot-hspec"] (NoArg setIgnoreConfigFile)         (h "do not read options from ~/.hspec and .hspec")+  , mkOption "m"  "match"             (Arg "PATTERN" return addMatch)     (h "only run examples that match given PATTERN")+  , mkOption []   "skip"              (Arg "PATTERN" return addSkip)      (h "skip examples that match given PATTERN")+  ]+  where+    setIgnoreConfigFile = set $ \config -> config {configIgnoreConfigFile = True}++configFileOptions :: Monad m => [OptDescr (Result m -> Result m)]+configFileOptions = [+    Option   []  ["color"]            (NoArg setColor)                    (h "colorize the output")+  , Option   []  ["no-color"]         (NoArg setNoColor)                  (h "do not colorize the output")+  , Option   []  ["diff"]             (NoArg setDiff)                     (h "show colorized diffs")+  , Option   []  ["no-diff"]          (NoArg setNoDiff)                   (h "do not show colorized diffs")+  , 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 previous test run (only works in combination with --failure-report or in GHCi)")+  , mkOption []   "failure-report"    (Arg "FILE" return setFailureReport)(h "read/write a failure report for use with --rerun")+  , Option   []  ["rerun-all-on-success"] (NoArg setRerunAllOnSuccess)    (h "run the whole test suite after a previously failing rerun succeeds for the first time (only works in combination with --rerun)")+  , mkOption "j"  "jobs"              (Arg "N" readMaxJobs setMaxJobs)    (h "run at most N parallelizable tests simultaneously (default: number of available processors)")+  ]+  where+    readFormatter :: String -> Maybe Formatter+    readFormatter = (`lookup` formatters)++    readMaxJobs :: String -> Maybe Int+    readMaxJobs s = do+      n <- readMaybe s+      guard $ n > 0+      return n++    setFormatter :: Formatter -> Config -> Config+    setFormatter f c = c {configFormatter = Just f}++    setOutputFile :: String -> Config -> Config+    setOutputFile file c = c {configOutputFile = Right file}++    setFailureReport :: String -> Config -> Config+    setFailureReport file c = c {configFailureReport = Just file}++    setMaxJobs :: Int -> Config -> Config+    setMaxJobs n c = c {configConcurrentJobs = Just n}++    setPrintCpuTime = set $ \config -> config {configPrintCpuTime = True}+    setDryRun       = set $ \config -> config {configDryRun = True}+    setFastFail     = set $ \config -> config {configFastFail = True}+    setRerun        = set $ \config -> config {configRerun = True}+    setRerunAllOnSuccess = set $ \config -> config {configRerunAllOnSuccess = True}+    setColor        = set $ \config -> config {configColorMode = ColorAlways}+    setNoColor      = set $ \config -> config {configColorMode = ColorNever}+    setDiff         = set $ \config -> config {configDiff = True}+    setNoDiff       = set $ \config -> config {configDiff = False}++set :: Monad m => (Config -> Config) -> Either a (m Config) -> Either a (m Config)+set = liftM . liftM++documentedOptions :: [OptDescr (Result Maybe -> Result Maybe)]+documentedOptions = commandLineOptions ++ configFileOptions++undocumentedOptions :: [OptDescr (Result Maybe -> Result Maybe)]+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 Maybe -> Result Maybe+    setHtml = set $ \config -> config {configHtmlOutput = True}++recognizedOptions :: [OptDescr (Result Maybe -> Result Maybe)]+recognizedOptions = documentedOptions ++ undocumentedOptions++parseOptions :: Config -> String -> [ConfigFile] -> Maybe EnvVar -> [String] -> Either (ExitCode, String) Config+parseOptions config prog configFiles envVar args = do+      foldM (parseFileOptions prog) config configFiles+  >>= parseEnvVarOptions prog envVar+  >>= parseCommandLineOptions prog args++parseCommandLineOptions :: String -> [String] -> Config -> Either (ExitCode, String) Config+parseCommandLineOptions prog args config = case parse recognizedOptions config args of+  Right Nothing -> Left (ExitSuccess, usageInfo ("Usage: " ++ prog ++ " [OPTION]...\n\nOPTIONS") documentedOptions)+  Right (Just c) -> Right c+  Left err -> failure err+  where+    failure err = Left (ExitFailure 1, prog ++ ": " ++ err ++ "\nTry `" ++ prog ++ " --help' for more information.\n")++parseFileOptions :: String -> Config -> ConfigFile -> Either (ExitCode, String) Config+parseFileOptions prog config (name, args) =+  parseOtherOptions prog ("in config file " ++ name) args config++parseEnvVarOptions :: String -> (Maybe EnvVar) -> Config -> Either (ExitCode, String) Config+parseEnvVarOptions prog args =+  parseOtherOptions prog ("from environment variable " ++ envVarName) (fromMaybe [] args)++parseOtherOptions :: String -> String -> [String] -> Config -> Either (ExitCode, String) Config+parseOtherOptions prog source args config = case parse configFileOptions config args of+  Right (Identity c) -> Right c+  Left err -> failure err+  where+    failure err = Left (ExitFailure 1, prog ++ ": " ++ message)+      where+        message = unlines $ case lines err of+          [x] -> [x ++ " " ++ source]+          xs -> xs ++ [source]++parse :: Monad m => [OptDescr (Result m -> Result m)] -> Config -> [String] -> Either String (m Config)+parse options config args = case getOpt Permute options args of+  (opts, [], []) -> case foldl' (flip id) (Right $ return config) opts of+    Left (InvalidArgument name value) -> Left ("invalid argument `" ++ value ++ "' for `--" ++ name ++ "'")+    Right x -> Right x+  (_, _, err:_) -> Left (init err)+  (_, arg:_, _) -> Left ("unexpected argument `" ++ arg ++ "'")++ignoreConfigFile :: Config -> [String] -> IO Bool+ignoreConfigFile config args = do+  ignore <- lookupEnv "IGNORE_DOT_HSPEC"+  case ignore of+    Just _ -> return True+    Nothing -> case parse recognizedOptions config args of+      Right (Just c) -> return (configIgnoreConfigFile c)+      _ -> return False
hspec-core/src/Test/Hspec/Core/QuickCheckUtil.hs view
@@ -2,7 +2,7 @@ module Test.Hspec.Core.QuickCheckUtil where  import           Prelude ()-import           Test.Hspec.Compat+import           Test.Hspec.Core.Compat  import           Data.Int import           Test.QuickCheck hiding (Result(..))
hspec-core/src/Test/Hspec/Core/Runner.hs view
@@ -21,10 +21,14 @@ , Path , defaultConfig , configAddFilter++#ifdef TEST+, rerunAll+#endif ) where  import           Prelude ()-import           Test.Hspec.Compat+import           Test.Hspec.Core.Compat  import           Control.Monad import           Data.Maybe@@ -40,10 +44,11 @@  import           Test.Hspec.Core.Util (Path) import           Test.Hspec.Core.Spec-import           Test.Hspec.Config+import           Test.Hspec.Core.Config import           Test.Hspec.Core.Formatters import           Test.Hspec.Core.Formatters.Internal-import           Test.Hspec.FailureReport+import qualified Test.Hspec.Core.Formatters.Internal as Formatter+import           Test.Hspec.Core.FailureReport import           Test.Hspec.Core.QuickCheckUtil  import           Test.Hspec.Core.Runner.Eval@@ -78,7 +83,7 @@   | otherwise = id   where     markSuccess :: Item () -> Item ()-    markSuccess item = item {itemExample = evaluateExample Success}+    markSuccess item = item {itemExample = safeEvaluateExample Success}      removeCleanup :: SpecTree () -> SpecTree ()     removeCleanup spec = case spec of@@ -105,8 +110,11 @@ hspecWith :: Config -> Spec -> IO () hspecWith conf spec = do   r <- hspecWithResult conf spec-  unless (summaryFailures r == 0) exitFailure+  unless (isSuccess r) exitFailure +isSuccess :: Summary -> Bool+isSuccess summary = summaryFailures summary == 0+ -- | Run given spec and returns a summary of the test run. -- -- /Note/: `hspecResult` does not exit with `exitFailure` on failing spec@@ -121,57 +129,93 @@ -- items.  If you need this, you have to check the `Summary` yourself and act -- accordingly. hspecWithResult :: Config -> Spec -> IO Summary-hspecWithResult conf spec = do+hspecWithResult config spec = do   prog <- getProgName   args <- getArgs-  c <- getConfig conf prog args >>= ensureSeed-  withArgs [] {- do not leak command-line arguments to examples -} $ withHandle c $ \h -> do-    let formatter = fromMaybe specdoc (configFormatter c)-        seed = (fromJust . configQuickCheckSeed) c-        qcArgs = configQuickCheckArgs c+  (oldFailureReport, c_) <- getConfig config prog args+  c <- ensureSeed c_+  if configRerunAllOnSuccess c+    -- With --rerun-all we may run the spec twice. For that reason GHC can not+    -- optimize away the spec tree. That means that the whole spec tree has to+    -- be constructed in memory and we loose constant space behavior.+    --+    -- By separating between rerunAllMode and normalMode here, we retain+    -- constant space behavior in normalMode.+    --+    -- see: https://github.com/hspec/hspec/issues/169+    then rerunAllMode c oldFailureReport+    else normalMode c+  where+    normalMode c = runSpec c spec+    rerunAllMode c oldFailureReport = do+      summary <- runSpec c spec+      if rerunAll c oldFailureReport summary+        then hspecWithResult config spec+        else return summary -    jobsSem <- newQSem =<< case configConcurrentJobs c of+runSpec :: Config -> Spec -> IO Summary+runSpec config spec = do+  doNotLeakCommandLineArgumentsToExamples $ withHandle config $ \h -> do+    let formatter = fromMaybe specdoc (configFormatter config)+        seed = (fromJust . configQuickCheckSeed) config+        qcArgs = configQuickCheckArgs config++    jobsSem <- newQSem =<< case configConcurrentJobs config of       Nothing -> getDefaultConcurrentJobs       Just maxJobs -> return maxJobs -    useColor <- doesUseColor h c+    useColor <- doesUseColor h config -    filteredSpec <- filterSpecs c . applyDryRun c <$> runSpecM spec+    filteredSpec <- filterSpecs config . applyDryRun config <$> runSpecM spec      withHiddenCursor useColor h $-      runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do-        runFormatter jobsSem useColor h c formatter filteredSpec `finally_` do-          failedFormatter formatter+      runFormatM useColor (configDiff config) (configHtmlOutput config) (configPrintCpuTime config) seed h $ do+        runFormatter jobsSem useColor h config formatter filteredSpec `finally_` do+          Formatter.interpret $ failedFormatter formatter -        footerFormatter formatter+        Formatter.interpret $ footerFormatter formatter -        -- dump failure report-        xs <- map failureRecordPath <$> getFailMessages-        liftIO $ writeFailureReport FailureReport {-            failureReportSeed = seed-          , failureReportMaxSuccess = QC.maxSuccess qcArgs-          , failureReportMaxSize = QC.maxSize qcArgs-          , failureReportMaxDiscardRatio = QC.maxDiscardRatio qcArgs-          , failureReportPaths = xs-          }+        xs <- map failureRecordPath <$> Formatter.interpret getFailMessages+        liftIO $ dumpFailureReport config seed qcArgs xs -        Summary <$> getTotalCount <*> getFailCount-  where-    withHiddenCursor :: Bool -> Handle -> IO a -> IO a-    withHiddenCursor useColor h-      | useColor  = E.bracket_ (hHideCursor h) (hShowCursor h)-      | otherwise = id+        Summary <$> Formatter.interpret getTotalCount <*> Formatter.interpret getFailCount -    doesUseColor :: Handle -> Config -> IO Bool-    doesUseColor h c = case configColorMode c of-      ColorAuto  -> (&&) <$> hIsTerminalDevice h <*> (not <$> isDumb)-      ColorNever -> return False-      ColorAlways -> return True+dumpFailureReport :: Config -> Integer -> QC.Args -> [Path] -> IO ()+dumpFailureReport config seed qcArgs xs = do+  writeFailureReport config FailureReport {+      failureReportSeed = seed+    , failureReportMaxSuccess = QC.maxSuccess qcArgs+    , failureReportMaxSize = QC.maxSize qcArgs+    , failureReportMaxDiscardRatio = QC.maxDiscardRatio qcArgs+    , failureReportPaths = xs+    } -    withHandle :: Config -> (Handle -> IO a) -> IO a-    withHandle c action = case configOutputFile c of-      Left h -> action h-      Right path -> withFile path WriteMode action+doNotLeakCommandLineArgumentsToExamples :: IO a -> IO a+doNotLeakCommandLineArgumentsToExamples = withArgs []++withHiddenCursor :: Bool -> Handle -> IO a -> IO a+withHiddenCursor useColor h+  | useColor  = E.bracket_ (hHideCursor h) (hShowCursor h)+  | otherwise = id++doesUseColor :: Handle -> Config -> IO Bool+doesUseColor h c = case configColorMode c of+  ColorAuto  -> (&&) <$> hIsTerminalDevice h <*> (not <$> isDumb)+  ColorNever -> return False+  ColorAlways -> return True++withHandle :: Config -> (Handle -> IO a) -> IO a+withHandle c action = case configOutputFile c of+  Left h -> action h+  Right path -> withFile path WriteMode action++rerunAll :: Config -> Maybe FailureReport -> Summary -> Bool+rerunAll _ Nothing _ = False+rerunAll config (Just oldFailureReport) summary =+     configRerunAllOnSuccess config+  && configRerun config+  && isSuccess summary+  && (not . null) (failureReportPaths oldFailureReport)  isDumb :: IO Bool isDumb = maybe False (== "dumb") <$> lookupEnv "TERM"
hspec-core/src/Test/Hspec/Core/Runner/Eval.hs view
@@ -8,7 +8,7 @@ module Test.Hspec.Core.Runner.Eval (runFormatter) where  import           Prelude ()-import           Test.Hspec.Compat+import           Test.Hspec.Core.Compat  import           Control.Monad (unless, when) import qualified Control.Exception as E@@ -16,22 +16,22 @@ import           System.IO (Handle)  import           Control.Monad.IO.Class (liftIO)-import           Control.DeepSeq (deepseq) import           Data.Time.Clock.POSIX  import           Test.Hspec.Core.Util import           Test.Hspec.Core.Spec-import           Test.Hspec.Config-import           Test.Hspec.Core.Formatters+import           Test.Hspec.Core.Config+import           Test.Hspec.Core.Formatters hiding (FormatM) import           Test.Hspec.Core.Formatters.Internal-import           Test.Hspec.Timer+import qualified Test.Hspec.Core.Formatters.Internal as Formatter+import           Test.Hspec.Core.Timer  type EvalTree = Tree (ActionWith ()) (String, Maybe Location, ProgressCallback -> FormatResult -> IO (FormatM ()))  -- | Evaluate all examples of a given spec and produce a report. runFormatter :: QSem -> Bool -> Handle -> Config -> Formatter -> [SpecTree ()] -> FormatM () runFormatter jobsSem useColor h c formatter specs = do-  headerFormatter formatter+  Formatter.interpret $ headerFormatter formatter   chan <- liftIO newChan   reportProgress <- liftIO mkReportProgress   run chan reportProgress c formatter (toEvalTree specs)@@ -60,24 +60,24 @@  type FormatResult = Either E.SomeException Result -> FormatM () -parallelize :: QSem -> Bool -> (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())+parallelize :: QSem -> Bool -> (ProgressCallback -> IO (Either E.SomeException Result)) -> ProgressCallback -> FormatResult -> IO (FormatM ()) parallelize jobsSem isParallelizable e   | isParallelizable = runParallel jobsSem e   | otherwise = runSequentially e -runSequentially :: (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())+runSequentially :: (ProgressCallback -> IO (Either E.SomeException Result)) -> ProgressCallback -> FormatResult -> IO (FormatM ()) runSequentially e reportProgress formatResult = return $ do-  result <- liftIO $ evalExample (e reportProgress)+  result <- liftIO $ e reportProgress   formatResult result  data Report = ReportProgress Progress | ReportResult (Either E.SomeException Result) -runParallel :: QSem -> (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ())+runParallel :: QSem -> (ProgressCallback -> IO (Either E.SomeException Result)) -> ProgressCallback -> FormatResult -> IO (FormatM ()) runParallel jobsSem e reportProgress formatResult = do   mvar <- newEmptyMVar   _ <- forkIO $ E.bracket_ (waitQSem jobsSem) (signalQSem jobsSem) $ do     let progressCallback = replaceMVar mvar . ReportProgress-    result <- evalExample (e progressCallback)+    result <- e progressCallback     replaceMVar mvar (ReportResult result)   return $ evalReport mvar   where@@ -93,15 +93,6 @@     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-  where-    forceResult :: Result -> Result-    forceResult r = case r of-      Success -> r-      Pending m -> m `deepseq` r-      Fail _ m -> m `deepseq` r- data Message = Done | Run (FormatM ())  run :: Chan Message -> (Path -> ProgressCallback) -> Config -> Formatter -> [EvalTree] -> FormatM ()@@ -121,9 +112,9 @@      queueSpec :: [String] -> EvalTree -> IO ()     queueSpec rGroups (Node group xs) = do-      defer (exampleGroupStarted formatter (reverse rGroups) group)+      defer (Formatter.interpret $ exampleGroupStarted formatter (reverse rGroups) group)       forM_ xs (queueSpec (group : rGroups))-      defer (exampleGroupDone formatter)+      defer (Formatter.interpret $ exampleGroupDone formatter)     queueSpec rGroups (NodeWithCleanup action xs) = do       forM_ xs (queueSpec rGroups)       defer (runCleanup (action ()) (reverse rGroups, "afterAll-hook"))@@ -138,22 +129,22 @@          reportProgress = reportProgress_ path -        formatResult :: Either E.SomeException Result -> FormatM ()+        formatResult :: FormatResult         formatResult result = do           case result of             Right Success -> do               increaseSuccessCount-              exampleSucceeded formatter path+              Formatter.interpret $ exampleSucceeded formatter path             Right (Pending reason) -> do               increasePendingCount-              examplePending formatter path reason-            Right (Fail loc_ err) -> failed (loc_ <|> loc) path (Right err)+              Formatter.interpret $ examplePending formatter path reason+            Right (Failure loc_ err) -> failed (loc_ <|> loc) path (Right err)             Left err         -> failed loc path (Left  err)      failed loc path err = do       increaseFailCount       addFailMessage loc path err-      exampleFailed formatter path err+      Formatter.interpret $ exampleFailed formatter path err  processMessages :: IO Message -> Bool -> FormatM () processMessages getMessage fastFail = go@@ -161,6 +152,6 @@     go = liftIO getMessage >>= \m -> case m of       Run action -> do         action-        fails <- getFailCount+        fails <- Formatter.interpret getFailCount         unless (fastFail && fails /= 0) go       Done -> return ()
hspec-core/src/Test/Hspec/Core/Spec.hs view
@@ -8,10 +8,16 @@ module Test.Hspec.Core.Spec (  -- * Defining a spec-  describe-, it+  it+, specify+, describe+, context , pending , pendingWith+, xit+, xspecify+, xdescribe+, xcontext , parallel  -- * The @SpecM@ monad@@ -30,6 +36,7 @@ import           Test.Hspec.Expectations (Expectation)  import           Test.Hspec.Core.Example+import           Test.Hspec.Core.Hooks import           Test.Hspec.Core.Tree import           Test.Hspec.Core.Spec.Monad @@ -37,6 +44,21 @@ describe :: String -> SpecWith a -> SpecWith a describe label spec = runIO (runSpecM spec) >>= fromSpecList . return . specGroup label +-- | @context@ is an alias for `describe`.+context :: String -> SpecWith a -> SpecWith a+context = describe++-- |+-- Changing `describe` to `xdescribe` marks all spec items of the corresponding subtree as pending.+--+-- This can be used to temporarily disable spec items.+xdescribe :: String -> SpecWith a -> SpecWith a+xdescribe label spec = before_ pending $ describe label spec++-- | @xcontext@ is an alias for `xdescribe`.+xcontext :: String -> SpecWith a -> SpecWith a+xcontext = xdescribe+ -- | The @it@ function creates a spec item. -- -- A spec item consists of:@@ -51,12 +73,27 @@ it :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it label action = fromSpecList [specItem label action] +-- | @specify@ is an alias for `it`.+specify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)+specify = it++-- |+-- Changing `it` to `xit` marks the corresponding spec item as pending.+--+-- This can be used to temporarily disable a spec item.+xit :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)+xit label action = before_ pending $ it label action++-- | @xspecify@ is an alias for `xit`.+xspecify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)+xspecify = xit+ -- | `parallel` marks all spec items of the given spec to be safe for parallel -- evaluation. parallel :: SpecWith a -> SpecWith a parallel = mapSpecItem_ $ \item -> item {itemIsParallelizable = True} --- | `pending` can be used to indicate that an example is /pending/.+-- | `pending` can be used to mark a spec item as pending. -- -- If you want to textually specify a behavior but do not have an example yet, -- use this:@@ -69,6 +106,6 @@  -- | -- `pendingWith` is similar to `pending`, but it takes an additional string--- argument that can be used to specify the reason for why it's pending.+-- argument that can be used to specify the reason for why the spec item is pending. pendingWith :: String -> Expectation pendingWith = E.throwIO . Pending . Just
hspec-core/src/Test/Hspec/Core/Spec/Monad.hs view
@@ -14,7 +14,7 @@ ) where  import           Prelude ()-import           Test.Hspec.Compat+import           Test.Hspec.Core.Compat  import           Control.Monad.Trans.Writer import           Control.Monad.IO.Class (liftIO)
+ hspec-core/src/Test/Hspec/Core/Timer.hs view
@@ -0,0 +1,14 @@+module Test.Hspec.Core.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
hspec-core/src/Test/Hspec/Core/Tree.hs view
@@ -15,9 +15,10 @@ ) where  import           Data.CallStack+import           Control.Exception  import           Prelude ()-import           Test.Hspec.Compat+import           Test.Hspec.Core.Compat  import           Test.Hspec.Core.Example @@ -51,7 +52,7 @@   -- parallel with other spec items , itemIsParallelizable :: Bool   -- | Example for behavior-, itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result+, itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO (Either SomeException Result) }  -- | The @specGroup@ function combines a list of specs into a larger spec.@@ -64,7 +65,7 @@  -- | The @specItem@ function creates a spec item. specItem :: (HasCallStack, Example a) => String -> a -> SpecTree (Arg a)-specItem s e = Leaf $ Item requirement location False (evaluateExample e)+specItem s e = Leaf $ Item requirement location False (safeEvaluateExample e)   where     requirement       | null s = "(unspecified behavior)"
hspec-core/src/Test/Hspec/Core/Util.hs view
@@ -21,7 +21,7 @@ import           Control.Exception import           Control.Concurrent.Async -import           Test.Hspec.Compat (showType)+import           Test.Hspec.Core.Compat (showType)  -- | -- @pluralize count singular@ pluralizes the given @singular@ word unless given@@ -46,7 +46,7 @@ strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse  -- |--- ensure that lines are not longer then given `n`, insert line breaks at word+-- ensure that lines are not longer than given `n`, insert line breaks at word -- boundaries lineBreaksAt :: Int -> String -> [String] lineBreaksAt n input = case words input of@@ -129,4 +129,13 @@ -- occurs, the exception is returned instead.  Unlike `try` it is agnostic to -- asynchronous exceptions. safeTry :: IO a -> IO (Either SomeException a)-safeTry action = withAsync (action >>= evaluate) waitCatch+safeTry action = bracket runAction cancelAction waitForAction+  where+    runAction = async ((action >>= evaluate))+    waitForAction = waitCatch+    cancelAction a = do+      cancel a+      -- It is important to wait here to make sure all finalizers in action have+      -- been run. Otherwise the main thread can exit before they have finished+      -- and the finalizers are only partially run.+      waitCatch a -- We use waitCatch to hide the ThreadKilled exception
− hspec-core/src/Test/Hspec/FailureReport.hs 
@@ -1,49 +0,0 @@-{-# LANGUAGE CPP #-}-module Test.Hspec.FailureReport (-  FailureReport (..)-, writeFailureReport-, readFailureReport-) where--#ifndef __GHCJS__-import           System.SetEnv-import           Test.Hspec.Core.Util (safeTry)-#endif-import           System.IO-import           Test.Hspec.Compat-import           Test.Hspec.Core.Util (Path)--data FailureReport = FailureReport {-  failureReportSeed :: Integer-, failureReportMaxSuccess :: Int-, failureReportMaxSize :: Int-, failureReportMaxDiscardRatio :: Int-, failureReportPaths :: [Path]-} deriving (Eq, Show, Read)--writeFailureReport :: FailureReport -> IO ()-#ifdef __GHCJS__-writeFailureReport _ = return ()-  -- ghcjs currently does not support setting environment variables-  -- (https://github.com/ghcjs/ghcjs/issues/263). Since writing a failure report-  -- into the environment is a non-essential feature we just disable this to be-  -- able to run hspec test-suites with ghcjs at all. Should be reverted once-  -- the issue is fixed.-#else-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 ++ ")")-#endif--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
− hspec-core/src/Test/Hspec/Options.hs 
@@ -1,198 +0,0 @@-module Test.Hspec.Options (-  Config(..)-, ColorMode (..)-, defaultConfig-, filterOr-, parseOptions-) where--import           Prelude ()-import           Control.Monad-import           Test.Hspec.Compat--import           System.IO-import           System.Exit-import           System.Console.GetOpt--import           Test.Hspec.Core.Formatters-import           Test.Hspec.Core.Util-import           Test.Hspec.Core.Example (Params(..), defaultParams)--data Config = Config {-  configDryRun :: Bool-, configPrintCpuTime :: Bool-, configFastFail :: Bool---- |--- A predicate that is used to filter the spec before it is run.  Only examples--- that satisfy the predicate are run.-, configRerun :: Bool-, configFilterPredicate :: Maybe (Path -> Bool)-, configSkipPredicate :: Maybe (Path -> Bool)-, configQuickCheckSeed :: Maybe Integer-, configQuickCheckMaxSuccess :: Maybe Int-, configQuickCheckMaxDiscardRatio :: Maybe Int-, configQuickCheckMaxSize :: Maybe Int-, configSmallCheckDepth :: Int-, configColorMode :: ColorMode-, configFormatter :: Maybe Formatter-, configHtmlOutput :: Bool-, configOutputFile :: Either Handle FilePath-, configConcurrentJobs :: Maybe Int-}--defaultConfig :: Config-defaultConfig = Config {-  configDryRun = False-, configPrintCpuTime = False-, configFastFail = False-, configRerun = False-, configFilterPredicate = Nothing-, configSkipPredicate = Nothing-, configQuickCheckSeed = Nothing-, configQuickCheckMaxSuccess = Nothing-, configQuickCheckMaxDiscardRatio = Nothing-, configQuickCheckMaxSize = Nothing-, configSmallCheckDepth = paramsSmallCheckDepth defaultParams-, configColorMode = ColorAuto-, configFormatter = Nothing-, configHtmlOutput = False-, configOutputFile = Left stdout-, configConcurrentJobs = Nothing-}--filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool)-filterOr p1_ p2_ = case (p1_, p2_) of-  (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path-  _ -> p1_ <|> p2_--addMatch :: String -> Config -> Config-addMatch s c = c {configFilterPredicate = Just (filterPredicate s) `filterOr` configFilterPredicate c}--addSkip :: String -> Config -> Config-addSkip s c = c {configSkipPredicate = Just (filterPredicate s) `filterOr` configSkipPredicate c}--setDepth :: Int -> Config -> Config-setDepth n c = c {configSmallCheckDepth = n}--setMaxSuccess :: Int -> Config -> Config-setMaxSuccess n c = c {configQuickCheckMaxSuccess = Just n}--setMaxSize :: Int -> Config -> Config-setMaxSize n c = c {configQuickCheckMaxSize = Just n}--setMaxDiscardRatio :: Int -> Config -> Config-setMaxDiscardRatio n c = c {configQuickCheckMaxDiscardRatio = Just n}--setSeed :: Integer -> Config -> Config-setSeed n c = c {configQuickCheckSeed = Just n}--data ColorMode = ColorAuto | ColorNever | ColorAlways-  deriving (Eq, Show)--formatters :: [(String, Formatter)]-formatters = [-    ("specdoc", specdoc)-  , ("progress", progress)-  , ("failed-examples", failed_examples)-  , ("silent", silent)-  ]--formatHelp :: String-formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map (("   " ++) . fst) formatters)--type Result = Either NoConfig Config--data NoConfig = Help | InvalidArgument String String--data Arg a = Arg {-  _argumentName   :: String-, _argumentParser :: String -> Maybe a-, _argumentSetter :: a -> Config -> Config-}--mkOption :: [Char] -> String -> Arg a -> String -> OptDescr (Result -> Result)-mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help-  where-    arg :: String -> Result -> Result-    arg input x = x >>= \c -> case parser input of-      Just n -> Right (setter n c)-      Nothing -> Left (InvalidArgument name input)--addLineBreaks :: String -> [String]-addLineBreaks = lineBreaksAt 44--options :: [OptDescr (Result -> Result)]-options = [-    Option   []  ["help"]             (NoArg (const $ Left Help))         (h "display this help and exit")-  , mkOption "m"  "match"             (Arg "PATTERN" return addMatch)     (h "only run examples that match given PATTERN")-  , mkOption []   "skip"              (Arg "PATTERN" return addSkip)      (h "skip 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)")-  , mkOption "j"  "jobs"              (Arg "N" readMaxJobs setMaxJobs)    (h "run at most N parallelizable tests simultaneously (default: number of available processors)")-  ]-  where-    h = unlines . addLineBreaks--    readFormatter :: String -> Maybe Formatter-    readFormatter = (`lookup` formatters)--    readMaxJobs :: String -> Maybe Int-    readMaxJobs s = do-      n <- readMaybe s-      guard $ n > 0-      return n--    setFormatter :: Formatter -> Config -> Config-    setFormatter f c = c {configFormatter = Just f}--    setOutputFile :: String -> Config -> Config-    setOutputFile file c = c {configOutputFile = Right file}--    setMaxJobs :: Int -> Config -> Config-    setMaxJobs n c = c {configConcurrentJobs = Just n}--    setPrintCpuTime x = x >>= \c -> return c {configPrintCpuTime = True}-    setDryRun       x = x >>= \c -> return c {configDryRun = True}-    setFastFail     x = x >>= \c -> return c {configFastFail = True}-    setRerun        x = x >>= \c -> return c {configRerun = True}-    setNoColor      x = x >>= \c -> return c {configColorMode = ColorNever}-    setColor        x = x >>= \c -> return c {configColorMode = ColorAlways}--undocumentedOptions :: [OptDescr (Result -> Result)]-undocumentedOptions = [-    -- for compatibility with test-framework-    mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default"--    -- undocumented for now, as we probably want to change this to produce a-    -- standalone HTML report in the future-  , Option []  ["html"]                    (NoArg setHtml)                    "produce HTML output"--    -- now a noop-  , Option "v" ["verbose"]                 (NoArg id)                         "do not suppress output to stdout when evaluating examples"-  ]-  where-    setHtml :: Result -> Result-    setHtml x = x >>= \c -> return c {configHtmlOutput = True}--parseOptions :: Config -> String -> [String] -> Either (ExitCode, String) Config-parseOptions c prog args = case getOpt Permute (options ++ undocumentedOptions) args of-    (opts, [], []) -> case foldl' (flip id) (Right c) opts of-        Left Help                         -> Left (ExitSuccess, usageInfo ("Usage: " ++ prog ++ " [OPTION]...\n\nOPTIONS") options)-        Left (InvalidArgument flag value) -> tryHelp ("invalid argument `" ++ value ++ "' for `--" ++ flag ++ "'\n")-        Right x -> Right x-    (_, _, err:_)  -> tryHelp err-    (_, arg:_, _)  -> tryHelp ("unexpected argument `" ++ arg ++ "'\n")-  where-    tryHelp msg = Left (ExitFailure 1, prog ++ ": " ++ msg ++ "Try `" ++ prog ++ " --help' for more information.\n")
− hspec-core/src/Test/Hspec/Timer.hs 
@@ -1,14 +0,0 @@-module Test.Hspec.Timer where--import           Data.IORef-import           Data.Time.Clock.POSIX--newTimer :: POSIXTime -> IO (IO Bool)-newTimer delay = do-  ref <- getPOSIXTime >>= newIORef-  return $ do-    t0 <- readIORef ref-    t1 <- getPOSIXTime-    if delay < t1 - t0-      then writeIORef ref t1 >> return True-      else return False
+ hspec-core/vendor/Data/Algorithm/Diff.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE DeriveFunctor #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Algorithm.Diff+-- Copyright   :  (c) Sterling Clover 2008-2011, Kevin Charter 2011+-- License     :  BSD 3 Clause+-- Maintainer  :  s.clover@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- This is an implementation of the O(ND) diff algorithm as described in+-- \"An O(ND) Difference Algorithm and Its Variations (1986)\"+-- <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.4.6927>. It is O(mn) in space.+-- The algorithm is the same one used by standared Unix diff.+-----------------------------------------------------------------------------++module Data.Algorithm.Diff+    ( Diff(..)+    -- * Comparing lists for differences+    , getDiff+    , getDiffBy++    -- * Finding chunks of differences+    , getGroupedDiff+    , getGroupedDiffBy+    ) where++import Prelude hiding (pi)++import Data.Array++data DI = F | S | B deriving (Show, Eq)++-- | A value is either from the 'First' list, the 'Second' or from 'Both'.+-- 'Both' contains both the left and right values, in case you are using a form+-- of equality that doesn't check all data (for example, if you are using a+-- newtype to only perform equality on side of a tuple).+data Diff a = First a | Second a | Both a a deriving (Show, Eq, Functor)++data DL = DL {poi :: !Int, poj :: !Int, path::[DI]} deriving (Show, Eq)++instance Ord DL+        where x <= y = if poi x == poi y+                then  poj x > poj y+                else poi x <= poi y++canDiag :: (a -> a -> Bool) -> [a] -> [a] -> Int -> Int -> Int -> Int -> Bool+canDiag eq as bs lena lenb = \ i j ->+   if i < lena && j < lenb then (arAs ! i) `eq` (arBs ! j) else False+    where arAs = listArray (0,lena - 1) as+          arBs = listArray (0,lenb - 1) bs++dstep :: (Int -> Int -> Bool) -> [DL] -> [DL]+dstep cd dls = hd:pairMaxes rst+  where (hd:rst) = nextDLs dls+        nextDLs [] = []+        nextDLs (dl:rest) = dl':dl'':nextDLs rest+          where dl'  = addsnake cd $ dl {poi=poi dl + 1, path=(F : pdl)}+                dl'' = addsnake cd $ dl {poj=poj dl + 1, path=(S : pdl)}+                pdl = path dl+        pairMaxes [] = []+        pairMaxes [x] = [x]+        pairMaxes (x:y:rest) = max x y:pairMaxes rest++addsnake :: (Int -> Int -> Bool) -> DL -> DL+addsnake cd dl+    | cd pi pj = addsnake cd $+                 dl {poi = pi + 1, poj = pj + 1, path=(B : path dl)}+    | otherwise   = dl+    where pi = poi dl; pj = poj dl++lcs :: (a -> a -> Bool) -> [a] -> [a] -> [DI]+lcs eq as bs = path . head . dropWhile (\dl -> poi dl /= lena || poj dl /= lenb) .+            concat . iterate (dstep cd) . (:[]) . addsnake cd $+            DL {poi=0,poj=0,path=[]}+            where cd = canDiag eq as bs lena lenb+                  lena = length as; lenb = length bs++-- | Takes two lists and returns a list of differences between them. This is+-- 'getDiffBy' with '==' used as predicate.+getDiff :: (Eq t) => [t] -> [t] -> [Diff t]+getDiff = getDiffBy (==)++-- | Takes two lists and returns a list of differences between them, grouped+-- into chunks. This is 'getGroupedDiffBy' with '==' used as predicate.+getGroupedDiff :: (Eq t) => [t] -> [t] -> [Diff [t]]+getGroupedDiff = getGroupedDiffBy (==)++-- | A form of 'getDiff' with no 'Eq' constraint. Instead, an equality predicate+-- is taken as the first argument.+getDiffBy :: (t -> t -> Bool) -> [t] -> [t] -> [Diff t]+getDiffBy eq a b = markup a b . reverse $ lcs eq a b+    where markup (x:xs)   ys   (F:ds) = First x  : markup xs ys ds+          markup   xs   (y:ys) (S:ds) = Second y : markup xs ys ds+          markup (x:xs) (y:ys) (B:ds) = Both x y : markup xs ys ds+          markup _ _ _ = []++getGroupedDiffBy :: (t -> t -> Bool) -> [t] -> [t] -> [Diff [t]]+getGroupedDiffBy eq a b = go $ getDiffBy eq a b+    where go (First x  : xs) = let (fs, rest) = goFirsts  xs in First  (x:fs)     : go rest+          go (Second x : xs) = let (fs, rest) = goSeconds xs in Second (x:fs)     : go rest+          go (Both x y : xs) = let (fs, rest) = goBoth    xs+                                   (fxs, fys) = unzip fs+                               in Both (x:fxs) (y:fys) : go rest+          go [] = []++          goFirsts  (First x  : xs) = let (fs, rest) = goFirsts  xs in (x:fs, rest)+          goFirsts  xs = ([],xs)++          goSeconds (Second x : xs) = let (fs, rest) = goSeconds xs in (x:fs, rest)+          goSeconds xs = ([],xs)++          goBoth    (Both x y : xs) = let (fs, rest) = goBoth xs    in ((x,y):fs, rest)+          goBoth    xs = ([],xs)
hspec-discover/src/Test/Hspec/Discover/Run.hs view
@@ -48,7 +48,7 @@         hPutStrLn stderr err         exitFailure       Right conf -> do-        when (configNested conf) (hPutStrLn stderr "hspec-discover: WARNING - The `--nested' flag is deprecated and will be removed in a future release!")+        when (configNested conf) (hPutStrLn stderr "hspec-discover: WARNING - The `--nested' option is deprecated and will be removed in a future release!")         specs <- findSpecs src         writeFile dst (mkSpecModule src conf specs)     _ -> do
hspec-meta.cabal view
@@ -1,12 +1,12 @@--- This file has been generated from package.yaml by hpack version 0.15.0.+-- This file has been generated from package.yaml by hpack version 0.18.0. -- -- see: https://github.com/sol/hpack  name:             hspec-meta-version:          2.3.2+version:          2.4.4 license:          MIT license-file:     LICENSE-copyright:        (c) 2011-2015 Simon Hengel,+copyright:        (c) 2011-2017 Simon Hengel,                   (c) 2011-2012 Trystan Spangler,                   (c) 2011 Greg Weber maintainer:       Simon Hengel <sol@typeful.net>@@ -21,7 +21,7 @@                   in-development version of Hspec.  extra-source-files:-    changelog+    CHANGES.markdown  source-repository head   type: git@@ -32,6 +32,7 @@   hs-source-dirs:       src       hspec-core/src+      hspec-core/vendor/   build-depends:       base == 4.*     , transformers >= 0.2.2.0@@ -46,6 +47,9 @@     , time     , async     , call-stack+    , array+    , directory+    , filepath   exposed-modules:       Test.Hspec.Meta   other-modules:@@ -56,23 +60,27 @@       Test.Hspec.HUnit       Test.Hspec.QuickCheck       Test.Hspec.Runner-      Test.Hspec.Compat-      Test.Hspec.Config+      Test.Hspec.Core.Compat+      Test.Hspec.Core.Config       Test.Hspec.Core.Example+      Test.Hspec.Core.FailureReport       Test.Hspec.Core.Formatters+      Test.Hspec.Core.Formatters.Diff+      Test.Hspec.Core.Formatters.Free       Test.Hspec.Core.Formatters.Internal+      Test.Hspec.Core.Formatters.Monad       Test.Hspec.Core.Hooks+      Test.Hspec.Core.Options       Test.Hspec.Core.QuickCheck       Test.Hspec.Core.QuickCheckUtil       Test.Hspec.Core.Runner       Test.Hspec.Core.Runner.Eval       Test.Hspec.Core.Spec       Test.Hspec.Core.Spec.Monad+      Test.Hspec.Core.Timer       Test.Hspec.Core.Tree       Test.Hspec.Core.Util-      Test.Hspec.FailureReport-      Test.Hspec.Options-      Test.Hspec.Timer+      Data.Algorithm.Diff       Paths_hspec_meta   default-language: Haskell2010 @@ -96,6 +104,9 @@     , time     , async     , call-stack+    , array+    , directory+    , filepath     , filepath     , directory   other-modules:
src/Test/Hspec.hs view
@@ -17,16 +17,28 @@ , module Test.Hspec.Expectations  -- * Defining a spec-, describe-, context , it , specify+, describe+, context , example-, pending-, pendingWith , parallel , runIO +-- * Pending spec items+-- |+-- During a test run a /pending/ spec item is:+--+-- 1. not executed+--+-- 1. reported as \"pending\"+, pending+, pendingWith+, xit+, xspecify+, xdescribe+, xcontext+ -- * Hooks , ActionWith , before@@ -65,11 +77,3 @@ -- >   putStrLn example :: Expectation -> Expectation example = id---- | @context@ is an alias for `describe`.-context :: String -> SpecWith a -> SpecWith a-context = describe---- | @specify@ is an alias for `it`.-specify :: Example a => String -> a -> SpecWith (Arg a)-specify = it