diff --git a/Specs.hs b/Specs.hs --- a/Specs.hs +++ b/Specs.hs @@ -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 diff --git a/Test/Hspec.hs b/Test/Hspec.hs --- a/Test/Hspec.hs +++ b/Test/Hspec.hs @@ -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 diff --git a/Test/Hspec/Core.hs b/Test/Hspec/Core.hs --- a/Test/Hspec/Core.hs +++ b/Test/Hspec/Core.hs @@ -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 diff --git a/Test/Hspec/Formatters.hs b/Test/Hspec/Formatters.hs --- a/Test/Hspec/Formatters.hs +++ b/Test/Hspec/Formatters.hs @@ -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" diff --git a/Test/Hspec/Formatters/Internal.hs b/Test/Hspec/Formatters/Internal.hs new file mode 100644 --- /dev/null +++ b/Test/Hspec/Formatters/Internal.hs @@ -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) diff --git a/Test/Hspec/Monadic.hs b/Test/Hspec/Monadic.hs --- a/Test/Hspec/Monadic.hs +++ b/Test/Hspec/Monadic.hs @@ -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" #-} diff --git a/Test/Hspec/QuickCheck.hs b/Test/Hspec/QuickCheck.hs --- a/Test/Hspec/QuickCheck.hs +++ b/Test/Hspec/QuickCheck.hs @@ -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 diff --git a/Test/Hspec/Runner.hs b/Test/Hspec/Runner.hs --- a/Test/Hspec/Runner.hs +++ b/Test/Hspec/Runner.hs @@ -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 diff --git a/hspec.cabal b/hspec.cabal --- a/hspec.cabal +++ b/hspec.cabal @@ -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