hspec-meta (empty) → 1.4.3

raw patch · 20 files changed

+1541/−0 lines, 20 filesdep +HUnitdep +QuickCheckdep +ansi-terminalsetup-changed

Dependencies added: HUnit, QuickCheck, ansi-terminal, base, directory, filepath, hspec-expectations, setenv, silently, time, transformers

Files

• LICENSE +10/−0
• Setup.lhs +3/−0
• hspec-discover/src/Main.hs +8/−0
• hspec-discover/src/Run.hs +161/−0
• hspec-meta.cabal +68/−0
• src/Test/Hspec.hs +128/−0
• src/Test/Hspec/Compat.hs +17/−0
• src/Test/Hspec/Config.hs +149/−0
• src/Test/Hspec/Core.hs +72/−0
• src/Test/Hspec/Core/Type.hs +95/−0
• src/Test/Hspec/FailureReport.hs +26/−0
• src/Test/Hspec/Formatters.hs +186/−0
• src/Test/Hspec/Formatters/Internal.hs +239/−0
• src/Test/Hspec/HUnit.hs +39/−0
• src/Test/Hspec/Meta.hs +3/−0
• src/Test/Hspec/Monadic.hs +54/−0
• src/Test/Hspec/Pending.hs +34/−0
• src/Test/Hspec/QuickCheck.hs +27/−0
• src/Test/Hspec/Runner.hs +142/−0
• src/Test/Hspec/Util.hs +80/−0

@@ -0,0 +1,10 @@++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:+++Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

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

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

@@ -0,0 +1,161 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | A preprocessor that finds and combines specs.+module Run where+import           Control.Monad+import           Control.Applicative+import           Data.List+import           Data.String+import           Data.Function+import           System.Environment+import           System.Exit+import           System.IO+import           System.Directory+import           System.FilePath hiding (combine)++instance IsString ShowS where+  fromString = showString++run :: [String] -> IO ()+run args_ = case args_ of+  src : _ : dst : args -> do+    nested <- case args of+      []           -> return False+      ["--nested"] -> return True+      _            -> exit+    specs <- findSpecs src+    writeFile dst (mkSpecModule src nested specs)+  _ -> exit+  where+    exit = do+      name <- getProgName+      hPutStrLn stderr ("usage: " ++ name ++ " SRC CUR DST [--nested]")+      exitFailure++mkSpecModule :: FilePath -> Bool -> [SpecNode] -> String+mkSpecModule src nested nodes =+  ( "{-# LINE 1 " . shows src . " #-}"+  . showString "module Main where\n"+  . showString "import Test.Hspec.Meta\n"+  . importList nodes+  . showString "main :: IO ()\n"+  . showString "main = hspec $ "+  . format nodes+  ) "\n"+  where+    format+      | nested    = formatSpecsNested+      | otherwise = formatSpecs++-- | Generate imports for a list of specs.+importList :: [SpecNode] -> ShowS+importList = go ""+  where+    go :: ShowS -> [SpecNode] -> ShowS+    go current = foldr (.) "" . map (f current)+    f current (SpecNode name inhabited children) = this . go (current . showString name . ".") children+      where+        this+          | inhabited = "import qualified " . current . showString name . "Spec\n"+          | otherwise = id++-- | Combine a list of strings with (>>).+sequenceS :: [ShowS] -> ShowS+sequenceS = foldr (.) "" . intersperse " >> "++-- | Convert a list of specs to code.+formatSpecs :: [SpecNode] -> ShowS+formatSpecs xs+  | null xs   = "return ()"+  | otherwise = sequenceS (map formatSpec xs)++-- | Convert a spec to code.+formatSpec :: SpecNode -> ShowS+formatSpec = sequenceS . go ""+  where+    go :: String -> SpecNode -> [ShowS]+    go current (SpecNode name inhabited children) = addThis $ concatMap (go (current ++ name ++ ".")) children+      where+        addThis :: [ShowS] -> [ShowS]+        addThis+          | inhabited = ("describe " . shows (current ++ name) . " " . showString (current ++ name ++ "Spec.spec") :)+          | otherwise = id++-- | Convert a list of specs to code.+--+-- Hierarchical modules are mapped to nested specs.+formatSpecsNested :: [SpecNode] -> ShowS+formatSpecsNested xs+  | null xs   = "return ()"+  | otherwise = sequenceS (map formatSpecNested xs)++-- | Convert a spec to code.+--+-- Hierarchical modules are mapped to nested specs.+formatSpecNested :: SpecNode -> ShowS+formatSpecNested = go ""+  where+    go current (SpecNode name inhabited children) = "describe " . shows name . " (" . specs . ")"+      where+        specs :: ShowS+        specs = (sequenceS . addThis . map (go (current . showString name . "."))) children+        addThis+          | inhabited = ((current . showString name . "Spec.spec") :)+          | otherwise = id++data SpecNode = SpecNode String Bool [SpecNode]+  deriving (Eq, Show)++specNodeName :: SpecNode -> String+specNodeName (SpecNode name _ _) = name++specNodeInhabited :: SpecNode -> Bool+specNodeInhabited (SpecNode _ inhabited _) = inhabited++specNodeChildren :: SpecNode -> [SpecNode]+specNodeChildren (SpecNode _ _ children) = children++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  dirs <- filterM (doesDirectoryExist . (dir </>)) c+  files <- filterM (doesFileExist . (dir </>)) c+  return (dirs, files)++-- | Find specs relative to given source file.+--+-- The source file itself is not considered.+findSpecs :: FilePath -> IO [SpecNode]+findSpecs src = do+  let (dir, file) = splitFileName src+  (dirs, files) <- getFilesAndDirectories dir+  go dir (dirs, filter (/= file) files)+  where+    go :: FilePath -> ([FilePath], [FilePath]) -> IO [SpecNode]+    go base (dirs, files) = do+      nestedSpecs <- forM dirs $ \d -> do+        let dir = base </> d+        SpecNode d False <$> (getFilesAndDirectories dir >>= go dir)+      (return . filterSpecs . combineSpecs) (specsFromFiles files ++ nestedSpecs)+      where+        specsFromFiles = map (\x -> SpecNode (stripSuffix x) True []) . filter (isSuffixOf suffix)+          where+            suffix = "Spec.hs"+            stripSuffix = reverse . drop (length suffix) . reverse++        -- remove empty leafs+        filterSpecs :: [SpecNode] -> [SpecNode]+        filterSpecs = filter (\x -> specNodeInhabited x || (not . null . specNodeChildren) x)++        -- sort specs, and merge nodes with the same name+        combineSpecs :: [SpecNode] -> [SpecNode]+        combineSpecs = foldr f [] . sortBy (compare `on` specNodeName)+          where+            f x@(SpecNode n1 _ _) (y@(SpecNode n2 _ _):acc) | n1 == n2 = x `combine` y : acc+            f x acc = x : acc++            x `combine` y = SpecNode name inhabited children+              where+                name      = specNodeName x+                inhabited = specNodeInhabited x || specNodeInhabited y+                children  = specNodeChildren x ++ specNodeChildren y

@@ -0,0 +1,68 @@+name:             hspec-meta+version:          1.4.3+license:          BSD3+license-file:     LICENSE+copyright:        (c) 2011-2012 Trystan Spangler, (c) 2011-2012 Simon Hengel, (c) 2011 Greg Weber+maintainer:       Simon Hengel <sol@typeful.net>+build-type:       Simple+cabal-version:    >= 1.8+category:         Testing+stability:        experimental+bug-reports:      https://github.com/hspec/hspec/issues+homepage:         http://hspec.github.com/+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.++source-repository head+  type: git+  location: https://github.com/hspec/hspec++Library+  ghc-options:+      -Wall+  hs-source-dirs:+      src+  build-depends:+      base          == 4.*+    , setenv+    , silently      >= 1.1.1+    , ansi-terminal == 0.5.*+    , time+    , transformers  >= 0.2.2.0 && < 0.4.0+    , HUnit         >= 1.2.5+    , QuickCheck    >= 2.4.0.1+    , hspec-expectations == 0.3.0.*+  exposed-modules:+      Test.Hspec.Meta+  other-modules:+      Test.Hspec+      Test.Hspec.Core+      Test.Hspec.Monadic+      Test.Hspec.Runner+      Test.Hspec.Formatters+      Test.Hspec.HUnit+      Test.Hspec.QuickCheck+      Test.Hspec.Util+      Test.Hspec.Compat+      Test.Hspec.Pending+      Test.Hspec.Core.Type+      Test.Hspec.Config+      Test.Hspec.FailureReport+      Test.Hspec.Formatters.Internal++-- hspec-discover+executable hspec-meta-discover+  ghc-options:+      -Wall+  hs-source-dirs:+      hspec-discover/src+  main-is:+      Main.hs+  other-modules:+      Run+  build-depends:+      base    == 4.*+    , filepath+    , directory

@@ -0,0 +1,128 @@+-- |+-- Stability: stable+--+-- Hspec is a framework for /Behavior-Driven Development (BDD)/ in Haskell. BDD+-- is an approach to software development that combines Test-Driven+-- Development, Domain-Driven Design, and Acceptance Test-Driven Planning.+-- Hspec helps you do the TDD part of that equation, focusing on the+-- documentation and design aspects of TDD.+--+-- Hspec (and the preceding intro) are based on the Ruby library RSpec. Much of+-- what applies to RSpec also applies to Hspec. Hspec ties together+-- /textual descriptions/ of behavior and /examples/ for that behavior.  The+-- examples serve as test cases for the specified behavior.  Hspec's mechanism+-- for examples is extensible.  Support for QuickCheck properties and HUnit+-- tests is included in the core package.+module Test.Hspec (++-- * Introduction+-- $intro++-- * Types+  Spec+, Example+, Pending++-- * Setting expectations+, module Test.Hspec.Expectations++-- * Defining a spec+, describe+, context+, it+, pending++-- * Running a spec+, hspec+) where++import           Test.Hspec.Core.Type hiding (describe, it)+import           Test.Hspec.Runner+import           Test.Hspec.HUnit ()+import           Test.Hspec.Expectations+import           Test.Hspec.Pending+import qualified Test.Hspec.Core as Core++-- $intro+--+-- The three functions you'll use the most are 'hspec', 'describe', and 'it'.+-- Here is an example of functions that format and unformat phone numbers and+-- the specs for them.+--+-- > import Test.Hspec+-- > import Test.QuickCheck+-- > import Test.HUnit+-- >+-- > main :: IO ()+-- > main = hspec spec+--+-- Since the specs are often used to tell you what to implement, it's best to+-- start with undefined functions. Once we have some specs, then you can+-- implement each behavior one at a time, ensuring that each behavior is met+-- and there is no undocumented behavior.+--+-- > unformatPhoneNumber :: String -> String+-- > unformatPhoneNumber = undefined+-- >+-- > formatPhoneNumber :: String -> String+-- > formatPhoneNumber = undefined+--+-- The 'describe' function takes a list of behaviors and examples bound+-- together with the 'it' function+--+-- > spec :: Spec+-- > spec = do+-- >   describe "unformatPhoneNumber" $ do+--+-- A `Bool` can be used as an example.+--+-- >     it "removes dashes, spaces, and parenthesies" $+-- >       unformatPhoneNumber "(555) 555-1234" == "5555551234"+--+--+-- The 'pending' function marks a behavior as pending an example. The example+-- doesn't count as failing.+--+-- >     it "handles non-US phone numbers" $+-- >       pending "need to look up how other cultures format phone numbers"+--+-- An HUnit 'Test.HUnit.Lang.Assertion' can be used as an example.+--+-- >     it "converts letters to numbers" $ do+-- >       let expected = "6862377"+-- >           actual   = unformatPhoneNumber "NUMBERS"+-- >       actual @?= expected+--+--+-- A QuickCheck 'Test.QuickCheck.Property' can be used as an example.+--+-- >     it "can add and remove formatting without changing the number" $ property $+-- >       forAll phoneNumber $ \n -> unformatPhoneNumber (formatPhoneNumber n) == n+-- >+-- > phoneNumber :: Gen String+-- > phoneNumber = do+-- >   n <- elements [7,10,11,12,13,14,15]+-- >   vectorOf n (elements "0123456789")+++-- | Combine a list of specs into a larger spec.+describe :: String -> Spec -> Spec+describe label action = fromSpecList [Core.describe label (runSpecM action)]++-- | An alias for `describe`.+context :: String -> Spec -> Spec+context = describe++-- | Create a spec item.+--+-- A spec item consists of:+--+-- * a textual description of a desired behavior+--+-- * an example for that behavior+--+-- > describe "absolute" $ do+-- >   it "returns a positive number when given a negative number" $+-- >     absolute (-1) == 1+it :: Example v => String -> v -> Spec+it label action = fromSpecList [Core.it label action]

@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}+module Test.Hspec.Compat where++import           Data.Typeable (Typeable, typeOf, typeRepTyCon)++#if MIN_VERSION_base(4,4,0)+import           Data.Typeable.Internal (tyConModule, tyConName)+#endif+++showType :: Typeable a => a -> String+showType a = let t = typeRepTyCon (typeOf a) in+#if MIN_VERSION_base(4,4,0)+  tyConModule t ++ "." ++ tyConName t+#else+  show t+#endif

@@ -0,0 +1,149 @@+module Test.Hspec.Config (+  Config (..)+, ColorMode (..)+, defaultConfig+, getConfig+, configAddFilter+) where++import           Control.Monad (unless)+import           Control.Applicative+import           System.IO+import           System.Exit+import           System.Environment+import           System.Console.GetOpt+import qualified Test.QuickCheck as QC+import           Test.Hspec.Formatters++import           Test.Hspec.Util+import           Test.Hspec.Core.Type (Params (..), defaultParams)++-- for Monad (Either e) when base < 4.3+import           Control.Monad.Trans.Error ()++data Config = Config {+  configVerbose         :: Bool+, configDryRun          :: Bool+, configPrintCpuTime    :: Bool+, configReRun           :: Bool++-- |+-- A predicate that is used to filter the spec before it is run.  Only examples+-- that satisfy the predicate are run.+, configFilterPredicate :: Maybe (Path -> Bool)+, configParams          :: Params+, configColorMode       :: ColorMode+, configFormatter       :: Formatter+, configHtmlOutput      :: Bool+, configHandle          :: Handle+}++data ColorMode = ColorAuto | ColorNever | ColorAlway++defaultConfig :: Config+defaultConfig = Config False False False False Nothing defaultParams ColorAuto specdoc False stdout++formatters :: [(String, Formatter)]+formatters = [+    ("specdoc", specdoc)+  , ("progress", progress)+  , ("failed-examples", failed_examples)+  , ("silent", silent)+  ]++formatHelp :: String+formatHelp = unlines ("Use a custom formatter.  This can be one of:" : map (("  " ++) . fst) formatters)++type Result = Either NoConfig Config++data NoConfig = Help | InvalidArgument String String++-- | Add a filter predicate to config.  If there is already a filter predicate,+-- then combine them with `||`.+configAddFilter :: (Path -> Bool) -> Config -> Config+configAddFilter p1 c = c {configFilterPredicate = Just p}+  where+    -- if there is already a predicate, we combine them with ||+    p  = maybe p1 (\p0 path -> p0 path || p1 path) mp+    mp = configFilterPredicate c++setQC_MaxSuccess :: String -> Result -> Result+setQC_MaxSuccess n x = (mapParams $ \p -> p {paramsQuickCheckArgs = (paramsQuickCheckArgs p) {QC.maxSuccess = read n}}) <$> x+  where+    mapParams :: (Params -> Params) -> Config -> Config+    mapParams f c = c {configParams = f (configParams c)}++options :: [OptDescr (Result -> Result)]+options = [+    Option []  ["help"]                    (NoArg (const $ Left Help))        "display this help and exit"+  , Option "v" ["verbose"]                 (NoArg setVerbose)                 "do not suppress output to stdout when\nevaluating examples"+  , Option "m" ["match"]                   (ReqArg setFilter "PATTERN")       "only run examples that match given PATTERN"+  , Option []  ["color"]                   (OptArg setColor "WHEN")           "colorize the output.  WHEN defaults to\n`always' or can be `never' or `auto'."+  , Option "f" ["format"]                  (ReqArg setFormatter "FORMATTER")  formatHelp+  , Option "a" ["qc-max-success"]          (ReqArg setQC_MaxSuccess "N")      "maximum number of successful tests before a\nQuickCheck property succeeds"+  , Option []  ["print-cpu-time"]          (NoArg setPrintCpuTime)            "include used CPU time in summary"+  , Option []  ["dry-run"]                 (NoArg setDryRun)                  "pretend that everything passed; don't verify\nanything"+  ]+  where+    setFilter :: String -> Result -> Result+    setFilter pattern x = configAddFilter (filterPredicate pattern) <$> x++    setVerbose      x = x >>= \c -> return c {configVerbose      = True}+    setPrintCpuTime x = x >>= \c -> return c {configPrintCpuTime = True}+    setDryRun       x = x >>= \c -> return c {configDryRun       = True}++    setFormatter name x = x >>= \c -> case lookup name formatters of+      Nothing -> Left (InvalidArgument "format" name)+      Just f  -> return c {configFormatter = f}++    setColor mValue x = x >>= \c -> parseColor mValue >>= \v -> return c {configColorMode = v}+      where+        parseColor s = case s of+          Nothing       -> return ColorAlway+          Just "auto"   -> return ColorAuto+          Just "never"  -> return ColorNever+          Just "always" -> return ColorAlway+          Just v        -> Left (InvalidArgument "color" v)++undocumentedOptions :: [OptDescr (Result -> Result)]+undocumentedOptions = [+    Option "r" ["re-run"]                  (NoArg  setReRun)                  "only re-run examples that previously failed"++    -- for compatibility with test-framework+  , Option ""  ["maximum-generated-tests"] (ReqArg setQC_MaxSuccess "NUMBER") "how many automated tests something like QuickCheck should try, by default"++    -- undocumented for now, as we probably want to change this to produce a+    -- standalone HTML report in the future+  , Option []  ["html"]                    (NoArg setHtml)                    "produce HTML output"+  ]+  where+    setReRun :: Result -> Result+    setReRun x = x >>= \c -> return c {configReRun = True}++    setHtml :: Result -> Result+    setHtml x = x >>= \c -> return c {configHtmlOutput = True}++getConfig :: IO Config+getConfig = do+  (opts, args, errors) <- getOpt Permute (options ++ undocumentedOptions) <$> getArgs++  unless (null errors)+    (tryHelp $ head errors)++  unless (null args)+    (tryHelp $ "unexpected argument `" ++ head args ++ "'\n")++  case foldl (flip id) (Right defaultConfig) opts of+    Left Help -> do+      name <- getProgName+      putStr $ usageInfo ("Usage: " ++ name ++ " [OPTION]...\n\nOPTIONS") options+      exitSuccess+    Left (InvalidArgument flag value) -> do+      tryHelp $ "invalid argument `" ++ value ++ "' for `--" ++ flag ++ "'\n"+    Right config -> do+      return config+  where+    tryHelp message = do+      name <- getProgName+      hPutStr stderr $ name ++ ": " ++ message ++ "Try `" ++ name ++ " --help' for more information.\n"+      exitFailure

@@ -0,0 +1,72 @@+-- |+-- Stability: experimental+--+-- This module provides access to Hspec's internals.  It is less stable than+-- other parts of the API.  For most users "Test.Hspec" is more suitable!+module Test.Hspec.Core (++-- * A type class for examples+  Example (..)+, Params (..)+, Result (..)++-- * A writer monad for constructing specs+, SpecM+, runSpecM+, fromSpecList++-- * Internal representation of a spec tree+, SpecTree (..)+, describe+, it++-- * Deprecated types and functions+, Spec+, Specs+, hspecB+, hspecX+, hHspec+, hspec+, Pending+, pending+) where++import           Control.Applicative+import           System.IO (Handle)++import           Test.Hspec.Core.Type hiding (Spec)+import qualified Test.Hspec.Pending as Pending+import qualified Test.Hspec.Runner as Runner+import           Test.Hspec.Runner (Summary(..), Config(..), defaultConfig)++hspecWith :: Config -> [SpecTree] -> IO Summary+hspecWith c = Runner.hspecWith c . fromSpecList++{-# DEPRECATED hspecX "use `Test.Hspec.Runner.hspec` instead" #-}     -- since 1.2.0+hspecX :: [SpecTree] -> IO ()+hspecX = hspec++{-# DEPRECATED hspec "use `Test.Hspec.Runner.hspec` instead" #-}      -- since 1.4.0+hspec :: [SpecTree] -> IO ()+hspec = Runner.hspec . fromSpecList++{-# DEPRECATED hspecB "use `Test.Hspec.Runner.hspecWith` instead" #-} -- since 1.4.0+hspecB :: [SpecTree] -> IO Bool+hspecB spec = (== 0) . summaryFailures <$> hspecWith defaultConfig spec++{-# DEPRECATED hHspec "use `Test.Hspec.Runner.hspecWith` instead" #-} -- since 1.4.0+hHspec :: Handle -> [SpecTree] -> IO Summary+hHspec h = hspecWith defaultConfig {configHandle = h}++{-# DEPRECATED Spec "use `SpecTree` instead" #-}                      -- since 1.4.0+type Spec = SpecTree++{-# DEPRECATED Specs "use `[SpecTree]` instead" #-}                   -- since 1.4.0+type Specs = [SpecTree]++{-# DEPRECATED pending "use `Test.Hspec.pending` instead" #-}         -- since 1.4.0+pending :: String -> Pending+pending = Pending.pending++{-# DEPRECATED Pending "use `Test.Hspec.Pending` instead" #-}         -- since 1.4.0+type Pending = Pending.Pending

@@ -0,0 +1,95 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving #-}+module Test.Hspec.Core.Type (+  Spec+, SpecM (..)+, runSpecM+, fromSpecList+, SpecTree (..)+, Example (..)+, Result (..)++, Params (..)+, defaultParams++, describe+, it+) where++import qualified Control.Exception as E+import           Control.Applicative+import           Control.Monad (when)+import           Control.Monad.Trans.Writer (Writer, execWriter, tell)++import           Test.Hspec.Util+import           Test.Hspec.Expectations+import           Test.HUnit.Lang (HUnitFailure(..))+import qualified Test.QuickCheck as QC++type Spec = SpecM ()++-- | A writer monad for `SpecTree` forests.+newtype SpecM a = SpecM (Writer [SpecTree] a)+  deriving (Functor, Applicative, Monad)++-- | Convert a `Spec` to a forest of `SpecTree`s.+runSpecM :: Spec -> [SpecTree]+runSpecM (SpecM specs) = execWriter specs++-- | Create a `Spec` from a forest of `SpecTree`s.+fromSpecList :: [SpecTree] -> Spec+fromSpecList = SpecM . tell++-- | The result of running an example.+data Result = Success | Pending (Maybe String) | Fail String+  deriving (Eq, Show)++data Params = Params {+  paramsQuickCheckArgs :: QC.Args+}++defaultParams :: Params+defaultParams = Params QC.stdArgs++-- | Internal representation of a spec.+data SpecTree =+    SpecGroup String [SpecTree]+  | SpecItem  String (Params -> IO Result)++-- | The @describe@ function combines a list of specs into a larger spec.+describe :: String -> [SpecTree] -> SpecTree+describe = SpecGroup++-- | Create a spec item.+it :: Example a => String -> a -> SpecTree+it s e = SpecItem s (`evaluateExample` e)++-- | A type class for examples.+class Example a where+  evaluateExample :: Params -> a -> IO Result++instance Example Bool where+  evaluateExample _ b = if b then return Success else return (Fail "")++instance Example Expectation where+  evaluateExample _ action = (action >> return Success) `E.catch` \(HUnitFailure err) -> return (Fail err)++instance Example Result where+  evaluateExample _ r = return r++instance Example QC.Property where+  evaluateExample c p = do+    r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) p+    when (isUserInterrupt r) $ do+      E.throwIO E.UserInterrupt++    return $+      case r of+        QC.Success {}               -> Success+        f@(QC.Failure {})           -> Fail (QC.output f)+        QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ quantify n "test" )+        QC.NoExpectedFailure {}     -> Fail ("No expected failure")+    where+      isUserInterrupt :: QC.Result -> Bool+      isUserInterrupt r = case r of+        QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True+        _ -> False

@@ -0,0 +1,26 @@+module Test.Hspec.FailureReport where++import           System.IO+import           System.SetEnv+import           Test.Hspec.Config+import           Test.Hspec.Util (safeEvaluate, readMaybe, getEnv)++writeFailureReport :: String -> IO ()+writeFailureReport x = do+  -- on Windows this can throw an exception when the input is too large, hence+  -- we use `safeEvaluate` here+  r <- safeEvaluate (setEnv "HSPEC_FAILURES" x)+  either onError return r+  where+    onError err = do+      hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")")++readFailureReport :: Config -> IO Config+readFailureReport c = do+  mx <- getEnv "HSPEC_FAILURES"+  case mx >>= readMaybe of+    Nothing -> do+      hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--re-run' is ignored!"+      return c+    Just xs -> do+      return $ configAddFilter (`elem` xs) c

@@ -0,0 +1,186 @@+-- |+-- Stability: experimental+--+-- This module contains formatters that can be used with+-- `Test.Hspec.Runner.hspecWith`.+module Test.Hspec.Formatters (++-- * Formatters+  silent+, specdoc+, progress+, failed_examples++-- * Implementing a custom Formatter+-- |+-- A formatter is a set of actions.  Each action is evaluated when a certain+-- situation is encountered during a test run.+--+-- Actions live in the `FormatM` monad.  It provides access to the runner state+-- and primitives for appending to the generated report.+, Formatter (..)+, FormatM++-- ** Accessing the runner state+, getSuccessCount+, getPendingCount+, getFailCount+, getTotalCount++, FailureRecord (..)+, getFailMessages++, getCPUTime+, getRealTime++-- ** Appending to the gerenated report+, write+, writeLine+, newParagraph++-- ** Dealing with colors+, withSuccessColor+, withPendingColor+, withFailColor+) where++import           Data.Maybe+import           Test.Hspec.Util+import           Test.Hspec.Compat+import           Data.List (intersperse)+import           Text.Printf+import           Control.Monad (unless)+import           Control.Applicative+import qualified Control.Exception as E++-- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make+-- sure, that we only use the public API to implement formatters.+--+-- Everything imported here has to be re-exported, so that users can implement+-- their own formatters.+import Test.Hspec.Formatters.Internal (+    Formatter (..)+  , FormatM++  , getSuccessCount+  , getPendingCount+  , getFailCount+  , getTotalCount++  , FailureRecord (..)+  , getFailMessages++  , getCPUTime+  , getRealTime++  , write+  , writeLine+  , newParagraph++  , withSuccessColor+  , withPendingColor+  , withFailColor+  )+++silent :: Formatter+silent = Formatter {+  headerFormatter     = return ()+, exampleGroupStarted = \_ _ _ -> return ()+, exampleGroupDone    = return ()+, exampleSucceeded    = \_ -> return ()+, exampleFailed       = \_ _ -> return ()+, examplePending      = \_ _  -> return ()+, failedFormatter     = return ()+, footerFormatter     = return ()+}+++specdoc :: Formatter+specdoc = silent {++  headerFormatter = do+    writeLine ""++, exampleGroupStarted = \n nesting name -> do++    -- separate groups with an empty line+    unless (n == 0) $ do+      newParagraph++    writeLine (indentationFor nesting ++ name)++, exampleGroupDone = do+    newParagraph++, exampleSucceeded = \(nesting, requirement) -> withSuccessColor $ do+    writeLine $ indentationFor nesting ++ "- " ++ requirement++, exampleFailed = \(nesting, requirement) _ -> withFailColor $ do+    n <- getFailCount+    writeLine $ indentationFor nesting ++ "- " ++ requirement ++ " FAILED [" ++ show n ++ "]"++, examplePending = \(nesting, requirement) reason -> withPendingColor $ do+    writeLine $ indentationFor nesting ++ "- " ++ requirement ++ "\n     # PENDING: " ++ fromMaybe "No reason given" reason++, failedFormatter = defaultFailedFormatter++, footerFormatter = defaultFooter+} where+    indentationFor nesting = replicate (length nesting * 2) ' '+++progress :: Formatter+progress = silent {+  exampleSucceeded = \_   -> withSuccessColor $ write "."+, exampleFailed    = \_ _ -> withFailColor    $ write "F"+, examplePending   = \_ _ -> withPendingColor $ write "."+, failedFormatter  = defaultFailedFormatter+, footerFormatter  = defaultFooter+}+++failed_examples :: Formatter+failed_examples   = silent {+  failedFormatter = defaultFailedFormatter+, footerFormatter = defaultFooter+}++defaultFailedFormatter :: FormatM ()+defaultFailedFormatter = do+  newParagraph+  withFailColor $ do+    failures <- map formatFailure . zip [1..] <$> getFailMessages+    mapM_ writeLine (intersperse "" failures)+    unless (null failures) (writeLine "")+  where+    formatFailure :: (Int, FailureRecord) -> String+    formatFailure (i, FailureRecord path reason) =+      show i ++ ") " ++ formatRequirement path ++ " FAILED" ++ err+      where+        err = case reason of+          Left (E.SomeException e)  -> " (uncaught exception)\n" ++ formatException e+          Right e -> if null e then "" else "\n" ++ e++        formatException e = showType e ++ " (" ++ show e ++ ")"++defaultFooter :: FormatM ()+defaultFooter = do++  writeLine =<< (++)+    <$> (printf "Finished in %1.4f seconds"+    <$> getRealTime) <*> (maybe "" (printf ", used %1.4f seconds of CPU time") <$> getCPUTime)++  fails   <- getFailCount+  pending <- getPendingCount+  total   <- getTotalCount++  let c | fails /= 0   = withFailColor+        | pending /= 0 = withPendingColor+        | otherwise    = withSuccessColor+  c $ do+    write $ quantify total   "example"+    write (", " ++ quantify fails "failure")+    unless (pending == 0) $+      write (", " ++ show pending ++ " pending")+  writeLine ""

@@ -0,0 +1,239 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Test.Hspec.Formatters.Internal (++-- * Public API+  Formatter (..)+, FormatM++, getSuccessCount+, getPendingCount+, getFailCount+, getTotalCount++, FailureRecord (..)+, getFailMessages++, getCPUTime+, getRealTime++, write+, writeLine+, newParagraph++, withSuccessColor+, withPendingColor+, withFailColor++-- * Functions for internal use+, runFormatM+, liftIO+, increaseSuccessCount+, increasePendingCount+, increaseFailCount+, addFailMessage+) where++import qualified System.IO as IO+import           System.IO (Handle)+import           Control.Monad (when, unless)+import           Control.Applicative+import           Control.Exception (SomeException, bracket_)+import           System.Console.ANSI+import           Control.Monad.Trans.State hiding (gets, modify)+import qualified Control.Monad.Trans.State as State+import qualified Control.Monad.IO.Class as IOClass+import qualified System.CPUTime as CPUTime+import           Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)++import           Test.Hspec.Util (Path)++-- | A lifted version of `State.gets`+gets :: (FormatterState -> a) -> FormatM a+gets f = FormatM (State.gets f)++-- | A lifted version of `State.modify`+modify :: (FormatterState -> FormatterState) -> FormatM ()+modify f = FormatM (State.modify f)++-- | A lifted version of `IOClass.liftIO`+--+-- This is meant for internal use only, and not part of the public API.  This+-- is also the reason why we do not make FormatM an instance MonadIO, so we+-- have narrow control over the visibilty of this function.+liftIO :: IO a -> FormatM a+liftIO action = FormatM (IOClass.liftIO action)++data FormatterState = FormatterState {+  stateHandle     :: Handle+, stateUseColor   :: Bool+, produceHTML     :: Bool+, lastIsEmptyLine :: Bool    -- True, if last line was empty+, successCount    :: Int+, pendingCount    :: Int+, failCount       :: Int+, failMessages    :: [FailureRecord]+, cpuStartTime    :: Maybe Integer+, startTime       :: POSIXTime+}++-- | The total number of examples encountered so far.+totalCount :: FormatterState -> Int+totalCount s = successCount s + pendingCount s + failCount s++newtype FormatM a = FormatM (StateT FormatterState IO a)+  deriving (Functor, Applicative, Monad)++runFormatM :: Bool -> Bool -> Bool -> Handle -> FormatM a -> IO a+runFormatM useColor produceHTML_ printCpuTime handle (FormatM action) = do+  time <- getPOSIXTime+  cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing+  evalStateT action (FormatterState handle useColor produceHTML_ False 0 0 0 [] cpuTime time)++-- | Increase the counter for successful examples+increaseSuccessCount :: FormatM ()+increaseSuccessCount = modify $ \s -> s {successCount = succ $ successCount s}++-- | Increase the counter for pending examples+increasePendingCount :: FormatM ()+increasePendingCount = modify $ \s -> s {pendingCount = succ $ pendingCount s}++-- | Increase the counter for failed examples+increaseFailCount :: FormatM ()+increaseFailCount = modify $ \s -> s {failCount = succ $ failCount s}++-- | Get the number of successful examples encountered so far.+getSuccessCount :: FormatM Int+getSuccessCount = gets successCount++-- | Get the number of pending examples encountered so far.+getPendingCount :: FormatM Int+getPendingCount = gets pendingCount++-- | Get the number of failed examples encountered so far.+getFailCount :: FormatM Int+getFailCount = gets failCount++-- | Get the total number of examples encountered so far.+getTotalCount :: FormatM Int+getTotalCount = gets totalCount++-- | Append to the list of accumulated failure messages.+addFailMessage :: Path -> (Either SomeException String) -> FormatM ()+addFailMessage p m = modify $ \s -> s {failMessages = FailureRecord p m : failMessages s}++-- | Get the list of accumulated failure messages.+getFailMessages :: FormatM [FailureRecord]+getFailMessages = reverse `fmap` gets failMessages++data FailureRecord = FailureRecord {+  failureRecordPath     :: Path+, failureRecordMessage  :: Either SomeException String+}++data Formatter = Formatter {++  headerFormatter :: FormatM ()++-- | evaluated before each test group+--+-- The given number indicates the position within the parent group.+, exampleGroupStarted :: Int -> [String] -> String -> FormatM ()++, exampleGroupDone    :: FormatM ()++-- | evaluated after each successful example+, exampleSucceeded    :: Path -> FormatM ()++-- | evaluated after each failed example+, exampleFailed       :: Path -> Either SomeException String -> FormatM ()++-- | evaluated after each pending example+, examplePending      :: Path -> Maybe String -> FormatM ()++-- | evaluated after a test run+, failedFormatter     :: FormatM ()++-- | evaluated after `failuresFormatter`+, footerFormatter     :: FormatM ()+}+++-- | Append an empty line to the report.+--+-- Calling this multiple times has the same effect as calling it once.+newParagraph :: FormatM ()+newParagraph = do+  f <- gets lastIsEmptyLine+  unless f $ do+    writeLine ""+    setLastIsEmptyLine True++setLastIsEmptyLine :: Bool -> FormatM ()+setLastIsEmptyLine f = modify $ \s -> s {lastIsEmptyLine = f}++-- | Append some output to the report.+write :: String -> FormatM ()+write s = do+  h <- gets stateHandle+  liftIO $ IO.hPutStr h s+  setLastIsEmptyLine False++-- | The same as `write`, but adds a newline character.+writeLine :: String -> FormatM ()+writeLine s = write s >> write "\n"++-- | Set output color to red, run given action, and finally restore the default+-- color.+withFailColor :: FormatM a -> FormatM a+withFailColor = withColor (SetColor Foreground Dull Red) "hspec-failure"++-- | Set output to color green, run given action, and finally restore the+-- default color.+withSuccessColor :: FormatM a -> FormatM a+withSuccessColor = withColor (SetColor Foreground Dull Green) "hspec-success"++-- | Set output color to yellow, run given action, and finally restore the+-- default color.+withPendingColor :: FormatM a -> FormatM a+withPendingColor = withColor (SetColor Foreground Dull Yellow) "hspec-pending"++-- | Set a color, run an action, and finally reset colors.+withColor :: SGR -> String -> FormatM a -> FormatM a+withColor color cls action = do+  r <- gets produceHTML+  (if r then htmlSpan cls else withColor_ color) action++htmlSpan :: String -> FormatM a -> FormatM a+htmlSpan cls action = write ("<span class=\"" ++ cls ++ "\">") *> action <* write "</span>"++withColor_ :: SGR -> FormatM a -> FormatM a+withColor_ color (FormatM action) = FormatM . StateT $ \st -> do+  let useColor = stateUseColor st+      h        = stateHandle st++  bracket_++    -- set color+    (when useColor $ hSetSGR h [color])++    -- reset colors+    (when useColor $ hSetSGR h [Reset])++    -- run action+    (runStateT action st)++-- | Get the used CPU time since the test run has been started.+getCPUTime :: FormatM (Maybe Double)+getCPUTime = do+  t1  <- liftIO CPUTime.getCPUTime+  mt0 <- gets cpuStartTime+  return $ toSeconds <$> ((-) <$> pure t1 <*> mt0)+  where+    toSeconds x = fromIntegral x / (10.0 ^ (12 :: Integer))++-- | Get the passed real time since the test run has been started.+getRealTime :: FormatM Double+getRealTime = do+  t1 <- liftIO getPOSIXTime+  t0 <- gets startTime+  return (realToFrac $ t1 - t0)

@@ -0,0 +1,39 @@+{-# OPTIONS -fno-warn-orphans #-}+module Test.Hspec.HUnit (+-- * Interoperability with HUnit+  fromHUnitTest+) where++import           Data.List (intersperse)+import qualified Test.HUnit as HU+import           Test.HUnit (Test (..))++import           Test.Hspec.Core.Type++-- | This instance is deprecated, use `Test.Hspec.HUnit.fromHUnitTest` instead!+instance Example Test where+  evaluateExample _ test = do+    (counts, fails) <- HU.runTestText HU.putTextToShowS test+    let r = if HU.errors counts + HU.failures counts == 0+             then Success+             else Fail (details $ fails "")+    return r+    where+      details :: String -> String+      details = concat . intersperse "\n" . tail . init . lines++-- |+-- Convert a HUnit test suite to a spec.  This can be used to run existing+-- HUnit tests with Hspec.+fromHUnitTest :: Test -> Spec+fromHUnitTest t = fromSpecList $ case t of+  TestList xs -> map go xs+  x           -> [go x]+  where+    go :: Test -> SpecTree+    go t_ = case t_ of+      TestLabel s (TestCase e)  -> it s e+      TestLabel s (TestList xs) -> describe s (map go xs)+      TestLabel s x             -> describe s [go x]+      TestList xs               -> describe "<unlabeled>" (map go xs)+      TestCase e                -> it  "<unlabeled>" e

@@ -0,0 +1,3 @@+module Test.Hspec.Meta (module Test.Hspec) where++import           Test.Hspec

@@ -0,0 +1,54 @@+{-# OPTIONS_HADDOCK not-home #-}+module Test.Hspec.Monadic {-# DEPRECATED "use \"Test.Hspec\", \"Test.Hspec.Runner\" or \"Test.Hspec.Core\" instead" #-} (+-- * Types+  Spec+, Example+, Pending++-- * Defining a spec+, describe+, context+, it+, pending++-- * Running a spec+, hspec+, Summary (..)++-- * Interface to the non-monadic API+, runSpecM+, fromSpecList++-- * Deprecated types and functions+, Specs+, descriptions+, hspecB+, hspecX+, hHspec+) where++import           System.IO+import           Control.Applicative++import           Test.Hspec.Core (runSpecM, fromSpecList)+import           Test.Hspec.Runner+import           Test.Hspec++{-# DEPRECATED Specs "use `Spec` instead" #-}             -- since 1.2.0+type Specs = Spec++{-# DEPRECATED descriptions "use `sequence_` instead" #-} -- since 1.0.0+descriptions :: [Spec] -> Spec+descriptions = sequence_++{-# DEPRECATED hspecX "use `hspec` instead" #-}           -- since 1.2.0+hspecX :: Spec -> IO ()+hspecX = hspec++{-# DEPRECATED hspecB "use `hspecWith` instead" #-}       -- since 1.4.0+hspecB :: Spec -> IO Bool+hspecB spec = (== 0) . summaryFailures <$> hspecWith defaultConfig spec++{-# DEPRECATED hHspec "use hspecWith instead" #-}         -- since 1.4.0+hHspec :: Handle -> Spec -> IO Summary+hHspec h = hspecWith defaultConfig {configHandle = h}

@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleInstances #-}+module Test.Hspec.Pending where++import qualified Test.Hspec.Core.Type as Core+import           Test.Hspec.Core.Type (Example(..))++-- NOTE: This is defined in a separate packages, because it clashes with+-- Result.Pending.++-- | A pending example.+newtype Pending = Pending (Maybe String)++instance Example Pending where+  evaluateExample c (Pending reason) = evaluateExample c (Core.Pending reason)++instance Example (String -> Pending) where+  evaluateExample c _ = evaluateExample c (Pending Nothing)++-- | A pending example.+--+-- If you want to textually specify a behavior but do not have an example yet,+-- use this:+--+-- > describe "fancyFormatter" $ do+-- >   it "can format text in a way that everyone likes" $+-- >     pending+--+-- You can give an optional reason for why it's pending:+--+-- > describe "fancyFormatter" $ do+-- >   it "can format text in a way that everyone likes" $+-- >     pending "waiting for clarification from the designers"+pending :: String -> Pending+pending = Pending . Just

@@ -0,0 +1,27 @@+-- |+-- Stability: provisional+module Test.Hspec.QuickCheck (+-- * Re-exports from QuickCheck+-- |+-- Previous versions of Hspec provided a distinct `property` combinator, but+-- it's now possible to use QuickCheck's `property` instead.  For backward+-- compatibility we now re-export QuickCheck's `property`, but it is advisable+-- to import it from "Test.QuickCheck" instead.+  property+-- * Shortcuts+, prop+) where++import           Test.QuickCheck+import           Test.Hspec++-- |+-- > prop ".." $+-- >   ..+--+-- is a shortcut for+--+-- > it ".." $ property $+-- >   ..+prop :: Testable prop => String -> prop -> Spec+prop s = it s . property

@@ -0,0 +1,142 @@+-- |+-- Stability: provisional+module Test.Hspec.Runner (+-- * Running a spec+  hspec+, hspecWith++-- * Types+, Summary (..)+, Config (..)+, ColorMode (..)+, Path+, defaultConfig+, configAddFilter+) where++import           Control.Monad+import           Control.Applicative+import           Data.Monoid+import           Data.Maybe+import           System.IO+import           System.Environment+import           System.Exit+import           System.IO.Silently (silence)++import           Test.Hspec.Util (Path, safeEvaluate)+import           Test.Hspec.Core.Type+import           Test.Hspec.Config+import           Test.Hspec.Formatters+import           Test.Hspec.Formatters.Internal+import           Test.Hspec.FailureReport++-- | Filter specs by given predicate.+--+-- The predicate takes a list of "describe" labels and a "requirement".+filterSpecs :: (Path -> Bool) -> [SpecTree] -> [SpecTree]+filterSpecs p = goSpecs []+  where+    goSpecs :: [String] -> [SpecTree] -> [SpecTree]+    goSpecs groups = catMaybes . map (goSpec groups)++    goSpec :: [String] -> SpecTree -> Maybe SpecTree+    goSpec groups spec = case spec of+      SpecItem requirement _ -> guard (p (groups, requirement)) >> return spec+      SpecGroup group specs     -> case goSpecs (groups ++ [group]) specs of+        [] -> Nothing+        xs -> Just (SpecGroup group xs)++-- | Evaluate all examples of a given spec and produce a report.+runFormatter :: Config -> Formatter -> [SpecTree] -> FormatM ()+runFormatter c formatter specs = headerFormatter formatter >> mapM_ (go []) (zip [0..] specs)+  where+    silence_+      | configVerbose c = id+      | otherwise       = silence++    eval+      | configDryRun c = \_ -> return (Right Success)+      | otherwise      = liftIO . safeEvaluate . silence_++    go :: [String] -> (Int, SpecTree) -> FormatM ()+    go rGroups (n, SpecGroup group xs) = do+      exampleGroupStarted formatter n (reverse rGroups) group+      mapM_ (go (group : rGroups)) (zip [0..] xs)+      exampleGroupDone formatter+    go rGroups (_, SpecItem requirement example) = do+      result <- eval (example $ configParams c)+      case result of+        Right Success -> do+          increaseSuccessCount+          exampleSucceeded formatter path+        Right (Pending reason) -> do+          increasePendingCount+          examplePending formatter path reason++        Right (Fail err) -> failed (Right err)+        Left e           -> failed (Left  e)+      where+        path = (groups, requirement)+        groups = reverse rGroups+        failed err = do+          increaseFailCount+          addFailMessage path err+          exampleFailed  formatter path err+++-- | Run given spec and write a report to `stdout`.+-- Exit with `exitFailure` if at least one spec item fails.+--+-- (see also `hspecWith`)+hspec :: Spec -> IO ()+hspec spec = do+  c <- getConfig+  withArgs [] {- do not leak command-line arguments to examples -} $ do+    r <- hspecWith c spec+    unless (summaryFailures r == 0) exitFailure++-- | Run given spec with custom options.+-- This is similar to `hspec`, but more flexible.+--+-- /Note/: `hspecWith` does not exit with `exitFailure` on failing spec items.+-- If you need this, you have to check the `Summary` yourself and act+-- accordingly.+hspecWith :: Config -> Spec -> IO Summary+hspecWith c_ spec = do+  -- read failure report on --re-run+  c <- if configReRun c_+    then do+      readFailureReport c_+    else do+      return c_++  let formatter = configFormatter c+      h = configHandle c++  useColor <- doesUseColor h c+  runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) h $ do+    runFormatter c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec)+    failedFormatter formatter+    footerFormatter formatter++    -- dump failure report+    xs <- map failureRecordPath <$> getFailMessages+    liftIO $ writeFailureReport (show xs)++    Summary <$> getTotalCount <*> getFailCount+  where+    doesUseColor :: Handle -> Config -> IO Bool+    doesUseColor h c = case configColorMode c of+      ColorAuto  -> hIsTerminalDevice h+      ColorNever -> return False+      ColorAlway -> return True++-- | Summary of a test run.+data Summary = Summary {+  summaryExamples :: Int+, summaryFailures :: Int+} deriving (Eq, Show)++instance Monoid Summary where+  mempty = Summary 0 0+  (Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2)

@@ -0,0 +1,80 @@+module Test.Hspec.Util (+  quantify+, safeEvaluate+, Path+, filterPredicate+, formatRequirement+, readMaybe+, getEnv+) where++import           Data.List+import           Data.Maybe+import           Data.Char (isSpace)+import           Control.Applicative+import qualified Control.Exception as E+import qualified System.Environment as Environment++-- | Create a more readable display of a quantity of something.+--+-- Examples:+--+-- >>> quantify 0 "example"+-- "0 examples"+--+-- >>> quantify 1 "example"+-- "1 example"+--+-- >>> quantify 2 "example"+-- "2 examples"+quantify :: Int -> String -> String+quantify 1 s = "1 " ++ s+quantify n s = show n ++ " " ++ s ++ "s"++safeEvaluate :: IO a -> IO (Either E.SomeException a)+safeEvaluate action = (Right <$> (action >>= E.evaluate)) `E.catches` [+  -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT+  -- (ctrl-c).  All AsyncExceptions are re-thrown (not just UserInterrupt)+  -- because all of them indicate severe conditions and should not occur during+  -- normal operation.+    E.Handler $ \e -> E.throw (e :: E.AsyncException)++  , E.Handler $ \e -> (return . Left) (e :: E.SomeException)+  ]++-- |+-- A tuple that represents the location of an example within a spec.+--+-- It consists of a list of group descriptions and a requirement description.+type Path = ([String], String)++-- | A predicate that can be used to filter specs.+filterPredicate :: String -> Path -> Bool+filterPredicate pattern path@(groups, requirement) =+     pattern `isInfixOf` plain+  || pattern `isInfixOf` formatted+  where+    plain = intercalate "/" (groups ++ [requirement])+    formatted = formatRequirement path++-- |+-- Try to create a proper English sentence from a path by applying some+-- heuristics.+formatRequirement :: Path -> String+formatRequirement (groups, requirement) = groups_ ++ requirement+  where+    groups_ = case break (any isSpace) groups of+      ([], ys) -> join ys+      (xs, ys) -> join (intercalate "." xs : ys)++    join xs = case xs of+      [x] -> x ++ " "+      ys  -> concatMap (++ ", ") ys++-- NOTE: base-4.6.0.0 provides a function with that name and type.  For+-- compatibility with earlier versions, we define our own version here.+readMaybe :: Read a => String -> Maybe a+readMaybe = fmap fst . listToMaybe . reads++getEnv :: String -> IO (Maybe String)+getEnv key = either (const Nothing) Just <$> safeEvaluate (Environment.getEnv key)