hspec 0.9.2.2 → 1.0.0
raw patch · 9 files changed
+535/−312 lines, 9 filesdep +timedep ~basedep ~transformers
Dependencies added: time
Dependency ranges changed: base, transformers
Files
- Specs.hs +41/−26
- Test/Hspec.hs +22/−9
- Test/Hspec/Core.hs +26/−51
- Test/Hspec/Formatters.hs +113/−109
- Test/Hspec/Formatters/Internal.hs +192/−0
- Test/Hspec/Monadic.hs +53/−41
- Test/Hspec/QuickCheck.hs +7/−11
- Test/Hspec/Runner.hs +34/−38
- hspec.cabal +47/−27
Specs.hs view
@@ -1,12 +1,14 @@-+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Specs where import Test.Hspec import Test.Hspec.Runner (hHspecWithFormat, toExitCode)-import Test.Hspec.Core (Spec(..),Result(..),quantify,failedCount)+import Test.Hspec.Core (Spec(..), Result(..), quantify, failedCount, evaluateExample) import Test.Hspec.Formatters import Test.Hspec.QuickCheck import Test.Hspec.HUnit ()+import Test.HUnit import System.IO import System.IO.Silently import System.Environment@@ -14,6 +16,8 @@ import Data.List (isPrefixOf) import qualified Test.HUnit as HUnit +deriving instance Show Result+ main :: IO () main = do ar <- getArgs@@ -76,7 +80,7 @@ "Step 4, implement your desired behavior", "> myabs n = if n < 0 then negate n else n", "",- "Step 5, watch your examples pass with green text when rerun",+ "Step 5, watch your examples succeed with green text when rerun", "myabs", " - returns the original number when given a positive input", " - returns a positive number when given a negative input",@@ -93,41 +97,52 @@ specs :: IO Specs specs = do- let testSpecs = describe "Example" [- it "pass" (Success),+ let testSpecs = [describe "Example" [+ it "success" (Success), it "fail 1" (Fail "fail message"), it "pending" (Pending "pending message"), it "fail 2" (HUnit.assertEqual "assertEqual test" 1 (2::Int)), it "exceptions" (undefined :: Bool), it "quickcheck" (property $ \ i -> i == (i+1::Integer))]+ ] - (reportContents, exampleSpecs) <- capture $ hHspecWithFormat (specdoc False) stdout testSpecs- (silentReportContents, _) <- capture $ hHspecWithFormat (silent False) stdout testSpecs- (progressReportContents, _) <- capture $ hHspecWithFormat (progress False) stdout testSpecs- (failed_examplesReportContents, _) <- capture $ hHspecWithFormat (failed_examples False) stdout testSpecs+ (reportContents, exampleSpecs) <- capture $ hHspecWithFormat specdoc False stdout testSpecs+ (silentReportContents, _) <- capture $ hHspecWithFormat silent False stdout testSpecs+ (progressReportContents, _) <- capture $ hHspecWithFormat progress False stdout testSpecs+ (failed_examplesReportContents, _) <- capture $ hHspecWithFormat failed_examples False stdout testSpecs let report = lines reportContents - return $ descriptions [+ return [ describe "the \"describe\" function" [- it "takes a description of what the behavior is for"- ((=="Example") . name . head $ exampleSpecs),-- it "groups behaviors for what's being described"- (all ((=="Example").name) exampleSpecs),-+ it "takes a description of what the behavior is for" $+ case exampleSpecs of+ [SpecGroup "Example" _] -> True+ _ -> False+ ,+ it "groups behaviors for what's being described" $+ case exampleSpecs of+ [SpecGroup _ xs] -> length xs == 6+ _ -> False+ , describe "a nested description" [ it "has it's own specs" (True) ] ], describe "the \"it\" function" [- it "takes a description of a desired behavior"- (requirement (Spec "Example" "whatever" Success 0) == "whatever" ),-- it "takes an example of that behavior"- (result (Spec "Example" "whatever" Success 0) == Success),-+ it "takes a description of a desired behavior" $+ case it "whatever" Success of+ SpecExample requirement _ -> requirement == "whatever"+ _ -> False+ ,+ it "takes an example of that behavior" $ do+ case it "whatever" Success of+ SpecExample _ example -> do+ r <- evaluateExample example+ r @?= Success+ SpecGroup _ _ -> assertFailure "unexpected SpecGroup"+ , it "can use a Bool, HUnit Test, QuickCheck property, or \"pending\" as an example" (True), @@ -142,7 +157,7 @@ (HUnit.assertEqual "" 29 (length report)), it "displays a row for each successfull, failed, or pending example"- (any (==" - pass") report && any (==" - fail 1 FAILED [1]") report),+ (any (==" - success") report && any (==" - fail 1 FAILED [1]") report), it "displays a detailed list of failed examples" (any (=="1) Example fail 1 FAILED") report),@@ -156,7 +171,7 @@ it "summarizes the number of examples and failures" (any (=="6 examples, 4 failures") report), - it "outputs failed examples in red, pending in yellow, and passing in green"+ it "outputs failed examples in red, pending in yellow, and successful in green" (True) ], describe "Bool as an example" [@@ -172,12 +187,12 @@ it "will show the failed assertion text if available (e.g. assertBool)" (HUnit.TestCase $ do- (innerReport, _) <- capture $ hspec $ describe "" [ it "" (HUnit.assertBool "trivial" False)]+ (innerReport, _) <- capture $ hspec $ [describe "" [ it "" (HUnit.assertBool "trivial" False)]] HUnit.assertBool "should find assertion text" $ any (=="trivial") (lines innerReport)), it "will show the failed assertion expected and actual values if available (e.g. assertEqual)" (HUnit.TestCase $ do- (innerReportContents, _) <- capture $ hspec $ describe "" [ it "" (HUnit.assertEqual "trivial" (1::Int) 2)]+ (innerReportContents, _) <- capture $ hspec $ [describe "" [ it "" (HUnit.assertEqual "trivial" (1::Int) 2)]] let innerReport = lines innerReportContents HUnit.assertBool "should find assertion text" $ any (=="trivial") innerReport HUnit.assertBool "should find 'expected: 1'" $ any (=="expected: 1") innerReport
Test/Hspec.hs view
@@ -15,7 +15,7 @@ -- > import Test.Hspec -- > import Test.Hspec.QuickCheck -- > import Test.Hspec.HUnit--- > import Test.QuickCheck hiding (property)+-- > import Test.QuickCheck -- > import Test.HUnit -- > -- > main = hspec mySpecs@@ -32,7 +32,7 @@ -- -- The 'describe' function takes a list of behaviors and examples bound together with the 'it' function ----- > mySpecs = describe "unformatPhoneNumber" [+-- > mySpecs = [describe "unformatPhoneNumber" [ -- -- A boolean expression can act as a behavior's example. --@@ -64,7 +64,7 @@ -- > it "can add and remove formatting without changing the number" -- > (property $ forAll phoneNumber $ -- > \ n -> unformatPhoneNumber (formatPhoneNumber n) == n)--- > ]+-- > ]] -- > -- > phoneNumber :: Gen String -- > phoneNumber = do@@ -72,12 +72,25 @@ -- > vectorOf nums (elements "0123456789") -- module Test.Hspec (- -- types- Spec(), Result(),Specs,- -- the main api- describe, it, hspec, hspecB, hspecX, pending, descriptions,- -- alternate "runner" functions- hHspec++ -- * Types+ Spec+ , Result+ , Specs++ -- * Defining a spec+ , describe+ , it+ , pending++ -- * Running a spec+ , hspec+ , hspecB+ , hspecX+ , hHspec++ -- * Deprecated functions+ , descriptions ) where import Test.Hspec.Core
Test/Hspec/Core.hs view
@@ -5,7 +5,6 @@ -- module Test.Hspec.Core where -import System.IO import System.IO.Silently import Control.Exception @@ -14,51 +13,23 @@ deriving Eq --- | Everything needed to specify and show a specific behavior.-data Spec = Spec {- -- | What is being tested, usually the name of a type or use case.- name::String,- -- | A description of the specific behavior being tested.- requirement::String,- -- | The status of the example of this behavior.- result::Result,- -- | The level of nestedness.- depth::Int }- | UnevaluatedSpec {- -- | What is being tested, usually the name of a type or use case.- name::String,- -- | A description of the specific behavior being tested.- requirement::String,- -- | An example of this behavior.- example::AnyExample,- -- | The level of nestedness.- depth::Int }---data Formatter = Formatter { formatterName :: String,- exampleGroupStarted :: Handle -> Spec -> IO (),- examplePassed :: Handle -> Spec -> [String] -> IO (),- exampleFailed :: Handle -> Spec -> [String] -> IO (),- examplePending :: Handle -> Spec -> [String] -> IO (),- errorsFormatter :: Handle -> [String] -> IO (),- footerFormatter :: Handle -> [Spec] -> Double -> IO (),- usesFormatting :: Bool }-+type UnevaluatedSpec = Spec AnyExample+type EvaluatedSpec = Spec Result -describe :: String -> [[Spec]] -> [Spec]-describe label specs = map desc (concat specs)- where desc spec- | null $ name spec = spec { name = label }- | otherwise = spec { depth = depth spec + 1 }+data Spec a = SpecGroup String [Spec a]+ | SpecExample String a --- | Combine a list of descriptions.-descriptions :: [[Spec]] -> [Spec]-descriptions = concat+describe :: String -> [Spec a] -> Spec a+describe = SpecGroup +-- | DEPRECATED: This is no longer needed (it's just an alias for `id` now).+descriptions :: [Spec a] -> [Spec a]+descriptions = id+{-# DEPRECATED descriptions "this is no longer needed, and will be removed in a future release" #-} -evaluateSpec :: Spec -> IO Spec-evaluateSpec (UnevaluatedSpec name' requirement' example' depth') = do- r <- evaluateExample example' `catches` [+safeEvaluateExample :: AnyExample -> IO Result+safeEvaluateExample example' = do+ evaluateExample example' `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@@ -67,8 +38,6 @@ Handler (\e -> return $ Fail (show (e :: SomeException))) ]- return $ Spec name' requirement' r depth'-evaluateSpec spec = return spec -- | Create a set of specifications for a specific type being described.@@ -79,8 +48,8 @@ -- > (abs (-1) == 1) -- > ] ---it :: Example a => String -> a -> [Spec]-it requirement' example' = [UnevaluatedSpec "" requirement' (AnyExample example') 0]+it :: Example a => String -> a -> UnevaluatedSpec+it requirement' example' = SpecExample requirement' (AnyExample example') class Example a where evaluateExample :: a -> IO Result@@ -112,13 +81,19 @@ pending = Pending -failedCount :: [Spec] -> Int-failedCount ss = length $ filter (isFailure.result) ss+failedCount :: [EvaluatedSpec] -> Int+failedCount = sum . map count+ where+ count (SpecGroup _ xs) = sum (map count xs)+ count (SpecExample _ x) = if isFailure x then 1 else 0 -failure :: [Spec] -> Bool-failure = any (isFailure.result)+failure :: [EvaluatedSpec] -> Bool+failure = any p+ where+ p (SpecGroup _ xs) = any p xs+ p (SpecExample _ x) = isFailure x -success :: [Spec] -> Bool+success :: [EvaluatedSpec] -> Bool success = not . failure isFailure :: Result -> Bool
Test/Hspec/Formatters.hs view
@@ -2,139 +2,143 @@ -- They follow a structure similar to RSpec formatters. -- module Test.Hspec.Formatters (- restoreFormat,- silent, specdoc, progress, failed_examples-) where -import Test.Hspec.Core-import System.IO-import Data.List (intersperse)-import Text.Printf-import Control.Monad (when)-import System.Console.ANSI+-- * Formatters+ silent+, specdoc+, progress+, failed_examples -silent :: Bool -> Formatter-silent useColor = Formatter {- formatterName = "silent",- exampleGroupStarted = \ _ _ -> return (),- examplePassed = \ _ _ _ -> return (),- exampleFailed = \ _ _ _ -> return (),- examplePending = \ _ _ _ -> return (),- errorsFormatter = \ _ _ -> return (),- footerFormatter = \ _ _ _ -> return (),- usesFormatting = useColor- }+-- * 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 -indentationFor :: Spec -> String-indentationFor spec = replicate (depth spec * 2) ' '+-- ** Accessing the runner state+, getSuccessCount+, getPendingCount+, getFailCount+, getTotalCount+, getFailMessages+, getCPUTime+, getRealTime -specdoc :: Bool -> Formatter-specdoc useColor = (silent useColor) {- formatterName = "specdoc",+-- ** Appending to the gerenated report+, write+, writeLine - exampleGroupStarted = \ h spec -> do- when useColor (normalColor h)- hPutStrLn h ("\n" ++ indentationFor spec ++ name spec)- when useColor (restoreFormat h),+-- ** Dealing with colors+, withSuccessColor+, withPendingColor+, withFailColor+) where - examplePassed = \ h spec _ -> do- when useColor (passColor h)- hPutStrLn h $ indentationFor spec ++ " - " ++ requirement spec- when useColor (restoreFormat h),+import Test.Hspec.Core (quantify)+import Data.List (intersperse)+import Text.Printf+import Control.Monad (when) - exampleFailed = \ h spec errors -> do- when useColor (failColor h)- hPutStrLn h $ indentationFor spec ++ " - " ++ requirement spec ++ " FAILED [" ++ (show $ (length errors) + 1) ++ "]"- when useColor (restoreFormat h),+-- 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 - examplePending = \ h spec _ -> do- when useColor (pendingColor h)- let (Pending s) = result spec- hPutStrLn h $ indentationFor spec ++ " - " ++ requirement spec ++ "\n # " ++ s- when useColor (restoreFormat h),+ , getSuccessCount+ , getPendingCount+ , getFailCount+ , getTotalCount+ , getFailMessages+ , getCPUTime+ , getRealTime - errorsFormatter = \ h errors -> do- when useColor (failColor h)- mapM_ (hPutStrLn h) ("" : intersperse "" errors)- when (not $ null errors) (hPutStrLn h "")- when useColor (restoreFormat h),+ , write+ , writeLine - footerFormatter = \ h specs time -> do- when useColor (if failedCount specs == 0 then passColor h else failColor h)- hPutStrLn h $ printf "Finished in %1.4f seconds" time- hPutStrLn h ""- hPutStr h $ quantify (length specs) "example" ++ ", "- hPutStrLn h $ quantify (failedCount specs) "failure"- when useColor (restoreFormat h)- }+ , withSuccessColor+ , withPendingColor+ , withFailColor+ ) -progress :: Bool -> Formatter-progress useColor = (silent useColor) {- formatterName = "progress",+silent :: Formatter+silent = Formatter {+ formatterName = "silent"+, exampleGroupStarted = \_ _ -> return ()+, exampleSucceeded = \_ _ -> return ()+, exampleFailed = \_ _ _ -> return ()+, examplePending = \_ _ _ -> return ()+, failedFormatter = return ()+, footerFormatter = return ()+} - examplePassed = \ h _ _ -> do- when useColor (passColor h)- hPutStr h "."- when useColor (restoreFormat h), - exampleFailed = \ h _ _ -> do- when useColor (failColor h)- hPutStr h "F"- when useColor (restoreFormat h),+specdoc :: Formatter+specdoc = silent {+ formatterName = "specdoc" - examplePending = \ h _ _ -> do- when useColor (pendingColor h)- hPutStr h $ "."- when useColor (restoreFormat h),+, exampleGroupStarted = \nesting name -> do+ writeLine ("\n" ++ indentationForGroup nesting ++ name) - errorsFormatter = \ h errors -> do- when useColor (failColor h)- mapM_ (hPutStrLn h) ("" : intersperse "" errors)- when (not $ null errors) (hPutStrLn h "")- when useColor (restoreFormat h),+, exampleSucceeded = \nesting requirement -> withSuccessColor $ do+ writeLine $ indentationForExample nesting ++ " - " ++ requirement - footerFormatter = \ h specs time -> do- when useColor (if failedCount specs == 0 then passColor h else failColor h)- hPutStrLn h $ printf "Finished in %1.4f seconds" time- hPutStrLn h ""- hPutStr h $ quantify (length specs) "example" ++ ", "- hPutStrLn h $ quantify (failedCount specs) "failure"- when useColor (restoreFormat h)- }+, exampleFailed = \nesting requirement _ -> withFailColor $ do+ failed <- getFailCount+ writeLine $ indentationForExample nesting ++ " - " ++ requirement ++ " FAILED [" ++ show failed ++ "]" +, examplePending = \nesting requirement reason -> withPendingColor $ do+ writeLine $ indentationForExample nesting ++ " - " ++ requirement ++ "\n # " ++ reason -failed_examples :: Bool -> Formatter-failed_examples useColor = (silent useColor) {- formatterName = "failed_examples",+, failedFormatter = defaultFailedFormatter - errorsFormatter = \ h errors -> do- when useColor (failColor h)- mapM_ (hPutStrLn h) ("" : intersperse "" errors)- when (not $ null errors) (hPutStrLn h "")- when useColor (restoreFormat h),+, footerFormatter = defaultFooter+} where+ indentationForExample nesting = replicate (pred nesting * 2) ' '+ indentationForGroup nesting = replicate (nesting * 2) ' ' - footerFormatter = \ h specs time -> do- when useColor (if failedCount specs == 0 then passColor h else failColor h)- hPutStrLn h $ printf "Finished in %1.4f seconds" time- hPutStrLn h ""- hPutStr h $ quantify (length specs) "example" ++ ", "- hPutStrLn h $ quantify (failedCount specs) "failure"- when useColor (restoreFormat h)- } +progress :: Formatter+progress = silent {+ formatterName = "progress"+, exampleSucceeded = \_ _ -> withSuccessColor $ write "."+, exampleFailed = \_ _ _ -> withFailColor $ write "F"+, examplePending = \_ _ _ -> withPendingColor $ write "."+, failedFormatter = defaultFailedFormatter+, footerFormatter = defaultFooter+} -failColor :: Handle -> IO()-failColor h = hSetSGR h [ SetColor Foreground Dull Red ] -passColor :: Handle -> IO()-passColor h = hSetSGR h [ SetColor Foreground Dull Green ]+failed_examples :: Formatter+failed_examples = silent {+ formatterName = "failed_examples"+, failedFormatter = defaultFailedFormatter+, footerFormatter = defaultFooter+} -pendingColor :: Handle -> IO()-pendingColor h = hSetSGR h [ SetColor Foreground Dull Yellow ] -normalColor :: Handle -> IO()-normalColor h = hSetSGR h [ Reset ]+defaultFailedFormatter :: FormatM ()+defaultFailedFormatter = withFailColor $ do+ failures <- getFailMessages+ mapM_ writeLine ("" : intersperse "" failures)+ when (not $ null failures) (writeLine "") -restoreFormat :: Handle -> IO()-restoreFormat h = hSetSGR h [ Reset ]+defaultFooter :: FormatM ()+defaultFooter = do+ cpuTime <- getCPUTime+ time <- getRealTime+ fails <- getFailCount+ total <- getTotalCount+ (if fails == 0 then withSuccessColor else withFailColor) $ do+ writeLine $ printf "Finished in %1.4f seconds, used %1.4f seconds of CPU time" time cpuTime+ writeLine ""+ write $ quantify total "example" ++ ", "+ writeLine $ quantify fails "failure"
+ Test/Hspec/Formatters/Internal.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Test.Hspec.Formatters.Internal (++-- * Public API+ Formatter (..)+, FormatM++, getSuccessCount+, getPendingCount+, getFailCount+, getTotalCount+, getFailMessages+, getCPUTime+, getRealTime++, write+, writeLine++, 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)+import Control.Exception (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)++-- | 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+, successCount :: Int+, pendingCount :: Int+, failCount :: Int+, failMessages :: [String]+, cpuStartTime :: 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, Monad)++runFormatM :: Bool -> Handle -> FormatM a -> IO a+runFormatM useColor handle (FormatM action) = do+ time <- getPOSIXTime+ cpuTime <- CPUTime.getCPUTime+ evalStateT action (FormatterState handle useColor 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 :: String -> FormatM ()+addFailMessage err = modify $ \s -> s {failMessages = err : failMessages s}++-- | Get the list of accumulated failure messages.+getFailMessages :: FormatM [String]+getFailMessages = reverse `fmap` gets failMessages++data Formatter = Formatter {+ formatterName :: String++-- | evaluated before each test group+, exampleGroupStarted :: Int -> String -> FormatM ()+-- | evaluated after each successful example+, exampleSucceeded :: Int -> String -> FormatM ()+-- | evaluated after each failed example+, exampleFailed :: Int -> String -> String -> FormatM ()+-- | evaluated after each pending example+, examplePending :: Int -> String -> String -> FormatM ()+-- | evaluated after a test run+, failedFormatter :: FormatM ()+-- | evaluated after `failuresFormatter`+, footerFormatter :: FormatM ()+}++-- | Append some output to the report.+write :: String -> FormatM ()+write s = do+ h <- gets stateHandle+ liftIO $ IO.hPutStr h s++-- | The same as `write`, but adds a newline character.+writeLine :: String -> FormatM ()+writeLine s = do+ h <- gets stateHandle+ liftIO $ IO.hPutStrLn h s++-- | 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)++-- | 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)++-- | 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)++-- | Set a color, run an action, and finally reset colors.+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 Double+getCPUTime = do+ t1 <- liftIO CPUTime.getCPUTime+ t0 <- gets cpuStartTime+ return ((fromIntegral $ t1 - t0) / (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)
Test/Hspec/Monadic.hs view
@@ -8,7 +8,7 @@ -- > import Test.Hspec.Monadic -- > import Test.Hspec.QuickCheck -- > import Test.Hspec.HUnit--- > import Test.QuickCheck hiding (property)+-- > import Test.QuickCheck -- > import Test.HUnit -- > -- > main = hspec mySpecs@@ -29,34 +29,32 @@ -- -- A boolean expression can act as a behavior's example. ----- > it "removes dashes, spaces, and parenthesies"--- > (unformatPhoneNumber "(555) 555-1234" == "5555551234")+-- > 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")+-- > it "handles non-US phone numbers" $+-- > pending "need to look up how other cultures format phone numbers" -- -- An HUnit 'Test' can act as a behavior's example. (must import @Test.Hspec.HUnit@) ----- > it "removes the \"ext\" prefix of the extension"--- > (TestCase $ let expected = "5555551234135"--- > actual = unformatPhoneNumber "(555) 555-1234 ext 135"--- > in assertEqual "remove extension" expected actual)+-- > it "removes the \"ext\" prefix of the extension" $ do+-- > let expected = "5555551234135"+-- > actual = unformatPhoneNumber "(555) 555-1234 ext 135"+-- > assertEqual "remove extension" expected actual -- -- An @IO()@ action is treated like an HUnit 'TestCase'. (must import @Test.Hspec.HUnit@) ----- > it "converts letters to numbers"--- > (do--- > let expected = "6862377"--- > let actual = unformatPhoneNumber "NUMBERS"--- > assertEqual "letters to numbers" expected actual)+-- > it "converts letters to numbers" $ do+-- > let expected = "6862377"+-- > actual = unformatPhoneNumber "NUMBERS"+-- > assertEqual "letters to numbers" expected actual -- -- The 'property' function allows a QuickCheck property to act as an example. (must import @Test.Hspec.HUnit@) ----- > it "can add and remove formatting without changing the number"--- > (property $ forAll phoneNumber $--- > \ n -> unformatPhoneNumber (formatPhoneNumber n) == n)+-- > it "can add and remove formatting without changing the number" $ property $+-- > forAll phoneNumber $ \ n -> unformatPhoneNumber (formatPhoneNumber n) == n -- > -- > phoneNumber :: Gen String -- > phoneNumber = do@@ -65,16 +63,29 @@ -- module Test.Hspec.Monadic (- -- types- Spec(), Result(),Specs,- -- the main api- describe, it, hspec, hspecB, hspecX, pending, descriptions,- -- alternate "runner" functions- hHspec,- -- interface to the non-monadic api- fromSpecList,- -- this is just for internal use- runSpecM++ -- * Types+ Spec+ , Result+ , Specs++ -- * Defining a spec+ , describe+ , it+ , pending++ -- * Running a spec+ , hspec+ , hspecB+ , hspecX+ , hHspec++ -- * Interface to the non-monadic API+ , runSpecM+ , fromSpecList++ -- * Deprecated functions+ , descriptions ) where import System.IO@@ -86,11 +97,11 @@ type Specs = SpecM () -newtype SpecM a = SpecM (Writer [Spec] a)+newtype SpecM a = SpecM (Writer [UnevaluatedSpec] a) deriving Monad -- | Create a document of the given specs and write it to stdout.-hspec :: Specs -> IO [Spec]+hspec :: Specs -> IO [EvaluatedSpec] hspec = Runner.hspec . runSpecM -- | Use in place of @hspec@ to also exit the program with an @ExitCode@@@ -105,23 +116,24 @@ -- -- > writeReport filename specs = withFile filename WriteMode (\ h -> hHspec h specs) ---hHspec :: Handle -> Specs -> IO [Spec]+hHspec :: Handle -> Specs -> IO [EvaluatedSpec] hHspec h = Runner.hHspec h . runSpecM -runSpecM :: Specs -> [Spec]+-- | Convert a monadic spec into a non-monadic spec.+runSpecM :: Specs -> [UnevaluatedSpec] runSpecM (SpecM specs) = execWriter specs -describe :: String -> Specs -> Specs-describe label action = SpecM . tell $ Core.describe label [runSpecM action]+-- | Convert a non-monadic spec into a monadic spec.+fromSpecList :: [UnevaluatedSpec] -> Specs+fromSpecList = SpecM . tell --- | Combine a list of descriptions. (Note that descriptions can also--- be combined with monadic sequencing.)-descriptions :: [Specs] -> Specs-descriptions = sequence_+describe :: String -> Specs -> Specs+describe label action = SpecM . tell $ [Core.describe label (runSpecM action)] it :: Example v => String -> v -> Specs-it label action = SpecM . tell $ Core.it label action+it label action = (SpecM . tell) [Core.it label action] --- | Converts a specs created with 'Test.Hspec.HUnit.describe' into a monadic 'describe'.-fromSpecList :: [Spec] -> Specs-fromSpecList = SpecM . tell+-- | DEPRECATED: Use `sequence_` instead.+descriptions :: [Specs] -> Specs+descriptions = sequence_+{-# DEPRECATED descriptions "use sequence_ instead" #-}
Test/Hspec/QuickCheck.hs view
@@ -1,4 +1,5 @@-+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Importing this module allows you to use a QuickCheck property as an example -- for a behavior. Use the 'property' function to indicate a QuickCkeck property. -- Any output from the example to stdout is ignored. If you need to write out for@@ -15,7 +16,8 @@ -- > ] -- module Test.Hspec.QuickCheck (- property, prop+ QC.property+, prop ) where import System.IO.Silently@@ -25,18 +27,12 @@ -- just for the prop shortcut import qualified Test.Hspec.Monadic as DSL -data QuickCheckProperty a = QuickCheckProperty a--property :: QC.Testable a => a -> QuickCheckProperty a-property = QuickCheckProperty- -- | Monadic DSL shortcut, use this instead of @it@ prop :: QC.Testable t => String -> t -> DSL.Specs-prop n p = DSL.it n (QuickCheckProperty p)-+prop n p = DSL.it n (QC.property p) -instance QC.Testable t => Example (QuickCheckProperty t) where- evaluateExample (QuickCheckProperty p) = do+instance Example QC.Property where+ evaluateExample p = do r <- silence $ QC.quickCheckResult p let r' = case r of QC.Success {} -> Success
Test/Hspec/Runner.hs view
@@ -8,36 +8,37 @@ import Test.Hspec.Core import Test.Hspec.Formatters+import Test.Hspec.Formatters.Internal import System.IO-import System.CPUTime (getCPUTime)-import Control.Monad (when) import System.Exit-import Control.Exception (bracket_) -type Specs = [Spec]+type Specs = [UnevaluatedSpec] -- | Evaluate and print the result of checking the spec examples.-runFormatter :: Formatter -> Handle -> String -> [String] -> Specs -> IO Specs-runFormatter formatter h _ errors [] = do- errorsFormatter formatter h (reverse errors)- return []-runFormatter formatter h group errors (iospec:ioss) = do- spec <- evaluateSpec iospec- when (group /= name spec) (exampleGroupStarted formatter h spec)- case result spec of- (Success ) -> examplePassed formatter h spec errors- (Fail _ ) -> exampleFailed formatter h spec errors- (Pending _) -> examplePending formatter h spec errors- let errors' = if isFailure (result spec)- then errorDetails spec (length errors) : errors- else errors- specs <- runFormatter formatter h (name spec) errors' ioss- return $ spec : specs+runFormatter :: Formatter -> Int -> String -> UnevaluatedSpec -> FormatM EvaluatedSpec+runFormatter formatter nesting _ (SpecGroup group xs) = do+ exampleGroupStarted formatter (nesting) group+ ys <- mapM (runFormatter formatter (succ nesting) group) xs+ return (SpecGroup group ys)+runFormatter formatter nesting group (SpecExample requirement e) = do+ result <- liftIO $ safeEvaluateExample e+ case result of+ Success -> do+ increaseSuccessCount+ exampleSucceeded formatter nesting requirement+ Fail err -> do+ increaseFailCount+ exampleFailed formatter nesting requirement err+ n <- getFailCount+ addFailMessage $ failureDetails group requirement err n+ Pending reason -> do+ increasePendingCount+ examplePending formatter nesting requirement reason+ return (SpecExample requirement result) -errorDetails :: Spec -> Int -> String-errorDetails spec i = case result spec of- (Fail s ) -> concat [ show (i + 1), ") ", name spec, " ", requirement spec, " FAILED", if null s then "" else "\n" ++ s ]- _ -> ""+failureDetails :: String -> String -> String -> Int -> String+failureDetails group requirement err i =+ concat [ show i, ") ", group, " ", requirement, " FAILED", if null err then "" else "\n" ++ err ] -- | Use in place of @hspec@ to also exit the program with an @ExitCode@ hspecX :: Specs -> IO a@@ -48,31 +49,26 @@ hspecB ss = hspec ss >>= return . success -- | Create a document of the given specs and write it to stdout.-hspec :: Specs -> IO [Spec]+hspec :: Specs -> IO [EvaluatedSpec] hspec ss = hHspec stdout ss -- | Create a document of the given specs and write it to the given handle. -- -- > writeReport filename specs = withFile filename WriteMode (\ h -> hHspec h specs) ---hHspec :: Handle -> Specs -> IO Specs+hHspec :: Handle -> Specs -> IO [EvaluatedSpec] hHspec h specs = do useColor <- hIsTerminalDevice h- hHspecWithFormat (specdoc useColor) h specs+ hHspecWithFormat specdoc useColor h specs -- | Create a document of the given specs and write it to the given handle. -- THIS IS LIKELY TO CHANGE-hHspecWithFormat :: Formatter -> Handle -> Specs -> IO Specs-hHspecWithFormat formatter h ss =- bracket_ (when (usesFormatting formatter) $ restoreFormat h)- (when (usesFormatting formatter) $ restoreFormat h)- (do- t0 <- getCPUTime- specList <- runFormatter formatter h "" [] ss- t1 <- getCPUTime- let runTime = ((fromIntegral $ t1 - t0) / (10.0^(12::Integer)) :: Double)- (footerFormatter formatter) h specList runTime- return specList)+hHspecWithFormat :: Formatter -> Bool -> Handle -> Specs -> IO [EvaluatedSpec]+hHspecWithFormat formatter useColor h ss = runFormatM useColor h $ do+ specList <- mapM (runFormatter formatter 0 "") ss+ failedFormatter formatter+ footerFormatter formatter+ return specList toExitCode :: Bool -> ExitCode toExitCode True = ExitSuccess
hspec.cabal view
@@ -1,5 +1,5 @@ name: hspec-version: 0.9.2.2+version: 1.0.0 cabal-version: >= 1.8 build-type: Simple license: BSD3@@ -11,40 +11,60 @@ stability: experimental bug-reports: https://github.com/hspec/hspec/issues synopsis: Behavior Driven Development for Haskell-description: Behavior Driven Development for Haskell- .- Hspec is roughly based on the Ruby library RSpec. However, Hspec is just a framework for running HUnit and QuickCheck tests. Compared to other options, it provides a much nicer syntax that makes tests very easy to read.+description: Behavior Driven Development for Haskell+ .+ Hspec is roughly based on the Ruby library RSpec. However,+ Hspec is just a framework for running HUnit and QuickCheck+ tests. Compared to other options, it provides a much nicer+ syntax that makes tests very easy to read. source-repository head type: git location: https://github.com/hspec/hspec Library- exposed: True- buildable: True- extensions: FlexibleInstances- ghc-options: -Wall -fno-warn-hi-shadowing+ ghc-options:+ -Wall - build-depends: HUnit >=1 && <=2,- QuickCheck >=2.4.0.1 && <=2.5,- base >=4 && <=5,- silently >= 1.1.1 && < 2,- ansi-terminal == 0.5.5,- transformers >= 0.2.0 && < 0.4+ build-depends:+ base >= 4 && <= 5+ , silently >= 1.1.1 && < 2+ , ansi-terminal == 0.5.5+ , time < 1.5+ , transformers >= 0.2.0 && < 0.4.0+ , HUnit >= 1 && <= 2+ , QuickCheck >= 2.4.0.1 && <= 2.5 - exposed-modules: Test.Hspec Test.Hspec.HUnit Test.Hspec.Core- Test.Hspec.Runner Test.Hspec.Monadic- Test.Hspec.Formatters Test.Hspec.QuickCheck+ exposed-modules:+ Test.Hspec+ , Test.Hspec.Core+ , Test.Hspec.Monadic+ , Test.Hspec.Runner+ , Test.Hspec.Formatters+ , Test.Hspec.HUnit+ , Test.Hspec.QuickCheck + other-modules:+ Test.Hspec.Formatters.Internal+ test-suite spec- type: exitcode-stdio-1.0- main-is: runtests.hs- other-modules: Specs- ghc-options: -Wall -fno-warn-hi-shadowing+ type:+ exitcode-stdio-1.0 - build-depends: HUnit >=1 && <=2,- QuickCheck >=2.4.0.1 && <=2.5,- base >=4 && <=5,- silently >= 1.1.1 && < 2,- ansi-terminal == 0.5.5,- transformers >= 0.2.0 && < 0.4+ main-is:+ runtests.hs++ other-modules:+ Specs++ ghc-options:+ -Wall -Werror++ build-depends:+ base >= 4 && <= 5+ , silently >= 1.1.1 && < 2+ , ansi-terminal == 0.5.5+ , time < 1.5+ , transformers >= 0.2.0 && < 0.4.0+ , HUnit >= 1 && <= 2+ , QuickCheck >= 2.4.0.1 && <= 2.5