hspec-meta 1.4.5 → 1.5.0
raw patch · 13 files changed
+229/−91 lines, 13 filesdep −silentlydep ~QuickCheckPVP ok
version bump matches the API change (PVP)
Dependencies removed: silently
Dependency ranges changed: QuickCheck
API changes (from Hackage documentation)
- Test.Hspec.Meta: data Pending
+ Test.Hspec.Meta: example :: Expectation -> Expectation
+ Test.Hspec.Meta: pendingWith :: String -> Expectation
- Test.Hspec.Meta: pending :: String -> Pending
+ Test.Hspec.Meta: pending :: Expectation
Files
- hspec-meta.cabal +4/−5
- src/Test/Hspec.hs +17/−2
- src/Test/Hspec/Compat.hs +58/−1
- src/Test/Hspec/Config.hs +9/−10
- src/Test/Hspec/Core.hs +1/−10
- src/Test/Hspec/Core/Type.hs +91/−16
- src/Test/Hspec/Formatters.hs +5/−0
- src/Test/Hspec/Formatters/Internal.hs +8/−2
- src/Test/Hspec/Monadic.hs +0/−1
- src/Test/Hspec/Pending.hs +0/−34
- src/Test/Hspec/Runner.hs +18/−10
- src/Test/Hspec/Timer.hs +14/−0
- src/Test/Hspec/Util.hs +4/−0
hspec-meta.cabal view
@@ -1,8 +1,8 @@ name: hspec-meta-version: 1.4.5+version: 1.5.0 license: BSD3 license-file: LICENSE-copyright: (c) 2011-2012 Trystan Spangler, (c) 2011-2012 Simon Hengel, (c) 2011 Greg Weber+copyright: (c) 2011-2013 Simon Hengel, (c) 2011-2012 Trystan Spangler, (c) 2011 Greg Weber maintainer: Simon Hengel <sol@typeful.net> build-type: Simple cabal-version: >= 1.8@@ -47,12 +47,11 @@ 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+ , QuickCheck >= 2.5.1 , hspec-expectations == 0.3.0.* exposed-modules: Test.Hspec.Meta@@ -66,11 +65,11 @@ 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+ Test.Hspec.Timer -- hspec-discover executable hspec-meta-discover
src/Test/Hspec.hs view
@@ -21,7 +21,6 @@ -- * Types Spec , Example-, Pending -- * Setting expectations , module Test.Hspec.Expectations@@ -30,7 +29,9 @@ , describe , context , it+, example , pending+, pendingWith -- * Running a spec , hspec@@ -40,7 +41,6 @@ import Test.Hspec.Runner import Test.Hspec.HUnit () import Test.Hspec.Expectations-import Test.Hspec.Pending import qualified Test.Hspec.Core as Core -- $intro@@ -126,3 +126,18 @@ -- > absolute (-1) == 1 it :: Example v => String -> v -> Spec it label action = fromSpecList [Core.it label action]++-- | This is a type restricted version of `id`. It can be used to get better+-- error messages on type mismatches.+--+-- Compare e.g.+--+-- > it "exposes some behavior" $ example $ do+-- > putStrLn+--+-- with+--+-- > it "exposes some behavior" $ do+-- > putStrLn+example :: Expectation -> Expectation+example = id
src/Test/Hspec/Compat.hs view
@@ -1,12 +1,60 @@ {-# LANGUAGE CPP #-}-module Test.Hspec.Compat where+module Test.Hspec.Compat (+ showType+, showFullType+, isUserInterrupt+, readMaybe+, module Data.IORef+#if !MIN_VERSION_base(4,6,0)+, modifyIORef'+#endif+) where import Data.Typeable (Typeable, typeOf, typeRepTyCon)+import qualified Test.QuickCheck as QC+import Text.Read+import Data.IORef #if MIN_VERSION_base(4,4,0) import Data.Typeable.Internal (tyConModule, tyConName) #endif +#if !MIN_VERSION_base(4,6,0)+import qualified Text.ParserCombinators.ReadP as P+import Prelude+#endif++#if !MIN_VERSION_base(4,6,0)+-- |Strict version of 'modifyIORef'+modifyIORef' :: IORef a -> (a -> a) -> IO ()+modifyIORef' ref f = do+ x <- readIORef ref+ let x' = f x+ x' `seq` writeIORef ref x'++-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+-- A 'Left' value indicates a parse error.+readEither :: Read a => String -> Either String a+readEither s =+ case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of+ [x] -> Right x+ [] -> Left "Prelude.read: no parse"+ _ -> Left "Prelude.read: ambiguous parse"+ where+ read' =+ do x <- readPrec+ lift P.skipSpaces+ return x++-- | Parse a string using the 'Read' instance.+-- Succeeds if there is exactly one valid result.+readMaybe :: Read a => String -> Maybe a+readMaybe s = case readEither s of+ Left _ -> Nothing+ Right a -> Just a+#endif+ showType :: Typeable a => a -> String showType a = let t = typeRepTyCon (typeOf a) in #if MIN_VERSION_base(4,4,0)@@ -23,3 +71,12 @@ #else show t #endif++isUserInterrupt :: QC.Result -> Bool+isUserInterrupt r = case r of+#if MIN_VERSION_QuickCheck(2,6,0)+ QC.Failure {QC.interrupted = x} -> x+#else+ QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True+#endif+ _ -> False
src/Test/Hspec/Config.hs view
@@ -16,7 +16,6 @@ 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 ()@@ -32,17 +31,19 @@ -- 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+, configQuickCheckArgs :: QC.Args , configColorMode :: ColorMode , configFormatter :: Formatter , configHtmlOutput :: Bool , configHandle :: Handle } +{-# DEPRECATED configVerbose "this has no effect anymore and will be removed with a future release" #-} -- deprecated since 1.5.0+ data ColorMode = ColorAuto | ColorNever | ColorAlway defaultConfig :: Config-defaultConfig = Config False False False False False Nothing defaultParams ColorAuto specdoc False stdout+defaultConfig = Config False False False False False Nothing QC.stdArgs {QC.chatty = False} ColorAuto specdoc False stdout formatters :: [(String, Formatter)] formatters = [@@ -69,10 +70,7 @@ 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)}+setQC_MaxSuccess n x = (\c -> c {configQuickCheckArgs = (configQuickCheckArgs c) {QC.maxSuccess = read n}}) <$> x addLineBreaks :: String -> [String] addLineBreaks = lineBreaksAt 44@@ -80,14 +78,13 @@ options :: [OptDescr (Result -> Result)] options = [ Option [] ["help"] (NoArg (const $ Left Help)) (h "display this help and exit")- , Option "v" ["verbose"] (NoArg setVerbose) (h "do not suppress output to stdout when evaluating examples") , Option "m" ["match"] (ReqArg setFilter "PATTERN") (h "only run examples that match given PATTERN") , Option [] ["color"] (OptArg setColor "WHEN") (h "colorize the output; WHEN defaults to `always' or can be `never' or `auto'") , Option "f" ["format"] (ReqArg setFormatter "FORMATTER") formatHelp , Option "a" ["qc-max-success"] (ReqArg setQC_MaxSuccess "N") (h "maximum number of successful tests before a QuickCheck property succeeds") , Option [] ["print-cpu-time"] (NoArg setPrintCpuTime) (h "include used CPU time in summary") , Option [] ["dry-run"] (NoArg setDryRun) (h "pretend that everything passed; don't verify anything")- , Option [] ["fast-fail"] (NoArg setFastFail) (h "stop after first failure")+ , Option [] ["fail-fast"] (NoArg setFastFail) (h "abort on first failure") ] where h = unlines . addLineBreaks@@ -95,7 +92,6 @@ 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} setFastFail x = x >>= \c -> return c {configFastFail = True}@@ -123,6 +119,9 @@ -- undocumented for now, as we probably want to change this to produce a -- standalone HTML report in the future , Option [] ["html"] (NoArg setHtml) "produce HTML output"++ -- now a noop+ , Option "v" ["verbose"] (NoArg id) "do not suppress output to stdout when evaluating examples" ] where setReRun :: Result -> Result
src/Test/Hspec/Core.hs view
@@ -8,6 +8,7 @@ -- * A type class for examples Example (..) , Params (..)+, Progress , Result (..) -- * A writer monad for constructing specs@@ -27,15 +28,12 @@ , 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) @@ -63,10 +61,3 @@ {-# 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
src/Test/Hspec/Core/Type.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.Core.Type ( Spec , SpecM (..)@@ -7,24 +8,33 @@ , SpecTree (..) , Example (..) , Result (..)- , Params (..)-, defaultParams+, Progress , describe , it++, pending+, pendingWith ) where import qualified Control.Exception as E import Control.Applicative import Control.Monad (when) import Control.Monad.Trans.Writer (Writer, execWriter, tell)+import Data.Typeable (Typeable)+import Data.List (isPrefixOf)+import Data.Maybe (fromMaybe) import Test.Hspec.Util import Test.Hspec.Expectations import Test.HUnit.Lang (HUnitFailure(..)) import qualified Test.QuickCheck as QC+import qualified Test.QuickCheck.State as QC+import qualified Test.QuickCheck.Property as QCP +import Test.Hspec.Compat (isUserInterrupt)+ type Spec = SpecM () -- | A writer monad for `SpecTree` forests.@@ -41,15 +51,17 @@ -- | The result of running an example. data Result = Success | Pending (Maybe String) | Fail String- deriving (Eq, Show)+ deriving (Eq, Show, Read, Typeable) +instance E.Exception Result++type Progress = (Int, Int)+ data Params = Params { paramsQuickCheckArgs :: QC.Args+, paramsReportProgress :: Progress -> IO () } -defaultParams :: Params-defaultParams = Params QC.stdArgs- -- | Internal representation of a spec. data SpecTree = SpecGroup String [SpecTree]@@ -57,11 +69,19 @@ -- | The @describe@ function combines a list of specs into a larger spec. describe :: String -> [SpecTree] -> SpecTree-describe = SpecGroup+describe s = SpecGroup msg+ where+ msg+ | null s = "(no description given)"+ | otherwise = s -- | Create a spec item. it :: Example a => String -> a -> SpecTree-it s e = SpecItem s (`evaluateExample` e)+it s e = SpecItem msg (`evaluateExample` e)+ where+ msg+ | null s = "(unspecified behavior)"+ | otherwise = s -- | A type class for examples. class Example a where@@ -71,25 +91,80 @@ 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)+ evaluateExample _ action = (action >> return Success) `E.catches` [+ E.Handler (\(HUnitFailure err) -> (return . Fail) err)+ , E.Handler (return :: Result -> IO Result)+ ] instance Example Result where evaluateExample _ r = return r instance Example QC.Property where evaluateExample c p = do- r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) p+ r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) (QCP.callback progressCallback p) when (isUserInterrupt r) $ do E.throwIO E.UserInterrupt return $ case r of QC.Success {} -> Success- f@(QC.Failure {}) -> Fail (QC.output f)+ QC.Failure {QC.output = m} -> fromMaybe (Fail $ sanitizeFailureMessage m) (parsePending m) 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+ progressCallback = QCP.PostTest QCP.NotCounterexample $+ \st _ -> paramsReportProgress c (QC.numSuccessTests st, QC.maxSuccessTests st)++ sanitizeFailureMessage :: String -> String+ sanitizeFailureMessage = strip . addFalsifiable . stripFailed++ addFalsifiable :: String -> String+ addFalsifiable m+ | "(after " `isPrefixOf` m = "Falsifiable " ++ m+ | otherwise = m++ stripFailed :: String -> String+ stripFailed m+ | prefix `isPrefixOf` m = drop n m+ | otherwise = m+ where+ prefix = "*** Failed! "+ n = length prefix++ parsePending :: String -> Maybe Result+ parsePending m+ | prefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m+ | otherwise = Nothing+ where+ n = length prefix+ prefix = "*** Failed! Exception: '"++instance QC.Testable Expectation where+ property = propertyIO+ exhaustive _ = True++propertyIO :: Expectation -> QC.Property+propertyIO action = QCP.morallyDubiousIOProperty $ do+ (action >> return succeeded) `E.catch` \(HUnitFailure err) -> return (failed err)+ where+ succeeded = QC.property QCP.succeeded+ failed err = QC.property QCP.failed {QCP.reason = err}++-- | Specifies a pending example.+--+-- If you want to textually specify a behavior but do not have an example yet,+-- use this:+--+-- > describe "fancyFormatter" $ do+-- > it "can format text in a way that everyone likes" $+-- > pending+pending :: Expectation+pending = E.throwIO (Pending Nothing)++-- | Specifies a pending example with a reason for why it's pending.+--+-- > describe "fancyFormatter" $ do+-- > it "can format text in a way that everyone likes" $+-- > pendingWith "waiting for clarification from the designers"+pendingWith :: String -> Expectation+pendingWith = E.throwIO . Pending . Just
src/Test/Hspec/Formatters.hs view
@@ -54,6 +54,7 @@ import Control.Monad (unless, forM_) import Control.Applicative import qualified Control.Exception as E+import System.IO (hPutStr) -- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make -- sure, that we only use the public API to implement formatters.@@ -90,6 +91,7 @@ headerFormatter = return () , exampleGroupStarted = \_ _ _ -> return () , exampleGroupDone = return ()+, exampleProgress = \_ _ _ -> return () , exampleSucceeded = \_ -> return () , exampleFailed = \_ _ -> return () , examplePending = \_ _ -> return ()@@ -114,6 +116,9 @@ , exampleGroupDone = do newParagraph++, exampleProgress = \h _ (current, total) -> do+ hPutStr h $ "(" ++ show current ++ "/" ++ show total ++ ")\r" , exampleSucceeded = \(nesting, requirement) -> withSuccessColor $ do writeLine $ indentationFor nesting ++ "- " ++ requirement
src/Test/Hspec/Formatters/Internal.hs view
@@ -43,10 +43,11 @@ import Control.Monad.Trans.State hiding (gets, modify) import qualified Control.Monad.IO.Class as IOClass import qualified System.CPUTime as CPUTime-import Data.IORef import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) import Test.Hspec.Util (Path)+import Test.Hspec.Compat+import Test.Hspec.Core.Type (Progress) -- | A lifted version of `Control.Monad.Trans.State.gets` gets :: (FormatterState -> a) -> FormatM a@@ -56,7 +57,7 @@ -- | A lifted version of `Control.Monad.Trans.State.modify` modify :: (FormatterState -> FormatterState) -> FormatM () modify f = FormatM $ do- get >>= IOClass.liftIO . (`modifyIORef` f)+ get >>= IOClass.liftIO . (`modifyIORef'` f) -- | A lifted version of `IOClass.liftIO` --@@ -146,6 +147,11 @@ , exampleGroupStarted :: Int -> [String] -> String -> FormatM () , exampleGroupDone :: FormatM ()++-- | used to notify the progress of the currently evaluated example+--+-- NOTE: This is only called when interactive/color mode.+, exampleProgress :: Handle -> Path -> Progress -> IO () -- | evaluated after each successful example , exampleSucceeded :: Path -> FormatM ()
src/Test/Hspec/Monadic.hs view
@@ -3,7 +3,6 @@ -- * Types Spec , Example-, Pending -- * Defining a spec , describe
− src/Test/Hspec/Pending.hs
@@ -1,34 +0,0 @@-{-# 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
src/Test/Hspec/Runner.hs view
@@ -21,7 +21,6 @@ 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@@ -29,6 +28,8 @@ import Test.Hspec.Formatters import Test.Hspec.Formatters.Internal import Test.Hspec.FailureReport+import System.Console.ANSI (hHideCursor, hShowCursor)+import Test.Hspec.Timer -- | Filter specs by given predicate. --@@ -47,8 +48,8 @@ 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 >> zip [0..] specs `each` go []+runFormatter :: Bool -> Config -> Formatter -> [SpecTree] -> FormatM ()+runFormatter useColor c formatter specs = headerFormatter formatter >> zip [0..] specs `each` go [] where -- like forM_, but respects --fast-fail each :: [a] -> (a -> FormatM ()) -> FormatM ()@@ -59,13 +60,9 @@ unless (configFastFail c && fails /= 0) $ do xs `each` f - silence_- | configVerbose c = id- | otherwise = silence- eval | configDryRun c = \_ -> return (Right Success)- | otherwise = liftIO . safeEvaluate . silence_+ | otherwise = liftIO . safeEvaluate go :: [String] -> (Int, SpecTree) -> FormatM () go rGroups (n, SpecGroup group xs) = do@@ -73,7 +70,8 @@ zip [0..] xs `each` go (group : rGroups) exampleGroupDone formatter go rGroups (_, SpecItem requirement example) = do- result <- eval (example $ configParams c)+ progressHandler <- mkProgressHandler+ result <- eval (example $ Params (configQuickCheckArgs c) progressHandler) case result of Right Success -> do increaseSuccessCount@@ -92,6 +90,14 @@ addFailMessage path err exampleFailed formatter path err + mkProgressHandler+ | useColor = do+ timer <- liftIO $ newTimer 0.05+ return $ \p -> do+ f <- timer+ when f $ do+ exampleProgress formatter (configHandle c) path p+ | otherwise = return . const $ return () -- | Run given spec and write a report to `stdout`. -- Exit with `exitFailure` if at least one spec item fails.@@ -123,9 +129,11 @@ h = configHandle c useColor <- doesUseColor h c+ when useColor (hHideCursor h) runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) h $ do- runFormatter c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_`+ runFormatter useColor c formatter (maybe id filterSpecs (configFilterPredicate c) $ runSpecM spec) `finally_` do failedFormatter formatter+ liftIO $ when useColor (hShowCursor h) footerFormatter formatter
+ src/Test/Hspec/Timer.hs view
@@ -0,0 +1,14 @@+module Test.Hspec.Timer where++import Data.IORef+import Data.Time.Clock.POSIX++newTimer :: POSIXTime -> IO (IO Bool)+newTimer delay = do+ ref <- getPOSIXTime >>= newIORef+ return $ do+ t0 <- readIORef ref+ t1 <- getPOSIXTime+ if delay < t1 - t0+ then writeIORef ref t1 >> return True+ else return False
src/Test/Hspec/Util.hs view
@@ -7,6 +7,7 @@ , formatRequirement , readMaybe , getEnv+, strip ) where import Data.List@@ -94,3 +95,6 @@ if length r <= n then go (r, ys) else s : go (y, ys)++strip :: String -> String+strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse