hspec-meta 2.6.0 → 2.7.8

raw patch · 32 files changed

+1509/−743 lines, 32 filesdep −HUnitdep −hspec-expectationsdep ~QuickChecksetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: HUnit, hspec-expectations

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• CHANGES.markdown +0/−559
• LICENSE +1/−1
• Setup.lhs +0/−3
• hspec-core/src/Test/Hspec/Core/Clock.hs +5/−0
• hspec-core/src/Test/Hspec/Core/Compat.hs +8/−0
• hspec-core/src/Test/Hspec/Core/Config.hs +38/−8
• hspec-core/src/Test/Hspec/Core/Config/Options.hs +31/−6
• hspec-core/src/Test/Hspec/Core/Example.hs +13/−7
• hspec-core/src/Test/Hspec/Core/Example/Location.hs +16/−0
• hspec-core/src/Test/Hspec/Core/Format.hs +2/−1
• hspec-core/src/Test/Hspec/Core/Formatters.hs +30/−19
• hspec-core/src/Test/Hspec/Core/Formatters/Internal.hs +17/−6
• hspec-core/src/Test/Hspec/Core/Hooks.hs +73/−1
• hspec-core/src/Test/Hspec/Core/Runner.hs +136/−67
• hspec-core/src/Test/Hspec/Core/Runner/Eval.hs +24/−25
• hspec-core/src/Test/Hspec/Core/Shuffle.hs +45/−0
• hspec-core/src/Test/Hspec/Core/Spec.hs +1/−1
• hspec-core/src/Test/Hspec/Core/Spec/Monad.hs +5/−3
• hspec-core/src/Test/Hspec/Core/Tree.hs +43/−2
• hspec-core/src/Test/Hspec/Core/Util.hs +1/−1
• hspec-core/vendor/Control/Concurrent/Async.hs +1/−1
• hspec-meta.cabal +37/−32
• src/Test/Hspec.hs +1/−0
• vendor/HUnit-1.6.2.0/src/Test/HUnit.hs +80/−0
• vendor/HUnit-1.6.2.0/src/Test/HUnit/Base.hs +361/−0
• vendor/HUnit-1.6.2.0/src/Test/HUnit/Lang.hs +104/−0
• vendor/HUnit-1.6.2.0/src/Test/HUnit/Terminal.hs +42/−0
• vendor/HUnit-1.6.2.0/src/Test/HUnit/Text.hs +152/−0
• vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations.hs +189/−0
• vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations/Contrib.hs +26/−0
• vendor/hspec-expectations-0.8.2/src/Test/Hspec/Expectations/Matcher.hs +26/−0
• version.yaml +1/−0

@@ -1,559 +0,0 @@-## Changes in 2.6.0-   - Allow to focus individual spec items (see #319)-   - Do not calculate diff on `--no-diff` (see #332)-   - Remove deprecated module Test.Hspec.Core--## Changes in 2.5.9-   - Extract source locations from RecConError (see #375)--## Changes in 2.5.8-   - Add `modifyArgs` and `modifyMaxShrinks` to `Test.Hspec.QuickCheck` (see #380)--## Changes in 2.5.7-   - GHC 8.6.1 related changes--## Changes in 2.5.6-   - Compatibility with `QuickCheck-2.12`--## Changes in 2.5.5-  - Use `module[line:column]` instead of `module:line:column` as default label-    for `describe`/`it` (fixes #366)--## Changes in 2.5.4-  - Show how to rerun individual spec items on test failures (see #205)--## Changes in 2.5.3-  - Treat character escapes like `\NUL` as single tokens on `--diff` (see #351)-  - Allow a `/` at the beginning and at the end of an absolute path that is-    passed to `--match` or `--skip`--## Changes in 2.5.2-  - Use module:line:column as default label for describe/it (see #250)-  - Warn if user is affected by https://ghc.haskell.org/trac/ghc/ticket/13285 (see #329)--## Changes in 2.5.1-  - Disable tests for Test.Hspec.Core.Timer (see #352)--## Changes in 2.5.0-  - Add `sequential` (see #311)-  - Add support for `--diff` when `shouldBe` is uesd with-    `QuickCheck`-properties-  - Add source locations when `shouldBe` is uesd with `QuickCheck` properties-  - Print `QuickCheck` labels on success (see #297)-  - Retain output of `verbose`, `label`, `collect`, `classify`, etc. for-    `QuickCheck` properties (see #257)-  - Extract source location from error / undefined (see #316)-  - Parse source locations from pattern match failures-  - Include source column when formatting source locations-  - Colorize whitespaces with background color instead of foreground color with-    `--diff`-  - Run `Test.Hspec.Core.Formatters.exampleProgress` in `FormatM` instead of-    `IO`-  - Make sure that progress output is always cleared (fixes #301)-  - Add location information to `pending` (not used by any formatter yet)-  - Include duration for each spec item in new formatter API (see #315) (not yet exposed)-  - Removed deprecated module `Test.Hspec.HUnit`, use-    `Test.Hspec.Contrib.HUnit` instead-  - Deprecate `--out`-  - Remove `BestEffort` source locations--## Changes in 2.4.8-  - compatibility with GHC 8.4.1-alpha3--## Changes in 2.4.7-  - compatibility with `QuickCheck-2.11.3` and up (note that `QuickCheck`-    versions `2.11` to `2.11.2` are not fully supported)--## Changes in 2.4.6-  - compatibility with the upcoming version `4.11.0.0` of `base`--## Changes in 2.4.5-  - `hspec-discover`: Sort specs using natural sort order--## Changes in 2.4.4-  - Require quickcheck-io >= 0.2.0--## 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.

@@ -1,4 +1,4 @@-Copyright (c) 2011-2018 Simon Hengel <sol@typeful.net>+Copyright (c) 2011-2021 Simon Hengel <sol@typeful.net> Copyright (c) 2011-2012 Trystan Spangler <trystan.s@comcast.net> Copyright (c) 2011-2011 Greg Weber <greg@gregweber.info> 

@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain

@@ -5,11 +5,13 @@ , getMonotonicTime , measure , sleep+, timeout ) where  import           Text.Printf import           System.Clock import           Control.Concurrent+import qualified System.Timeout as System  newtype Seconds = Seconds Double   deriving (Eq, Show, Num, Fractional, PrintfArg)@@ -31,3 +33,6 @@  sleep :: Seconds -> IO () sleep = threadDelay . toMicroseconds++timeout :: Seconds -> IO a -> IO (Maybe a)+timeout = System.timeout . toMicroseconds

@@ -20,6 +20,8 @@ , atomicWriteIORef #endif , interruptible++, guarded ) where  import           Control.Applicative@@ -58,6 +60,9 @@   , sequence   , sequence_   , sum+#if !MIN_VERSION_base(4,6,0)+  , catch+#endif   )  import           Data.Typeable (Typeable, typeOf, typeRepTyCon)@@ -139,3 +144,6 @@     MaskedInterruptible   -> unsafeUnmask act     MaskedUninterruptible -> act #endif++guarded :: Alternative m => (a -> Bool) -> a -> m a+guarded p a = if p a then pure a else empty

@@ -3,9 +3,12 @@   Config (..) , ColorMode(..) , defaultConfig-, getConfig+, readConfig , configAddFilter , configQuickCheckArgs++, readFailureReportOnRerun+, applyFailureReport #ifdef TEST , readConfigFiles #endif@@ -21,6 +24,7 @@ import           System.Exit import           System.FilePath import           System.Directory+import           System.Environment (getProgName) import qualified Test.QuickCheck as QC  import           Test.Hspec.Core.Util@@ -36,8 +40,8 @@     configFilterPredicate = Just p1 `filterOr` configFilterPredicate c   } -mkConfig :: Maybe FailureReport -> Config -> Config-mkConfig mFailureReport opts = opts {+applyFailureReport :: Maybe FailureReport -> Config -> Config+applyFailureReport mFailureReport opts = opts {     configFilterPredicate = matchFilter `filterOr` rerunFilter   , configQuickCheckSeed = mSeed   , configQuickCheckMaxSuccess = mMaxSuccess@@ -79,8 +83,31 @@     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+-- |+-- `readConfig` parses config options from several sources and constructs a+-- `Config` value.  It takes options from:+--+-- 1. @~/.hspec@ (a config file in the user's home directory)+-- 1. @.hspec@ (a config file in the current working directory)+-- 1. the environment variable @HSPEC_OPTIONS@+-- 1. the provided list of command-line options (the second argument to @readConfig@)+--+-- (precedence from low to high)+--+-- When parsing fails then @readConfig@ writes an error message to `stderr` and+-- exits with `exitFailure`.+--+-- When @--help@ is provided as a command-line option then @readConfig@ writes+-- a help message to `stdout` and exits with `exitSuccess`.+--+-- A common way to use @readConfig@ is:+--+-- @+-- `System.Environment.getArgs` >>= readConfig `defaultConfig`+-- @+readConfig :: Config -> [String] -> IO Config+readConfig opts_ args = do+  prog <- getProgName   configFiles <- do     ignore <- ignoreConfigFile opts_ args     case ignore of@@ -89,9 +116,12 @@   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)+    Right opts -> return opts++readFailureReportOnRerun :: Config -> IO (Maybe FailureReport)+readFailureReportOnRerun config+  | configRerun config = readFailureReport config+  | otherwise = return Nothing  readConfigFiles :: IO [ConfigFile] readConfigFiles = do

@@ -33,8 +33,11 @@ data Config = Config {   configIgnoreConfigFile :: Bool , configDryRun :: Bool+, configFocusedOnly :: Bool+, configFailOnFocused :: Bool , configPrintCpuTime :: Bool , configFastFail :: Bool+, configRandomize :: Bool , configFailureReport :: Maybe FilePath , configRerun :: Bool , configRerunAllOnSuccess :: Bool@@ -61,8 +64,11 @@ defaultConfig = Config {   configIgnoreConfigFile = False , configDryRun = False+, configFocusedOnly = False+, configFailOnFocused = False , configPrintCpuTime = False , configFastFail = False+, configRandomize = False , configFailureReport = Nothing , configRerun = False , configRerunAllOnSuccess = False@@ -190,12 +196,18 @@   ]  runnerOptions :: Monad m => [OptDescr (Result m -> Result m)]-runnerOptions = [-    Option [] ["dry-run"] (NoArg setDryRun) "pretend that everything passed; don't verify anything"-  , Option [] ["fail-fast"] (NoArg setFastFail) "abort on first failure"-  , Option "r" ["rerun"] (NoArg  setRerun) "rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)"+runnerOptions = concat [+    mkFlag "dry-run" setDryRun "pretend that everything passed; don't verify anything"+  , mkFlag "focused-only" setFocusedOnly "do not run anything, unless there are focused spec items"+  , mkFlag "fail-on-focused" setFailOnFocused "fail on focused spec items"+  , mkFlag "fail-fast" setFastFail "abort on first failure"+  , mkFlag "randomize" setRandomize "randomize execution order"+  ] ++ [+    Option "r" ["rerun"] (NoArg  setRerun) "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) "read/write a failure report for use with --rerun"   , Option [] ["rerun-all-on-success"] (NoArg setRerunAllOnSuccess) "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) "run at most N parallelizable tests simultaneously (default: number of available processors)"   ]   where@@ -211,8 +223,21 @@     setMaxJobs :: Int -> Config -> Config     setMaxJobs n c = c {configConcurrentJobs = Just n} -    setDryRun       = set $ \config -> config {configDryRun = True}-    setFastFail     = set $ \config -> config {configFastFail = True}+    setDryRun :: Bool -> Config -> Config+    setDryRun value config = config {configDryRun = value}++    setFocusedOnly :: Bool -> Config -> Config+    setFocusedOnly value config = config {configFocusedOnly = value}++    setFailOnFocused :: Bool -> Config -> Config+    setFailOnFocused value config = config {configFailOnFocused = value}++    setFastFail :: Bool -> Config -> Config+    setFastFail value config = config {configFastFail = value}++    setRandomize :: Bool -> Config -> Config+    setRandomize value config = config {configRandomize = value}+     setRerun        = set $ \config -> config {configRerun = True}     setRerunAllOnSuccess = set $ \config -> config {configRerunAllOnSuccess = True} 

@@ -4,6 +4,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-}++-- NOTE: re-exported from Test.Hspec.Core.Spec module Test.Hspec.Core.Example (   Example (..) , Params (..)@@ -15,6 +17,7 @@ , ResultStatus (..) , Location (..) , FailureReason (..)+, safeEvaluate , safeEvaluateExample ) where @@ -88,13 +91,7 @@ instance Exception ResultStatus  safeEvaluateExample :: Example e => e -> Params -> (ActionWith (Arg e) -> IO ()) -> ProgressCallback -> IO Result-safeEvaluateExample example params around progress = do-  r <- safeTry $ forceResult <$> evaluateExample example params around progress-  return $ case r of-    Left e | Just result <- fromException e -> Result "" result-    Left e | Just hunit <- fromException e -> Result "" $ hunitFailureToResult Nothing hunit-    Left e -> Result "" $ Failure Nothing $ Error Nothing e-    Right result -> result+safeEvaluateExample example params around progress = safeEvaluate $ forceResult <$> evaluateExample example params around progress   where     forceResult :: Result -> Result     forceResult r@(Result info status) = info `deepseq` (forceResultStatus status) `seq` r@@ -104,6 +101,15 @@       Success -> r       Pending _ m -> m `deepseq` r       Failure _ m -> m `deepseq` r++safeEvaluate :: IO Result -> IO Result+safeEvaluate action = do+  r <- safeTry $ action+  return $ case r of+    Left e | Just result <- fromException e -> Result "" result+    Left e | Just hunit <- fromException e -> Result "" $ hunitFailureToResult Nothing hunit+    Left e -> Result "" $ Failure Nothing $ Error Nothing e+    Right result -> result  instance Example Result where   type Arg Result = ()

@@ -4,6 +4,7 @@ , extractLocation  -- for testing+, parseAssertionFailed , parseCallStack , parseLocation , parseSourceSpan@@ -31,6 +32,21 @@   <|> locationFromPatternMatchFail e   <|> locationFromRecConError e   <|> locationFromIOException e+  <|> locationFromNoMethodError e+  <|> locationFromAssertionFailed e++locationFromNoMethodError :: SomeException -> Maybe Location+locationFromNoMethodError e = case fromException e of+  Just (NoMethodError s) -> listToMaybe (words s) >>= parseSourceSpan+  Nothing -> Nothing++locationFromAssertionFailed :: SomeException -> Maybe Location+locationFromAssertionFailed e = case fromException e of+  Just (AssertionFailed loc) -> parseAssertionFailed loc+  Nothing -> Nothing++parseAssertionFailed :: String -> Maybe Location+parseAssertionFailed loc = parseCallStack loc <|> parseSourceSpan loc  locationFromErrorCall :: SomeException -> Maybe Location locationFromErrorCall e = case fromException e of

@@ -20,12 +20,13 @@ , itemDuration :: Seconds , itemInfo :: String , itemResult :: Result-}+} deriving Show  data Result =     Success   | Pending (Maybe String)   | Failure FailureReason+  deriving Show  data Format m = Format {   formatRun :: forall a. m a -> IO a

@@ -3,7 +3,7 @@ -- Stability: experimental -- -- This module contains formatters that can be used with--- `Test.Hspec.Runner.hspecWith`.+-- `Test.Hspec.Core.Runner.hspecWith`. module Test.Hspec.Core.Formatters (  -- * Formatters@@ -61,8 +61,11 @@  import           Data.Maybe import           Test.Hspec.Core.Util+import           Test.Hspec.Core.Clock import           Test.Hspec.Core.Spec (Location(..)) import           Text.Printf+import           Control.Monad.IO.Class+import           Control.Exception  -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make -- sure, that we only use the public API to implement formatters.@@ -100,8 +103,6 @@   , missingChunk   ) -import           Test.Hspec.Core.Clock (Seconds(..))- import           Test.Hspec.Core.Formatters.Diff  silent :: Formatter@@ -212,28 +213,38 @@           mapM_ indent preface            b <- useDiff-          let-            chunks-              | b = diff expected actual-              | otherwise = [First expected, Second actual] -          withFailColor $ write (indentation ++ "expected: ")-          forM_ chunks $ \chunk -> case chunk of-            Both a _ -> indented write a-            First a -> indented extraChunk a-            Second _ -> return ()-          writeLine ""+          let threshold = 2 :: Seconds -          withFailColor $ write (indentation ++ " but got: ")-          forM_ chunks $ \chunk -> case chunk of-            Both a _ -> indented write a-            First _ -> return ()-            Second a -> indented missingChunk a-          writeLine ""+          mchunks <- liftIO $ if b+            then timeout threshold (evaluate $ diff expected actual)+            else return Nothing++          case mchunks of+            Just chunks -> do+              writeDiff chunks extraChunk missingChunk+            Nothing -> do+              writeDiff [First expected, Second actual] write write           where             indented output text = case break (== '\n') text of               (xs, "") -> output xs               (xs, _ : ys) -> output (xs ++ "\n") >> write (indentation ++ "          ") >> indented output ys++            writeDiff chunks extra missing = do+              withFailColor $ write (indentation ++ "expected: ")+              forM_ chunks $ \ chunk -> case chunk of+                Both a _ -> indented write a+                First a -> indented extra 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 missing a+              writeLine ""+         Error _ e -> withFailColor . indent $ (("uncaught exception: " ++) . formatException) e        writeLine ""

@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} module Test.Hspec.Core.Formatters.Internal (   FormatM , FormatConfig(..)@@ -9,6 +9,9 @@ , addFailMessage , finally_ , formatterToFormat+#ifdef TEST+, overwriteWith+#endif ) where  import           Prelude ()@@ -94,8 +97,8 @@ } deriving (Eq, Show)  data FormatterState = FormatterState {-  stateSuccessCount    :: Int-, statePendingCount    :: Int+  stateSuccessCount    :: !Int+, statePendingCount    :: !Int , stateFailMessages    :: [FailureRecord] , stateCpuStartTime    :: Maybe Integer , stateStartTime       :: Seconds@@ -149,10 +152,18 @@ getFailMessages :: FormatM [FailureRecord] getFailMessages = reverse `fmap` gets stateFailMessages +overwriteWith :: String -> String -> String+overwriteWith old new+  | n == 0 = new+  | otherwise = '\r' : new ++ replicate (n - length new) ' '+  where+    n = length old+ writeTransient :: String -> FormatM ()-writeTransient s = do-  write ("\r" ++ s)-  modify $ \ state -> state {stateTransientOutput = s}+writeTransient new = do+  old <- gets stateTransientOutput+  write $ old `overwriteWith` new+  modify $ \ state -> state {stateTransientOutput = new}   h <- getHandle   liftIO $ IO.hFlush h 

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} -- | Stability: provisional module Test.Hspec.Core.Hooks (   before@@ -5,6 +6,7 @@ , beforeWith , beforeAll , beforeAll_+, beforeAllWith , after , after_ , afterAll@@ -12,10 +14,17 @@ , around , around_ , aroundWith+, aroundAll+, aroundAll_+, aroundAllWith ) where -import           Control.Exception (SomeException, finally, throwIO, try)+import           Prelude ()+import           Test.Hspec.Core.Compat++import           Control.Exception (SomeException, finally, throwIO, try, catch) import           Control.Concurrent.MVar+import           Control.Concurrent.Async  import           Test.Hspec.Core.Example import           Test.Hspec.Core.Tree@@ -45,6 +54,12 @@   mvar <- runIO (newMVar Empty)   before_ (memoize mvar action) spec +-- | Run a custom action with an argument before the first spec item.+beforeAllWith :: (b -> IO a) -> SpecWith a -> SpecWith b+beforeAllWith action spec = do+  mvar <- runIO (newMVar Empty)+  beforeWith (memoize mvar . action) spec+ data Memoized a =     Empty   | Memoized a@@ -91,3 +106,60 @@ modifyAroundAction :: (ActionWith a -> ActionWith b) -> Item a -> Item b modifyAroundAction action item@Item{itemExample = e} =   item{ itemExample = \params aroundAction -> e params (aroundAction . action) }++-- | Wrap an action around the given spec.+aroundAll :: (ActionWith a -> IO ()) -> SpecWith a -> Spec+aroundAll action = aroundAllWith $ \ e () -> action e++-- | Wrap an action around the given spec.+aroundAll_ :: (IO () -> IO ()) -> SpecWith a -> SpecWith a+aroundAll_ action spec = do+  allSpecItemsDone <- runIO newEmptyMVar+  workerRef <- runIO newEmptyMVar+  let+    acquire :: IO ()+    acquire = do+      resource <- newEmptyMVar+      worker <- async $ do+        action $ do+          signal resource+          waitFor allSpecItemsDone+      putMVar workerRef worker+      unwrapExceptionsFromLinkedThread $ do+        link worker+        waitFor resource+    release :: IO ()+    release = signal allSpecItemsDone >> takeMVar workerRef >>= wait+  beforeAll_ acquire $ afterAll_ release spec++-- | Wrap an action around the given spec. Changes the arg type inside.+aroundAllWith :: forall a b. (ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b+aroundAllWith action spec = do+  allSpecItemsDone <- runIO newEmptyMVar+  workerRef <- runIO newEmptyMVar+  let+    acquire :: b -> IO a+    acquire b = do+      resource <- newEmptyMVar+      worker <- async $ do+        flip action b $ \ a -> do+          putMVar resource a+          waitFor allSpecItemsDone+      putMVar workerRef worker+      unwrapExceptionsFromLinkedThread $ do+        link worker+        takeMVar resource+    release :: IO ()+    release = signal allSpecItemsDone >> takeMVar workerRef >>= wait+  beforeAllWith acquire $ afterAll_ release spec++unwrapExceptionsFromLinkedThread :: IO a -> IO a+unwrapExceptionsFromLinkedThread = (`catch` \ (ExceptionInLinkedThread _ e) -> throwIO e)++type BinarySemaphore = MVar ()++signal :: BinarySemaphore -> IO ()+signal = flip putMVar ()++waitFor :: BinarySemaphore -> IO ()+waitFor = takeMVar

@@ -5,20 +5,30 @@ module Test.Hspec.Core.Runner ( -- * Running a spec   hspec-, hspecWith-, hspecResult-, hspecWithResult+, runSpec --- * Types-, Summary (..)+-- * Config , Config (..) , ColorMode (..) , Path , defaultConfig , configAddFilter+, readConfig +-- * Summary+, Summary (..)+, isSuccess+, evaluateSummary++-- * Legacy+-- | The following primitives are deprecated.  Use `runSpec` instead.+, hspecWith+, hspecResult+, hspecWithResult+ #ifdef TEST , rerunAll+, specToEvalForest #endif ) where @@ -27,9 +37,12 @@  import           Data.Maybe import           System.IO-import           System.Environment (getProgName, getArgs, withArgs)+import           System.Environment (getArgs, withArgs) import           System.Exit import qualified Control.Exception as E+import           System.Random+import           Control.Monad.ST+import           Data.STRef  import           System.Console.ANSI (hHideCursor, hShowCursor) import qualified Test.QuickCheck as QC@@ -41,51 +54,47 @@ import           Test.Hspec.Core.Formatters.Internal import           Test.Hspec.Core.FailureReport import           Test.Hspec.Core.QuickCheckUtil+import           Test.Hspec.Core.Shuffle  import           Test.Hspec.Core.Runner.Eval --- | Filter specs by given predicate.------ The predicate takes a list of "describe" labels and a "requirement".-filterSpecs :: Config -> [EvalTree] -> [EvalTree]-filterSpecs c = go []+applyFilterPredicates :: Config -> [EvalTree] -> [EvalTree]+applyFilterPredicates c = filterForestWithLabels p   where-    p :: Path -> Bool-    p path = (fromMaybe (const True) (configFilterPredicate c) path) &&-               not (fromMaybe (const False) (configSkipPredicate c) path)--    go :: [String] -> [EvalTree] -> [EvalTree]-    go groups = mapMaybe (goSpec groups)+    include :: Path -> Bool+    include = fromMaybe (const True) (configFilterPredicate c) -    goSpecs :: [String] -> [EvalTree] -> ([EvalTree] -> b) -> Maybe b-    goSpecs groups specs ctor = case go groups specs of-      [] -> Nothing-      xs -> Just (ctor xs)+    skip :: Path -> Bool+    skip = fromMaybe (const False) (configSkipPredicate c) -    goSpec :: [String] -> EvalTree -> Maybe (EvalTree)-    goSpec groups spec = case spec of-      Leaf item -> guard (p (groups, evalItemDescription item)) >> return spec-      Node group specs -> goSpecs (groups ++ [group]) specs (Node group)-      NodeWithCleanup action specs -> goSpecs groups specs (NodeWithCleanup action)+    p :: [String] -> EvalItem -> Bool+    p groups item = include path && not (skip path)+      where+        path = (groups, evalItemDescription item) -applyDryRun :: Config -> [SpecTree ()] -> [SpecTree ()]+applyDryRun :: Config -> [EvalTree] -> [EvalTree] applyDryRun c-  | configDryRun c = map (removeCleanup . fmap markSuccess)+  | configDryRun c = bimapForest removeCleanup markSuccess   | otherwise = id   where-    markSuccess :: Item () -> Item ()-    markSuccess item = item {itemExample = safeEvaluateExample (Result "" Success)}+    removeCleanup :: IO () -> IO ()+    removeCleanup _ = return () -    removeCleanup :: SpecTree () -> SpecTree ()-    removeCleanup spec = case spec of-      Node x xs -> Node x (map removeCleanup xs)-      NodeWithCleanup _ xs -> NodeWithCleanup (\() -> return ()) (map removeCleanup xs)-      leaf@(Leaf _) -> leaf+    markSuccess :: EvalItem -> EvalItem+    markSuccess item = item {evalItemAction = \ _ -> return $ Result "" Success} --- | Run given spec and write a report to `stdout`.+-- | Run a given spec and write a report to `stdout`. -- Exit with `exitFailure` if at least one spec item fails.+--+-- /Note/: `hspec` handles command-line options and reads config files.  This+-- is not always desired.  Use `runSpec` if you need more control over these+-- aspects. hspec :: Spec -> IO ()-hspec = hspecWith defaultConfig+hspec spec =+      getArgs+  >>= readConfig defaultConfig+  >>= doNotLeakCommandLineArgumentsToExamples . runSpec spec+  >>= evaluateSummary  -- Add a seed to given config if there is none.  That way the same seed is used -- for all properties.  This helps with --seed and --rerun.@@ -99,20 +108,25 @@ -- | Run given spec with custom options. -- This is similar to `hspec`, but more flexible. hspecWith :: Config -> Spec -> IO ()-hspecWith conf spec = do-  r <- hspecWithResult conf spec-  unless (isSuccess r) exitFailure+hspecWith config spec = getArgs >>= readConfig config >>= doNotLeakCommandLineArgumentsToExamples . runSpec spec >>= evaluateSummary +-- | `True` if the given `Summary` indicates that there were no+-- failures, `False` otherwise. isSuccess :: Summary -> Bool isSuccess summary = summaryFailures summary == 0 +-- | Exit with `exitFailure` if the given `Summary` indicates that there was at+-- least one failure.+evaluateSummary :: Summary -> IO ()+evaluateSummary summary = unless (isSuccess summary) exitFailure+ -- | Run given spec and returns a summary of the test run. -- -- /Note/: `hspecResult` does not exit with `exitFailure` on failing spec -- items.  If you need this, you have to check the `Summary` yourself and act -- accordingly. hspecResult :: Spec -> IO Summary-hspecResult = hspecWithResult defaultConfig+hspecResult spec = getArgs >>= readConfig defaultConfig >>= doNotLeakCommandLineArgumentsToExamples . runSpec spec  -- | Run given spec with custom options and returns a summary of the test run. --@@ -120,11 +134,25 @@ -- items.  If you need this, you have to check the `Summary` yourself and act -- accordingly. hspecWithResult :: Config -> Spec -> IO Summary-hspecWithResult config spec = do-  prog <- getProgName-  args <- getArgs-  (oldFailureReport, c_) <- getConfig config prog args-  c <- ensureSeed c_+hspecWithResult config spec = getArgs >>= readConfig config >>= doNotLeakCommandLineArgumentsToExamples . runSpec spec++-- |+-- `runSpec` is the most basic primitive to run a spec. `hspec` is defined in+-- terms of @runSpec@:+--+-- @+-- hspec spec =+--       `getArgs`+--   >>= `readConfig` `defaultConfig`+--   >>= `withArgs` [] . runSpec spec+--   >>= `evaluateSummary`+-- @+runSpec :: Spec -> Config -> IO Summary+runSpec spec c_ = do+  oldFailureReport <- readFailureReportOnRerun c_++  c <- ensureSeed (applyFailureReport oldFailureReport 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@@ -137,16 +165,40 @@     then rerunAllMode c oldFailureReport     else normalMode c   where-    normalMode c = runSpec c spec+    normalMode c = runSpec_ c spec     rerunAllMode c oldFailureReport = do-      summary <- runSpec c spec+      summary <- runSpec_ c spec       if rerunAll c oldFailureReport summary-        then hspecWithResult config spec+        then runSpec spec c_         else return summary -runSpec :: Config -> Spec -> IO Summary-runSpec config spec = do-  doNotLeakCommandLineArgumentsToExamples $ withHandle config $ \h -> do+failFocused :: Item a -> Item a+failFocused item = item {itemExample = example}+  where+    failure = Failure Nothing (Reason "item is focused; failing due to --fail-on-focused")+    example+      | itemIsFocused item = \ params hook p -> do+          Result info status <- itemExample item params hook p+          return $ Result info $ case status of+            Success -> failure+            Pending _ _ -> failure+            Failure{} -> status+      | otherwise = itemExample item++failFocusedItems :: Config -> Spec -> Spec+failFocusedItems config spec+  | configFailOnFocused config = mapSpecItem_ failFocused spec+  | otherwise = spec++focusSpec :: Config -> Spec -> Spec+focusSpec config spec+  | configFocusedOnly config = spec+  | otherwise = focus spec++runSpec_ :: Config -> Spec -> IO Summary+runSpec_ config spec = do+  filteredSpec <- specToEvalForest config spec+  withHandle config $ \h -> do     let formatter = fromMaybe specdoc (configFormatter config)         seed = (fromJust . configQuickCheckSeed) config         qcArgs = configQuickCheckArgs config@@ -157,11 +209,7 @@      useColor <- doesUseColor h config -    let params = Params (configQuickCheckArgs config) (configSmallCheckDepth config)--    filteredSpec <- filterSpecs config . mapMaybe (toEvalTree params) . applyDryRun config <$> runSpecM (focus spec)--    (total, failures) <- withHiddenCursor useColor h $ do+    results <- withHiddenCursor useColor h $ do       let         formatConfig = FormatConfig {           formatConfigHandle = h@@ -178,19 +226,35 @@         }       runFormatter evalConfig filteredSpec -    dumpFailureReport config seed qcArgs failures-    return (Summary total (length failures))+    let failures = filter resultItemIsFailure results -toEvalTree :: Params -> SpecTree () -> Maybe EvalTree-toEvalTree params = go+    dumpFailureReport config seed qcArgs (map fst failures)++    return Summary {+      summaryExamples = length results+    , summaryFailures = length failures+    }++specToEvalForest :: Config -> Spec -> IO [EvalTree]+specToEvalForest config spec = do+  let+    seed = (fromJust . configQuickCheckSeed) config+    focusedSpec = focusSpec config (failFocusedItems config spec)+    params = Params (configQuickCheckArgs config) (configSmallCheckDepth config)+    randomize+      | configRandomize config = randomizeForest seed+      | otherwise = id+  randomize . pruneForest . applyFilterPredicates config . applyDryRun config . toEvalForest params <$> runSpecM focusedSpec++toEvalForest :: Params -> [SpecTree ()] -> [EvalTree]+toEvalForest params = bimapForest withUnit toEvalItem . filterForest itemIsFocused   where-    go :: Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem)-    go t = case t of-      Node s xs -> Just $ Node s (mapMaybe go xs)-      NodeWithCleanup c xs -> Just $ NodeWithCleanup (c ()) (mapMaybe go xs)-      Leaf (Item requirement loc isParallelizable isFocused e) ->-        guard isFocused >> return (Leaf (EvalItem requirement loc (fromMaybe False isParallelizable) (e params $ ($ ()))))+    toEvalItem :: Item () -> EvalItem+    toEvalItem (Item requirement loc isParallelizable _isFocused e) = EvalItem requirement loc (fromMaybe False isParallelizable) (e params withUnit) +    withUnit :: ActionWith () -> IO ()+    withUnit action = action ()+ dumpFailureReport :: Config -> Integer -> QC.Args -> [Path] -> IO () dumpFailureReport config seed qcArgs xs = do   writeFailureReport config FailureReport {@@ -245,3 +309,8 @@ instance Semigroup Summary where   (Summary x1 x2) <> (Summary y1 y2) = Summary (x1 + y1) (x2 + y2) #endif++randomizeForest :: Integer -> [Tree c a] -> [Tree c a]+randomizeForest seed t = runST $ do+  ref <- newSTRef (mkStdGen $ fromIntegral seed)+  shuffleForest ref t

@@ -14,6 +14,7 @@ , EvalTree , EvalItem(..) , runFormatter+, resultItemIsFailure #ifdef TEST , runSequentially #endif@@ -40,6 +41,7 @@ import qualified Test.Hspec.Core.Format as Format import           Test.Hspec.Core.Clock import           Test.Hspec.Core.Example.Location+import           Test.Hspec.Core.Example (safeEvaluate)  -- for compatibility with GHC < 7.10.1 type Monad m = (Functor m, Applicative m, M.Monad m)@@ -53,31 +55,20 @@  data State m = State {   stateConfig :: EvalConfig m-, stateSuccessCount :: Int-, statePendingCount :: Int-, stateFailures :: [Path]+, stateResults :: [(Path, Format.Item)] }  type EvalM m = StateT (State m) m -increaseSuccessCount :: Monad m => EvalM m ()-increaseSuccessCount = modify $ \state -> state {stateSuccessCount = stateSuccessCount state + 1}--increasePendingCount :: Monad m => EvalM m ()-increasePendingCount = modify $ \state -> state {statePendingCount = statePendingCount state + 1}--addFailure :: Monad m => Path -> EvalM m ()-addFailure path = modify $ \state -> state {stateFailures = path : stateFailures state}+addResult :: Monad m => Path -> Format.Item -> EvalM m ()+addResult path item = modify $ \ state -> state {stateResults = (path, item) : stateResults state}  getFormat :: Monad m => (Format m -> a) -> EvalM m a getFormat format = gets (format . evalConfigFormat . stateConfig)  reportItem :: Monad m => Path -> Format.Item -> EvalM m () reportItem path item = do-  case Format.itemResult item of-    Format.Success {} -> increaseSuccessCount-    Format.Pending {} -> increasePendingCount-    Format.Failure {} -> addFailure path+  addResult path item   format <- getFormat formatItem   lift (format path item) @@ -113,10 +104,10 @@ type EvalTree = Tree (IO ()) EvalItem  runEvalM :: Monad m => EvalConfig m -> EvalM m () -> m (State m)-runEvalM config action = execStateT action (State config 0 0 [])+runEvalM config action = execStateT action (State config [])  -- | Evaluate all examples of a given spec and produce a report.-runFormatter :: forall m. MonadIO m => EvalConfig m -> [EvalTree] -> IO (Int, [Path])+runFormatter :: forall m. MonadIO m => EvalConfig m -> [EvalTree] -> IO ([(Path, Format.Item)]) runFormatter config specs = do   let     start = parallelizeTree (evalConfigConcurrentJobs config) specs@@ -126,10 +117,7 @@       state <- formatRun format $ do         runEvalM config $           run $ map (fmap (fmap (. reportProgress timer) . snd)) runningSpecs-      let-        failures = stateFailures state-        total = stateSuccessCount state + statePendingCount state + length failures-      return (total, reverse failures)+      return (reverse $ stateResults state)   where     format = evalConfigFormat config @@ -223,8 +211,10 @@      runCleanup :: [String] -> IO () -> EvalM m ()     runCleanup groups action = do-      (dt, r) <- liftIO $ measure $ safeTry action-      either (\ e -> reportItem path . failureItem (extractLocation e) dt "" . Error Nothing $ e) return r+      r <- liftIO $ measure $ safeEvaluate (action >> return (Result "" Success))+      case r of+        (_, Result "" Success) -> return ()+        _ -> reportResult path Nothing r       where         path = (groups, "afterAll-hook") @@ -260,9 +250,18 @@ sequenceActions :: Monad m => Bool -> [EvalM m ()] -> EvalM m () sequenceActions fastFail = go   where+    go :: Monad m => [EvalM m ()] -> EvalM m ()     go [] = return ()     go (action : actions) = do-      () <- action-      hasFailures <- (not . null) <$> gets stateFailures+      action+      hasFailures <- any resultItemIsFailure <$> gets stateResults       let stopNow = fastFail && hasFailures       unless stopNow (go actions)++resultItemIsFailure :: (Path, Format.Item) -> Bool+resultItemIsFailure = isFailure . Format.itemResult . snd+  where+    isFailure r = case r of+      Format.Success{} -> False+      Format.Pending{} -> False+      Format.Failure{} -> True

@@ -0,0 +1,45 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Core.Shuffle (+  shuffleForest+#ifdef TEST+, shuffle+, mkArray+#endif+) where++import           Prelude ()+import           Test.Hspec.Core.Compat+import           Test.Hspec.Core.Tree++import           System.Random+import           Control.Monad.ST+import           Data.STRef+import           Data.Array.ST++shuffleForest :: STRef s StdGen -> [Tree c a] -> ST s [Tree c a]+shuffleForest ref xs = (shuffle ref xs >>= mapM (shuffleTree ref))++shuffleTree :: STRef s StdGen -> Tree c a -> ST s (Tree c a)+shuffleTree ref t = case t of+  Node d xs -> Node d <$> shuffleForest ref xs+  NodeWithCleanup c xs -> NodeWithCleanup c <$> shuffleForest ref xs+  Leaf {} -> return t++shuffle :: STRef s StdGen -> [a] -> ST s [a]+shuffle ref xs = do+  arr <- mkArray xs+  bounds@(_, n) <- getBounds arr+  forM (range bounds) $ \ i -> do+    j <- randomIndex (i, n)+    vi <- readArray arr i+    vj <- readArray arr j+    writeArray arr j vi+    return vj+  where+    randomIndex bounds = do+      (a, gen) <- randomR bounds <$> readSTRef ref+      writeSTRef ref gen+      return a++mkArray :: [a] -> ST s (STArray s Int a)+mkArray xs = newListArray (1, length xs) xs

@@ -108,7 +108,7 @@   let     ys       | any (any itemIsFocused) xs = xs-      | otherwise = map (bimapTree id (\ item -> item {itemIsFocused = True})) xs+      | otherwise = bimapForest id (\ item -> item {itemIsFocused = True}) xs   fromSpecList ys  -- | @fit@ is an alias for @fmap focus . it@

@@ -1,4 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- NOTE: re-exported from Test.Hspec.Core.Spec module Test.Hspec.Core.Spec.Monad (   Spec , SpecWith@@ -49,11 +51,11 @@ runIO :: IO r -> SpecM a r runIO = SpecM . liftIO -mapSpecTree :: (SpecTree a -> SpecTree b) -> SpecM a r -> SpecM b r-mapSpecTree f (SpecM specs) = SpecM (mapWriterT (fmap (second (map f))) specs)+mapSpecForest :: ([SpecTree a] -> [SpecTree b]) -> SpecM a r -> SpecM b r+mapSpecForest f (SpecM specs) = SpecM (mapWriterT (fmap (second f)) specs)  mapSpecItem :: (ActionWith a -> ActionWith b) -> (Item a -> Item b) -> SpecWith a -> SpecWith b-mapSpecItem g f = mapSpecTree (bimapTree g f)+mapSpecItem g f = mapSpecForest (bimapForest g f)  mapSpecItem_ :: (Item a -> Item a) -> SpecWith a -> SpecWith a mapSpecItem_ = mapSpecItem id

@@ -4,8 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} --- |--- Stability: unstable+-- NOTE: re-exported from Test.Hspec.Core.Spec module Test.Hspec.Core.Tree (   SpecTree , Tree (..)@@ -13,6 +12,13 @@ , specGroup , specItem , bimapTree+, bimapForest+, filterTree+, filterForest+, filterTreeWithLabels+, filterForestWithLabels+, pruneTree+, pruneForest , location ) where @@ -35,6 +41,9 @@ -- over the type of cleanup actions and the type of the actual spec items. type SpecTree a = Tree (ActionWith a) (Item a) +bimapForest :: (a -> b) -> (c -> d) -> [Tree a c] -> [Tree b d]+bimapForest g f = map (bimapTree g f)+ bimapTree :: (a -> b) -> (c -> d) -> Tree a c -> Tree b d bimapTree g f = go   where@@ -42,6 +51,38 @@       Node d xs -> Node d (map go xs)       NodeWithCleanup cleanup xs -> NodeWithCleanup (g cleanup) (map go xs)       Leaf item -> Leaf (f item)++filterTree :: (a -> Bool) -> Tree c a -> Maybe (Tree c a)+filterTree = filterTreeWithLabels . const++filterForest :: (a -> Bool) -> [Tree c a] -> [Tree c a]+filterForest = filterForestWithLabels . const++filterTreeWithLabels :: ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)+filterTreeWithLabels = filterTree_ []++filterForestWithLabels :: ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]+filterForestWithLabels = filterForest_ []++filterForest_ :: [String] -> ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]+filterForest_ groups = mapMaybe . filterTree_ groups++filterTree_ :: [String] -> ([String] -> a -> Bool) -> Tree c a -> Maybe (Tree c a)+filterTree_ groups p tree = case tree of+  Node group xs -> Just $ Node group $ filterForest_ (groups ++ [group]) p xs+  NodeWithCleanup action xs -> Just $ NodeWithCleanup action $ filterForest_ groups p xs+  Leaf item -> Leaf <$> guarded (p groups) item++pruneForest :: [Tree c a] -> [Tree c a]+pruneForest = mapMaybe pruneTree++pruneTree :: Tree c a -> Maybe (Tree c a)+pruneTree node = case node of+  Node group xs -> Node group <$> prune xs+  NodeWithCleanup action xs -> NodeWithCleanup action <$> prune xs+  Leaf{} -> Just node+  where+    prune = guarded (not . null) . pruneForest  -- | -- @Item@ is used to represent spec items internally.  A spec item consists of:

@@ -63,7 +63,7 @@           else s : go (y, ys)  -- |--- A `Path` represents the location of an example within the spec tree.+-- A `Path` describes the location of a spec item within a spec tree. -- -- It consists of a list of group descriptions and a requirement description. type Path = ([String], String)

@@ -146,7 +146,7 @@ #if __GLASGOW_HASKELL__ < 710 import Data.Typeable #endif-#if MIN_VERSION_base(4,9,0)+#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,13,0) import Data.Semigroup (Semigroup((<>))) #endif 

@@ -1,29 +1,27 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.0.+-- This file has been generated from package.yaml by hpack version 0.34.3. -- -- see: https://github.com/sol/hpack------ hash: 09929585045f559b6f4dc8e49667a90bf2260d46c6a0ef0d02b2bdd4d40fb9de -name:             hspec-meta-version:          2.6.0-license:          MIT-license-file:     LICENSE-copyright:        (c) 2011-2018 Simon Hengel,-                  (c) 2011-2012 Trystan Spangler,-                  (c) 2011 Greg Weber-maintainer:       Simon Hengel <sol@typeful.net>-build-type:       Simple-category:         Testing-stability:        experimental-bug-reports:      https://github.com/hspec/hspec/issues-homepage:         http://hspec.github.io/-synopsis:         A version of Hspec which is used to test Hspec itself-description:      A stable version of Hspec which is used to test the-                  in-development version of Hspec.+name:           hspec-meta+version:        2.7.8+synopsis:       A version of Hspec which is used to test Hspec itself+description:    A stable version of Hspec which is used to test the+                in-development version of Hspec.+category:       Testing+stability:      experimental+homepage:       http://hspec.github.io/+bug-reports:    https://github.com/hspec/hspec/issues+maintainer:     Simon Hengel <sol@typeful.net>+copyright:      (c) 2011-2021 Simon Hengel,+                (c) 2011-2012 Trystan Spangler,+                (c) 2011 Greg Weber+license:        MIT+license-file:   LICENSE+build-type:     Simple extra-source-files:-    CHANGES.markdown+    version.yaml  source-repository head   type: git@@ -57,6 +55,7 @@       Test.Hspec.Core.QuickCheckUtil       Test.Hspec.Core.Runner       Test.Hspec.Core.Runner.Eval+      Test.Hspec.Core.Shuffle       Test.Hspec.Core.Spec       Test.Hspec.Core.Spec.Monad       Test.Hspec.Core.Timer@@ -64,15 +63,24 @@       Test.Hspec.Core.Util       Control.Concurrent.Async       Data.Algorithm.Diff+      Test.HUnit+      Test.HUnit.Base+      Test.HUnit.Lang+      Test.HUnit.Terminal+      Test.HUnit.Text+      Test.Hspec.Expectations+      Test.Hspec.Expectations.Contrib+      Test.Hspec.Expectations.Matcher       Paths_hspec_meta-  ghc-options: -Wall   hs-source-dirs:       src       hspec-core/src       hspec-core/vendor+      vendor/HUnit-1.6.2.0/src/+      vendor/hspec-expectations-0.8.2/src/+  ghc-options: -Wall   build-depends:-      HUnit-    , QuickCheck >=2.10+      QuickCheck >=2.12     , ansi-terminal     , array     , base ==4.*@@ -81,7 +89,6 @@     , deepseq     , directory     , filepath-    , hspec-expectations ==0.8.2.*     , quickcheck-io     , random     , setenv@@ -92,13 +99,17 @@  executable hspec-meta-discover   main-is: hspec-discover.hs+  other-modules:+      Test.Hspec.Discover.Config+      Test.Hspec.Discover.Run+      Test.Hspec.Discover.Sort+      Paths_hspec_meta   hs-source-dirs:       hspec-discover/src       hspec-discover/driver   ghc-options: -Wall   build-depends:-      HUnit-    , QuickCheck >=2.10+      QuickCheck >=2.12     , ansi-terminal     , array     , base ==4.*@@ -107,16 +118,10 @@     , deepseq     , directory     , filepath-    , hspec-expectations ==0.8.2.*     , quickcheck-io     , random     , setenv     , stm >=2.2     , time     , transformers >=0.2.2.0-  other-modules:-      Test.Hspec.Discover.Config-      Test.Hspec.Discover.Run-      Test.Hspec.Discover.Sort-      Paths_hspec_meta   default-language: Haskell2010

@@ -56,6 +56,7 @@ , beforeWith , beforeAll , beforeAll_+, beforeAllWith , after , after_ , afterAll

@@ -0,0 +1,80 @@+-- | HUnit is a unit testing framework for Haskell, inspired by the JUnit tool+-- for Java. This guide describes how to use HUnit, assuming you are familiar+-- with Haskell, though not necessarily with JUnit.+--+-- In the Haskell module where your tests will reside, import module+-- @Test.HUnit@:+--+-- @+--    import Test.HUnit+-- @+--+--  Define test cases as appropriate:+--+-- @+--    test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3))+--    test2 = TestCase (do (x,y) <- partA 3+--                         assertEqual "for the first result of partA," 5 x+--                         b <- partB y+--                         assertBool ("(partB " ++ show y ++ ") failed") b)+-- @+--+-- Name the test cases and group them together:+--+-- @+--    tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2]+-- @+--+-- Run the tests as a group. At a Haskell interpreter prompt, apply the function+-- @runTestTT@ to the collected tests. (The /TT/ suggests /T/ext orientation+-- with output to the /T/erminal.)+--+-- @+--    \> runTestTT tests+--    Cases: 2  Tried: 2  Errors: 0  Failures: 0+--    \>+-- @+--+-- If the tests are proving their worth, you might see:+--+-- @+--    \> runTestTT tests+--    ### Failure in: 0:test1+--    for (foo 3),+--    expected: (1,2)+--     but got: (1,3)+--    Cases: 2  Tried: 2  Errors: 0  Failures: 1+--    \>+-- @+--+-- You can specify tests even more succinctly using operators and overloaded+-- functions that HUnit provides:+--+-- @+--    tests = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3),+--                   "test2" ~: do (x, y) <- partA 3+--                                 assertEqual "for the first result of partA," 5 x+--                                 partB y \@? "(partB " ++ show y ++ ") failed" ]+-- @+--+-- Assuming the same test failures as before, you would see:+--+-- @+--    \> runTestTT tests+--    ### Failure in: 0:test1:(foo 3)+--    expected: (1,2)+--     but got: (1,3)+--    Cases: 2  Tried: 2  Errors: 0  Failures: 1+--    \>+-- @++module Test.HUnit+(+  module Test.HUnit.Base,+  module Test.HUnit.Text+)+where++import Test.HUnit.Base+import Test.HUnit.Text+

@@ -0,0 +1,361 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}++#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE ConstraintKinds #-}+#define HasCallStack_ HasCallStack =>+#else+#define HasCallStack_+#endif++-- | Basic definitions for the HUnit library.+--+--   This module contains what you need to create assertions and test cases and+--   combine them into test suites.+--+--   This module also provides infrastructure for+--   implementing test controllers (which are used to execute tests).+--   See "Test.HUnit.Text" for a great example of how to implement a test+--   controller.++module Test.HUnit.Base+(+  -- ** Declaring tests+  Test(..),+  (~=?), (~?=), (~:), (~?),++  -- ** Making assertions+  assertFailure, {- from Test.HUnit.Lang: -}+  assertBool, assertEqual, assertString,+  Assertion, {- from Test.HUnit.Lang: -}+  (@=?), (@?=), (@?),++  -- ** Extending the assertion functionality+  Assertable(..), ListAssertable(..),+  AssertionPredicate, AssertionPredicable(..),+  Testable(..),++  -- ** Test execution+  -- $testExecutionNote+  State(..), Counts(..),+  Path, Node(..),+  testCasePaths,+  testCaseCount,+  ReportStart, ReportProblem,+  performTest+) where++import Control.Monad (unless, foldM)+import Data.CallStack+++-- Assertion Definition+-- ====================++import Test.HUnit.Lang+++-- Conditional Assertion Functions+-- -------------------------------++-- | Asserts that the specified condition holds.+assertBool :: HasCallStack_+              String    -- ^ The message that is displayed if the assertion fails+           -> Bool      -- ^ The condition+           -> Assertion+assertBool msg b = unless b (assertFailure msg)++-- | Signals an assertion failure if a non-empty message (i.e., a message+-- other than @\"\"@) is passed.+assertString :: HasCallStack_+                String    -- ^ The message that is displayed with the assertion failure+             -> Assertion+assertString s = unless (null s) (assertFailure s)++-- Overloaded `assert` Function+-- ----------------------------++-- | Allows the extension of the assertion mechanism.+--+-- Since an 'Assertion' can be a sequence of @Assertion@s and @IO@ actions,+-- there is a fair amount of flexibility of what can be achieved.  As a rule,+-- the resulting @Assertion@ should be the body of a 'TestCase' or part of+-- a @TestCase@; it should not be used to assert multiple, independent+-- conditions.+--+-- If more complex arrangements of assertions are needed, 'Test's and+-- 'Testable' should be used.+class Assertable t+ where assert :: HasCallStack_ t -> Assertion++instance Assertable ()+ where assert = return++instance Assertable Bool+ where assert = assertBool ""++instance (ListAssertable t) => Assertable [t]+ where assert = listAssert++instance (Assertable t) => Assertable (IO t)+ where assert = (>>= assert)++-- | A specialized form of 'Assertable' to handle lists.+class ListAssertable t+ where listAssert :: HasCallStack_ [t] -> Assertion++instance ListAssertable Char+ where listAssert = assertString+++-- Overloaded `assertionPredicate` Function+-- ----------------------------------------++-- | The result of an assertion that hasn't been evaluated yet.+--+-- Most test cases follow the following steps:+--+-- 1. Do some processing or an action.+--+-- 2. Assert certain conditions.+--+-- However, this flow is not always suitable.  @AssertionPredicate@ allows for+-- additional steps to be inserted without the initial action to be affected+-- by side effects.  Additionally, clean-up can be done before the test case+-- has a chance to end.  A potential work flow is:+--+-- 1. Write data to a file.+--+-- 2. Read data from a file, evaluate conditions.+--+-- 3. Clean up the file.+--+-- 4. Assert that the side effects of the read operation meet certain conditions.+--+-- 5. Assert that the conditions evaluated in step 2 are met.+type AssertionPredicate = IO Bool++-- | Used to signify that a data type can be converted to an assertion+-- predicate.+class AssertionPredicable t+ where assertionPredicate :: t -> AssertionPredicate++instance AssertionPredicable Bool+ where assertionPredicate = return++instance (AssertionPredicable t) => AssertionPredicable (IO t)+ where assertionPredicate = (>>= assertionPredicate)+++-- Assertion Construction Operators+-- --------------------------------++infix  1 @?, @=?, @?=++-- | Asserts that the condition obtained from the specified+--   'AssertionPredicable' holds.+(@?) :: HasCallStack_ AssertionPredicable t+                                => t          -- ^ A value of which the asserted condition is predicated+                                -> String     -- ^ A message that is displayed if the assertion fails+                                -> Assertion+predi @? msg = assertionPredicate predi >>= assertBool msg++-- | Asserts that the specified actual value is equal to the expected value+--   (with the expected value on the left-hand side).+(@=?) :: HasCallStack_ (Eq a, Show a)+                        => a -- ^ The expected value+                        -> a -- ^ The actual value+                        -> Assertion+expected @=? actual = assertEqual "" expected actual++-- | Asserts that the specified actual value is equal to the expected value+--   (with the actual value on the left-hand side).+(@?=) :: HasCallStack_ (Eq a, Show a)+                        => a -- ^ The actual value+                        -> a -- ^ The expected value+                        -> Assertion+actual @?= expected = assertEqual "" expected actual++++-- Test Definition+-- ===============++-- | The basic structure used to create an annotated tree of test cases.+data Test+    -- | A single, independent test case composed.+    = TestCase Assertion+    -- | A set of @Test@s sharing the same level in the hierarchy.+    | TestList [Test]+    -- | A name or description for a subtree of the @Test@s.+    | TestLabel String Test++instance Show Test where+  showsPrec _ (TestCase _)    = showString "TestCase _"+  showsPrec _ (TestList ts)   = showString "TestList " . showList ts+  showsPrec p (TestLabel l t) = showString "TestLabel " . showString l+                                . showChar ' ' . showsPrec p t++-- Overloaded `test` Function+-- --------------------------++-- | Provides a way to convert data into a @Test@ or set of @Test@.+class Testable t+ where test :: HasCallStack_ t -> Test++instance Testable Test+ where test = id++instance (Assertable t) => Testable (IO t)+ where test = TestCase . assert++instance (Testable t) => Testable [t]+ where test = TestList . map test+++-- Test Construction Operators+-- ---------------------------++infix  1 ~?, ~=?, ~?=+infixr 0 ~:++-- | Creates a test case resulting from asserting the condition obtained+--   from the specified 'AssertionPredicable'.+(~?) :: HasCallStack_ AssertionPredicable t+                                => t       -- ^ A value of which the asserted condition is predicated+                                -> String  -- ^ A message that is displayed on test failure+                                -> Test+predi ~? msg = TestCase (predi @? msg)++-- | Shorthand for a test case that asserts equality (with the expected+--   value on the left-hand side, and the actual value on the right-hand+--   side).+(~=?) :: HasCallStack_ (Eq a, Show a)+                        => a     -- ^ The expected value+                        -> a     -- ^ The actual value+                        -> Test+expected ~=? actual = TestCase (expected @=? actual)++-- | Shorthand for a test case that asserts equality (with the actual+--   value on the left-hand side, and the expected value on the right-hand+--   side).+(~?=) :: HasCallStack_ (Eq a, Show a)+                        => a     -- ^ The actual value+                        -> a     -- ^ The expected value+                        -> Test+actual ~?= expected = TestCase (actual @?= expected)++-- | Creates a test from the specified 'Testable', with the specified+--   label attached to it.+--+-- Since 'Test' is @Testable@, this can be used as a shorthand way of attaching+-- a 'TestLabel' to one or more tests.+(~:) :: HasCallStack_ Testable t => String -> t -> Test+label ~: t = TestLabel label (test t)++++-- Test Execution+-- ==============++-- $testExecutionNote+-- Note: the rest of the functionality in this module is intended for+-- implementors of test controllers. If you just want to run your tests cases,+-- simply use a test controller, such as the text-based controller in+-- "Test.HUnit.Text".++-- | A data structure that hold the results of tests that have been performed+-- up until this point.+data Counts = Counts { cases, tried, errors, failures :: Int }+  deriving (Eq, Show, Read)++-- | Keeps track of the remaining tests and the results of the performed tests.+-- As each test is performed, the path is removed and the counts are+-- updated as appropriate.+data State = State { path :: Path, counts :: Counts }+  deriving (Eq, Show, Read)++-- | Report generator for reporting the start of a test run.+type ReportStart us = State -> us -> IO us++-- | Report generator for reporting problems that have occurred during+--   a test run. Problems may be errors or assertion failures.+type ReportProblem us = Maybe SrcLoc -> String -> State -> us -> IO us++-- | Uniquely describes the location of a test within a test hierarchy.+-- Node order is from test case to root.+type Path = [Node]++-- | Composed into 'Path's.+data Node  = ListItem Int | Label String+  deriving (Eq, Show, Read)++-- | Determines the paths for all 'TestCase's in a tree of @Test@s.+testCasePaths :: Test -> [Path]+testCasePaths t0 = tcp t0 []+ where tcp (TestCase _) p = [p]+       tcp (TestList ts) p =+         concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ]+       tcp (TestLabel l t) p = tcp t (Label l : p)++-- | Counts the number of 'TestCase's in a tree of @Test@s.+testCaseCount :: Test -> Int+testCaseCount (TestCase _)    = 1+testCaseCount (TestList ts)   = sum (map testCaseCount ts)+testCaseCount (TestLabel _ t) = testCaseCount t++-- | Performs a test run with the specified report generators.+--+-- This handles the actual running of the tests.  Most developers will want+-- to use @HUnit.Text.runTestTT@ instead.  A developer could use this function+-- to execute tests via another IO system, such as a GUI, or to output the+-- results in a different manner (e.g., upload XML-formatted results to a+-- webservice).+--+-- Note that the counts in a start report do not include the test case+-- being started, whereas the counts in a problem report do include the+-- test case just finished.  The principle is that the counts are sampled+-- only between test case executions.  As a result, the number of test+-- case successes always equals the difference of test cases tried and+-- the sum of test case errors and failures.+performTest :: ReportStart us   -- ^ report generator for the test run start+            -> ReportProblem us -- ^ report generator for errors during the test run+            -> ReportProblem us -- ^ report generator for assertion failures during the test run+            -> us+            -> Test             -- ^ the test to be executed+            -> IO (Counts, us)+performTest reportStart reportError reportFailure initialUs initialT = do+  (ss', us') <- pt initState initialUs initialT+  unless (null (path ss')) $ error "performTest: Final path is nonnull"+  return (counts ss', us')+ where+  initState  = State{ path = [], counts = initCounts }+  initCounts = Counts{ cases = testCaseCount initialT, tried = 0,+                       errors = 0, failures = 0}++  pt ss us (TestCase a) = do+    us' <- reportStart ss us+    r <- performTestCase a+    case r of+      Success -> do+        return (ss', us')+      Failure loc m -> do+        usF <- reportFailure loc m ssF us'+        return (ssF, usF)+      Error loc m -> do+        usE <- reportError loc m ssE us'+        return (ssE, usE)+   where c@Counts{ tried = n } = counts ss+         ss' = ss{ counts = c{ tried = n + 1 } }+         ssF = ss{ counts = c{ tried = n + 1, failures = failures c + 1 } }+         ssE = ss{ counts = c{ tried = n + 1, errors   = errors   c + 1 } }++  pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..])+   where f (ss', us') (t, n) = withNode (ListItem n) ss' us' t++  pt ss us (TestLabel label t) = withNode (Label label) ss us t++  withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t+                               return (ss2{ path = path0 }, us1)+   where path0 = path ss0+         ss1 = ss0{ path = node : path0 }

@@ -0,0 +1,104 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}++#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE ConstraintKinds #-}+#define HasCallStack_ HasCallStack =>+#else+#define HasCallStack_+#endif++module Test.HUnit.Lang (+  Assertion,+  assertFailure,+  assertEqual,++  Result (..),+  performTestCase,+-- * Internals+-- |+-- /Note:/ This is not part of the public API!  It is exposed so that you can+-- tinker with the internals of HUnit, but do not expect it to be stable!+  HUnitFailure (..),+  FailureReason (..),+  formatFailureReason+) where++import           Control.DeepSeq+import           Control.Exception as E+import           Control.Monad+import           Data.List+import           Data.Typeable+import           Data.CallStack++-- | When an assertion is evaluated, it will output a message if and only if the+-- assertion fails.+--+-- Test cases are composed of a sequence of one or more assertions.+type Assertion = IO ()++data HUnitFailure = HUnitFailure (Maybe SrcLoc) FailureReason+    deriving (Eq, Show, Typeable)++instance Exception HUnitFailure++data FailureReason = Reason String | ExpectedButGot (Maybe String) String String+    deriving (Eq, Show, Typeable)++location :: HasCallStack_ Maybe SrcLoc+location = case reverse callStack of+  (_, loc) : _ -> Just loc+  [] -> Nothing++-- | Unconditionally signals that a failure has occurred.+assertFailure ::+     HasCallStack_+     String -- ^ A message that is displayed with the assertion failure+  -> IO a+assertFailure msg = msg `deepseq` E.throwIO (HUnitFailure location $ Reason msg)++-- | Asserts that the specified actual value is equal to the expected value.+-- The output message will contain the prefix, the expected value, and the+-- actual value.+--+-- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted+-- and only the expected and actual values are output.+assertEqual :: HasCallStack_ (Eq a, Show a)+                              => String -- ^ The message prefix+                              -> a      -- ^ The expected value+                              -> a      -- ^ The actual value+                              -> Assertion+assertEqual preface expected actual =+  unless (actual == expected) $ do+    (prefaceMsg `deepseq` expectedMsg `deepseq` actualMsg `deepseq` E.throwIO (HUnitFailure location $ ExpectedButGot prefaceMsg expectedMsg actualMsg))+  where+    prefaceMsg+      | null preface = Nothing+      | otherwise = Just preface+    expectedMsg = show expected+    actualMsg = show actual++formatFailureReason :: FailureReason -> String+formatFailureReason (Reason reason) = reason+formatFailureReason (ExpectedButGot preface expected actual) = intercalate "\n" . maybe id (:) preface $ ["expected: " ++ expected, " but got: " ++ actual]++data Result = Success | Failure (Maybe SrcLoc) String | Error (Maybe SrcLoc) String+  deriving (Eq, Show)++-- | Performs a single test case.+performTestCase :: Assertion -- ^ an assertion to be made during the test case run+                -> IO Result+performTestCase action =+  (action >> return Success)+     `E.catches`+      [E.Handler (\(HUnitFailure loc reason) -> return $ Failure loc (formatFailureReason reason)),++       -- Re-throw AsyncException, otherwise execution will not terminate on+       -- SIGINT (ctrl-c).  Currently, all AsyncExceptions are being thrown+       -- because it's thought that none of them will be encountered during+       -- normal HUnit operation.  If you encounter an example where this+       -- is not the case, please email the maintainer.+       E.Handler (\e -> throw (e :: E.AsyncException)),++       E.Handler (\e -> return $ Error Nothing $ show (e :: E.SomeException))]

@@ -0,0 +1,42 @@+-- | This module handles the complexities of writing information to the+-- terminal, including modifying text in place.++module Test.HUnit.Terminal (+        terminalAppearance+    ) where++import Data.Char (isPrint)+++-- | Simplifies the input string by interpreting @\\r@ and @\\b@ characters+-- specially so that the result string has the same final (or /terminal/,+-- pun intended) appearance as would the input string when written to a+-- terminal that overwrites character positions following carriage+-- returns and backspaces.++terminalAppearance :: String -> String+terminalAppearance str = ta id "" "" str++-- | The helper function @ta@ takes an accumulating @ShowS@-style function+-- that holds /committed/ lines of text, a (reversed) list of characters+-- on the current line /before/ the cursor, a (normal) list of characters+-- on the current line /after/ the cursor, and the remaining input.++ta+    :: ([Char] -> t) -- ^ An accumulating @ShowS@-style function+                     -- that holds /committed/ lines of text+    -> [Char] -- ^ A (reversed) list of characters+              -- on the current line /before/ the cursor+    -> [Char] -- ^ A (normal) list of characters+              -- on the current line /after/ the cursor+    -> [Char] -- ^ The remaining input+    -> t+ta f    bs  as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs+ta f    bs  as ('\r':cs) = ta f "" (reverse bs ++ as) cs+ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs+ta _    ""   _ ('\b': _) = error "'\\b' at beginning of line"+ta f    bs  as (c:cs)+    | not (isPrint c)    = error "invalid nonprinting character"+    | null as            = ta f (c:bs) ""        cs+    | otherwise          = ta f (c:bs) (tail as) cs+ta f    bs  as       ""  = f (reverse bs ++ as)

@@ -0,0 +1,152 @@+-- | Text-based test controller for running HUnit tests and reporting+--   results as text, usually to a terminal.++module Test.HUnit.Text+(+  PutText(..),+  putTextToHandle, putTextToShowS,+  runTestText,+  showPath, showCounts,+  runTestTT,+  runTestTTAndExit+)+where++import Test.HUnit.Base++import Data.CallStack+import Control.Monad (when)+import System.IO (Handle, stderr, hPutStr, hPutStrLn)+import System.Exit (exitSuccess, exitFailure)+++-- | As the general text-based test controller ('runTestText') executes a+--   test, it reports each test case start, error, and failure by+--   constructing a string and passing it to the function embodied in a+--   'PutText'.  A report string is known as a \"line\", although it includes+--   no line terminator; the function in a 'PutText' is responsible for+--   terminating lines appropriately.  Besides the line, the function+--   receives a flag indicating the intended \"persistence\" of the line:+--   'True' indicates that the line should be part of the final overall+--   report; 'False' indicates that the line merely indicates progress of+--   the test execution.  Each progress line shows the current values of+--   the cumulative test execution counts; a final, persistent line shows+--   the final count values.+--+--   The 'PutText' function is also passed, and returns, an arbitrary state+--   value (called 'st' here).  The initial state value is given in the+--   'PutText'; the final value is returned by 'runTestText'.++data PutText st = PutText (String -> Bool -> st -> IO st) st+++-- | Two reporting schemes are defined here.  @putTextToHandle@ writes+-- report lines to a given handle.  'putTextToShowS' accumulates+-- persistent lines for return as a whole by 'runTestText'.+--+-- @putTextToHandle@ writes persistent lines to the given handle,+-- following each by a newline character.  In addition, if the given flag+-- is @True@, it writes progress lines to the handle as well.  A progress+-- line is written with no line termination, so that it can be+-- overwritten by the next report line.  As overwriting involves writing+-- carriage return and blank characters, its proper effect is usually+-- only obtained on terminal devices.++putTextToHandle+    :: Handle+    -> Bool -- ^ Write progress lines to handle?+    -> PutText Int+putTextToHandle handle showProgress = PutText put initCnt+ where+  initCnt = if showProgress then 0 else -1+  put line pers (-1) = do when pers (hPutStrLn handle line); return (-1)+  put line True  cnt = do hPutStrLn handle (erase cnt ++ line); return 0+  put line False _   = do hPutStr handle ('\r' : line); return (length line)+    -- The "erasing" strategy with a single '\r' relies on the fact that the+    -- lengths of successive summary lines are monotonically nondecreasing.+  erase cnt = if cnt == 0 then "" else "\r" ++ replicate cnt ' ' ++ "\r"+++-- | Accumulates persistent lines (dropping progess lines) for return by+--   'runTestText'.  The accumulated lines are represented by a+--   @'ShowS' ('String' -> 'String')@ function whose first argument is the+--   string to be appended to the accumulated report lines.++putTextToShowS :: PutText ShowS+putTextToShowS = PutText put id+ where put line pers f = return (if pers then acc f line else f)+       acc f line rest = f (line ++ '\n' : rest)+++-- | Executes a test, processing each report line according to the given+--   reporting scheme.  The reporting scheme's state is threaded through calls+--   to the reporting scheme's function and finally returned, along with final+--   count values.++runTestText :: PutText st -> Test -> IO (Counts, st)+runTestText (PutText put us0) t = do+  (counts', us1) <- performTest reportStart reportError reportFailure us0 t+  us2 <- put (showCounts counts') True us1+  return (counts', us2)+ where+  reportStart ss us = put (showCounts (counts ss)) False us+  reportError   = reportProblem "Error:"   "Error in:   "+  reportFailure = reportProblem "Failure:" "Failure in: "+  reportProblem p0 p1 loc msg ss us = put line True us+   where line  = "### " ++ kind ++ path' ++ "\n" ++ formatLocation loc ++ msg+         kind  = if null path' then p0 else p1+         path' = showPath (path ss)++formatLocation :: Maybe SrcLoc -> String+formatLocation Nothing = ""+formatLocation (Just loc) = srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ "\n"++-- | Converts test execution counts to a string.++showCounts :: Counts -> String+showCounts Counts{ cases = cases', tried = tried',+                   errors = errors', failures = failures' } =+  "Cases: " ++ show cases' ++ "  Tried: " ++ show tried' +++  "  Errors: " ++ show errors' ++ "  Failures: " ++ show failures'+++-- | Converts a test case path to a string, separating adjacent elements by+--   the colon (\':\'). An element of the path is quoted (as with 'show') when+--   there is potential ambiguity.++showPath :: Path -> String+showPath [] = ""+showPath nodes = foldl1 f (map showNode nodes)+ where f b a = a ++ ":" ++ b+       showNode (ListItem n) = show n+       showNode (Label label) = safe label (show label)+       safe s ss = if ':' `elem` s || "\"" ++ s ++ "\"" /= ss then ss else s+++-- | Provides the \"standard\" text-based test controller. Reporting is made to+--   standard error, and progress reports are included. For possible+--   programmatic use, the final counts are returned.+--+--   The \"TT\" in the name suggests \"Text-based reporting to the Terminal\".++runTestTT :: Test -> IO Counts+runTestTT t = do (counts', 0) <- runTestText (putTextToHandle stderr True) t+                 return counts'++-- | Convenience wrapper for 'runTestTT'.+--   Simply runs 'runTestTT' and then exits back to the OS,+--   using 'exitSuccess' if there were no errors or failures,+--   or 'exitFailure' if there were. For example:+--+--   > tests :: Test+--   > tests = ...+--   >+--   > main :: IO ()+--   > main = runTestTTAndExit tests++runTestTTAndExit :: Test -> IO ()+runTestTTAndExit tests = do+  c <- runTestTT tests+  if (errors c == 0) && (failures c == 0)+    then exitSuccess+    else exitFailure

@@ -0,0 +1,189 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ImplicitParams #-}+-- |+-- Introductory documentation: <https://github.com/sol/hspec-expectations#readme>+module Test.Hspec.Expectations (++-- * Setting expectations+  Expectation+, expectationFailure+, shouldBe+, shouldSatisfy+, shouldStartWith+, shouldEndWith+, shouldContain+, shouldMatchList+, shouldReturn++, shouldNotBe+, shouldNotSatisfy+, shouldNotContain+, shouldNotReturn++-- * Expecting exceptions+, shouldThrow++-- ** Selecting exceptions+, Selector++-- ** Predefined type-based selectors+-- |+-- There are predefined selectors for some standard exceptions.  Each selector+-- is just @const True@ with an appropriate type.+, anyException+, anyErrorCall+, anyIOException+, anyArithException++-- ** Combinators for defining value-based selectors+-- |+-- Some exceptions (most prominently `ErrorCall`) have no `Eq` instance.+-- Selecting a specific value would require pattern matching.+--+-- For such exceptions, combinators that construct selectors are provided.+-- Each combinator corresponds to a constructor; it takes the same arguments,+-- and has the same name (but starting with a lower-case letter).+, errorCall++-- * Re-exports+, HasCallStack+) where++import qualified Test.HUnit+import           Test.HUnit ((@?=))+import           Control.Exception+import           Data.Typeable+import           Data.List++import           Control.Monad (unless)++import           Test.Hspec.Expectations.Matcher++import           Data.CallStack (HasCallStack)++type Expectation = Test.HUnit.Assertion++expectationFailure :: HasCallStack => String -> Expectation+expectationFailure = Test.HUnit.assertFailure++expectTrue :: HasCallStack => String -> Bool -> Expectation+expectTrue msg b = unless b (expectationFailure msg)++infix 1 `shouldBe`, `shouldSatisfy`, `shouldStartWith`, `shouldEndWith`, `shouldContain`, `shouldMatchList`, `shouldReturn`, `shouldThrow`+infix 1 `shouldNotBe`, `shouldNotSatisfy`, `shouldNotContain`, `shouldNotReturn`++-- |+-- @actual \`shouldBe\` expected@ sets the expectation that @actual@ is equal+-- to @expected@.+shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation+actual `shouldBe` expected = actual @?= expected++-- |+-- @v \`shouldSatisfy\` p@ sets the expectation that @p v@ is @True@.+shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation+v `shouldSatisfy` p = expectTrue ("predicate failed on: " ++ show v) (p v)++compareWith :: (HasCallStack, Show a) => (a -> a -> Bool) -> String -> a -> a -> Expectation+compareWith comparator errorDesc result expected = expectTrue errorMsg (comparator expected result)+  where+    errorMsg = show result ++ " " ++ errorDesc ++ " " ++ show expected++-- |+-- @list \`shouldStartWith\` prefix@ sets the expectation that @list@ starts with @prefix@,+shouldStartWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation+shouldStartWith = compareWith isPrefixOf "does not start with"++-- |+-- @list \`shouldEndWith\` suffix@ sets the expectation that @list@ ends with @suffix@,+shouldEndWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation+shouldEndWith = compareWith isSuffixOf "does not end with"++-- |+-- @list \`shouldContain\` sublist@ sets the expectation that @sublist@ is contained,+-- wholly and intact, anywhere in @list@.+shouldContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation+shouldContain = compareWith isInfixOf "does not contain"++-- |+-- @xs \`shouldMatchList\` ys@ sets the expectation that @xs@ has the same+-- elements that @ys@ has, possibly in another order+shouldMatchList :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation+xs `shouldMatchList` ys = maybe (return ()) expectationFailure (matchList xs ys)++-- |+-- @action \`shouldReturn\` expected@ sets the expectation that @action@+-- returns @expected@.+shouldReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation+action `shouldReturn` expected = action >>= (`shouldBe` expected)++-- |+-- @actual \`shouldNotBe\` notExpected@ sets the expectation that @actual@ is not+-- equal to @notExpected@+shouldNotBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation+actual `shouldNotBe` notExpected = expectTrue ("not expected: " ++ show actual) (actual /= notExpected)++-- |+-- @v \`shouldNotSatisfy\` p@ sets the expectation that @p v@ is @False@.+shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation+v `shouldNotSatisfy` p = expectTrue ("predicate succeeded on: " ++ show v) ((not . p) v)++-- |+-- @list \`shouldNotContain\` sublist@ sets the expectation that @sublist@ is not+-- contained anywhere in @list@.+shouldNotContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation+list `shouldNotContain` sublist = expectTrue errorMsg ((not . isInfixOf sublist) list)+  where+    errorMsg = show list ++ " does contain " ++ show sublist++-- |+-- @action \`shouldNotReturn\` notExpected@ sets the expectation that @action@+-- does not return @notExpected@.+shouldNotReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation+action `shouldNotReturn` notExpected = action >>= (`shouldNotBe` notExpected)++-- |+-- A @Selector@ is a predicate; it can simultaneously constrain the type and+-- value of an exception.+type Selector a = (a -> Bool)++-- |+-- @action \`shouldThrow\` selector@ sets the expectation that @action@ throws+-- an exception.  The precise nature of the expected exception is described+-- with a 'Selector'.+shouldThrow :: (HasCallStack, Exception e) => IO a -> Selector e -> Expectation+action `shouldThrow` p = do+  r <- try action+  case r of+    Right _ ->+      expectationFailure $+        "did not get expected exception: " ++ exceptionType+    Left e ->+      (`expectTrue` p e) $+        "predicate failed on expected exception: " ++ exceptionType ++ " (" ++ show e ++ ")"+  where+    -- a string repsentation of the expected exception's type+    exceptionType = (show . typeOf . instanceOf) p+      where+        instanceOf :: Selector a -> a+        instanceOf _ = error "Test.Hspec.Expectations.shouldThrow: broken Typeable instance"++anyException :: Selector SomeException+anyException = const True++anyErrorCall :: Selector ErrorCall+anyErrorCall = const True++errorCall :: String -> Selector ErrorCall+#if MIN_VERSION_base(4,9,0)+errorCall s (ErrorCallWithLocation msg _) = s == msg+#else+errorCall s (ErrorCall msg) = s == msg+#endif++anyIOException :: Selector IOException+anyIOException = const True++anyArithException :: Selector ArithException+anyArithException = const True

@@ -0,0 +1,26 @@+{-# LANGUAGE CPP #-}+-- |+-- Experimental combinators, that may become part of the main distribution, if+-- they turn out to be useful for a wider audience.+module Test.Hspec.Expectations.Contrib (+-- * Predicates+-- | (useful in combination with `shouldSatisfy`)+  isLeft+, isRight+) where+++#if MIN_VERSION_base(4,7,0)+import Data.Either+#else++isLeft :: Either a b -> Bool+{-# DEPRECATED isLeft "use Data.Either.Compat.isLeft from package base-compat instead" #-}+isLeft (Left  _) = True+isLeft (Right _) = False++isRight :: Either a b -> Bool+{-# DEPRECATED isRight "use Data.Either.Compat.isRight from package base-compat instead" #-}+isRight (Left  _) = False+isRight (Right _) = True+#endif

@@ -0,0 +1,26 @@+module Test.Hspec.Expectations.Matcher (matchList) where++import           Prelude hiding (showList)+import           Data.List++matchList :: (Show a, Eq a) => [a] -> [a] -> Maybe String+xs `matchList` ys+  | null extra && null missing = Nothing+  | otherwise = Just (err "")+  where+    extra   = xs \\ ys+    missing = ys \\ xs++    msgAndList msg zs = showString msg . showList zs . showString "\n"+    optMsgList msg zs = if null zs then id else msgAndList msg zs++    err :: ShowS+    err =+        showString "Actual list is not a permutation of expected list!\n"+      . msgAndList "  expected list contains:   " ys+      . msgAndList "  actual list contains:     " xs+      . optMsgList "  the missing elements are: " missing+      . optMsgList "  the extra elements are:   " extra++showList :: Show a => [a] -> ShowS+showList xs = showChar '[' . foldr (.) (showChar ']') (intersperse (showString ", ") $ map shows xs)

@@ -0,0 +1,1 @@+&version 2.7.8