diff --git a/Specs.hs b/Specs.hs --- a/Specs.hs +++ b/Specs.hs @@ -1,22 +1,31 @@ module Specs where -import Test.Hspec.Internal +import Test.Hspec +import Test.Hspec.Runner (hHspecWithFormat) +import Test.Hspec.Core (Spec(..),Result(..),quantify,failedCount) +import Test.Hspec.Formatters (specdoc) import Test.Hspec.QuickCheck import Test.Hspec.HUnit () import System.IO +import System.IO.Silently import System.Environment import System.Exit +import Data.List (isPrefixOf) import qualified Test.HUnit as HUnit +toExitCode :: Bool -> ExitCode +toExitCode True = ExitSuccess +toExitCode False = ExitFailure 1 + main :: IO () main = do ar <- getArgs - b <- case ar of + ss <- case ar of ["README"] -> withFile "README" WriteMode (\ h -> hPutStrLn h preable >> hHspec h specs) [filename] -> withFile filename WriteMode (\ h -> hHspec h specs) - _ -> hspecB specs - exitWith $ toExitCode b + _ -> hspec specs + exitWith $ toExitCode (failedCount ss == 0) preable :: String preable = unlines [ @@ -37,12 +46,12 @@ "Step 2, write whatever you are describing", "> myabs n = undefined", "", - "Step 3, watch your examples fail", + "Step 3, watch your examples fail with red text", "> hspec specs", "myabs", - " x returns the original number when given a positive input [1]", - " x returns a positive number when given a negative input [2]", - " x returns zero when given zero [3]", + " x returns the original number when given a positive input FAILED [1]", + " x returns a positive number when given a negative input FAILED [2]", + " x returns zero when given zero FAILED [3]", "", "1) myabs returns the original number when given a positive input FAILED", "Prelude.undefined", @@ -60,7 +69,7 @@ "Step 4, implement your desired behavior", "> myabs n = if n < 0 then negate n else n", "", - "Step 5, watch your examples pass", + "Step 5, watch your examples pass with green text", "> hspec specs", "myabs", " - returns the original number when given a positive input", @@ -76,24 +85,21 @@ "", "Here's the report of hspec's behavior:" ] -specs :: IO [Spec] +specs :: IO Specs specs = do - exampleSpecs <- describe "Example" [ - it "pass" (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))] + let testSpecs = describe "Example" [ + it "pass" (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))] - let report = pureHspec exampleSpecs + (reportContents, exampleSpecs) <- capture $ hHspecWithFormat (specdoc False) stdout testSpecs - -- uncomment the next line to aid in debugging - --mapM_ putStrLn $ ["-- START example specs --"] ++ report ++ ["-- END example specs --"] + let report = lines reportContents - -- the real specs descriptions [ - describe "the \"describe\" function" [ it "takes a description of what the behavior is for" ((=="Example") . name . head $ exampleSpecs), @@ -112,7 +118,7 @@ (True), it "will treat exceptions as failures" - (any (==" x exceptions [3]") report) + (any (==" x exceptions FAILED [3]") report) ], describe "the \"hspec\" function" [ it "displays a header for each thing being described" @@ -120,20 +126,16 @@ it "displays one row for each behavior" (HUnit.assertEqual "" 29 (length report)), - -- 19 = group header + behaviors + blank lines + time + error messsages + pending message + example/failures footer it "displays a '-' for successfull examples" (any (==" - pass") report), it "displays an 'x' for failed examples" - (any (==" x fail 1 [1]") report), + (any (==" x fail 1 FAILED [1]") report), - it "displays a list of failed examples" + it "displays a detailed list of failed examples" (any (=="1) Example fail 1 FAILED") report), - it "displays available details for failed examples" - (any (=="fail message") report), - it "displays a '-' for pending examples" (any (==" - pending") report ), @@ -141,12 +143,12 @@ (any (==" # pending message") report ), it "summarizes the time it takes to finish" - (any (=="Finished in 0.0000 seconds") (pureHspec exampleSpecs)), + (any ("Finished in " `isPrefixOf`) report), it "summarizes the number of examples and failures" - (any (=="6 examples, 4 failures") (pureHspec exampleSpecs)), + (any (=="6 examples, 4 failures") report), - it "outputs to stdout" + it "outputs failed examples in red, pending in yellow, and passing in green" (True) ], describe "Bool as an example" [ @@ -162,14 +164,13 @@ it "will show the failed assertion text if available (e.g. assertBool)" (HUnit.TestCase $ do - innerSpecs <- describe "" [ it "" (HUnit.assertBool "trivial" False)] - let innerReport = pureHspec innerSpecs - HUnit.assertBool "should find assertion text" $ any (=="trivial") innerReport), + (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 - innerSpecs <- describe "" [ it "" (HUnit.assertEqual "trivial" (1::Int) 2)] - let innerReport = pureHspec innerSpecs + (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 HUnit.assertBool "should find ' but got: 2'" $ any (==" but got: 2") innerReport) @@ -180,24 +181,13 @@ it "will show what falsified it" (any (=="0") report) - ], + ], describe "pending as an example" [ it "is specified with the \"pending\" function and an explanation" (pending "message" == Pending "message"), it "accepts a message to display in the report" (any (== " # pending message") report) - ], - describe "hspecB" [ - it "returns true if no examples failed" - (HUnit.TestCase $ do - ss <- describe "" [it "" Success] - HUnit.assertEqual "no errors" True (snd $ pureHspecB ss)), - - it "returns false if any examples failed" - (HUnit.TestCase $ do - ss <- describe "" [it "" (Fail "test")] - HUnit.assertEqual "one error" False (snd $ pureHspecB ss)) ], describe "quantify (an internal function)" [ it "returns an amount and a word given an amount and word" @@ -212,3 +202,4 @@ it "returns a plural word given the number 0" (quantify (0::Int) "thing" == "0 things") ]] + diff --git a/hspec.cabal b/hspec.cabal --- a/hspec.cabal +++ b/hspec.cabal @@ -1,5 +1,5 @@ name: hspec -version: 0.3.0 +version: 0.4.3 cabal-version: -any build-type: Custom license: BSD3 @@ -7,11 +7,12 @@ copyright: (c) 2011 Trystan Spangler maintainer: trystan.s@comcast.net build-depends: HUnit >=1 && <=2, QuickCheck >=2.4.0.1 && <=2.5, - base >=4 && <=5 + base >=4 && <=5, silently == 1.1.1, + ansi-terminal == 0.5.5, transformers >= 0.2.0 && < 0.3.0 stability: experimental homepage: https://github.com/trystan/hspec package-url: https://github.com/trystan/hspec -bug-reports: mailto:trystan.s@comcast.net +bug-reports: https://github.com/trystan/hspec/issues synopsis: Behavior Driven Development for Haskell description: Behavior Driven Development for Haskell . @@ -22,10 +23,13 @@ data-files: data-dir: "" extra-source-files: ./Specs.hs ./src/Test/Hspec/HUnit.hs - ./src/Test/Hspec/Internal.hs ./src/Test/Hspec/QuickCheck.hs + ./src/Test/Hspec/Runner.hs ./src/Test/Hspec/Monadic.hs + ./src/Test/Hspec/Formatters.hs + ./src/Test/Hspec/Core.hs ./src/Test/Hspec/QuickCheck.hs extra-tmp-files: -exposed-modules: Test.Hspec Test.Hspec.HUnit Test.Hspec.Internal - Test.Hspec.QuickCheck +exposed-modules: Test.Hspec Test.Hspec.HUnit Test.Hspec.Core + Test.Hspec.Runner Test.Hspec.Monadic + Test.Hspec.Formatters Test.Hspec.QuickCheck exposed: True buildable: True build-tools: diff --git a/src/Test/Hspec.hs b/src/Test/Hspec.hs --- a/src/Test/Hspec.hs +++ b/src/Test/Hspec.hs @@ -73,11 +73,13 @@ -- module Test.Hspec ( -- types - Spec(), Result(), + Spec(), Result(),Specs, -- the main api describe, it, hspec, pending, descriptions, -- alternate "runner" functions - hHspec, hspecX, hspecB, pureHspec, pureHspecB + hHspec ) where -import Test.Hspec.Internal +import Test.Hspec.Core +import Test.Hspec.Runner + diff --git a/src/Test/Hspec/Core.hs b/src/Test/Hspec/Core.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Core.hs @@ -0,0 +1,108 @@ +{-# OPTIONS -XFlexibleInstances #-} + +-- | This module contains the core types, constructors, classes, +-- instances, and utility functions common to hspec. +-- +module Test.Hspec.Core where + +import System.IO +import System.IO.Silently +import Control.Exception +import Control.Monad (liftM) + +-- | The result of running an example. +data Result = Success | Fail String | Pending String + deriving Eq + +-- | Everything needed to specify and show a specific behavior. +data Spec = Spec { + -- | What is being tested, usually the name of a type. + name::String, + -- | The specific behavior being tested. + requirement::String, + -- | The status of this behavior. + result::Result } + +data Formatter = Formatter { 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 () } + + +-- | Create a set of specifications for a specific type being described. +-- Once you know what you want specs for, use this. +-- +-- > describe "abs" [ +-- > it "returns a positive number given a negative number" +-- > (abs (-1) == 1) +-- > ] +-- +describe :: String -- ^ The name of what is being described, usually a function or type. + -> [IO (String, Result)] -- ^ A list of behaviors and examples, created by a list of 'it'. + -> IO [IO Spec] +describe n = return . map (>>= \ (req, res) -> return (Spec n req res)) + +-- | Combine a list of descriptions. +descriptions :: [IO [IO Spec]] -> IO [IO Spec] +descriptions = liftM concat . sequence + +-- | Evaluate a Result. Any exceptions (undefined, etc.) are treated as failures. +safely :: Result -> IO Result +safely f = Control.Exception.catch ok failed + where ok = silence $ f `seq` return f + failed e = return $ Fail (show (e :: SomeException)) + +-- | Anything that can be used as an example of a behavior. +class SpecVerifier a where + -- | Create a description and example of a behavior, a list of these + -- is used by 'describe'. Once you know what you want to specify, use this. + -- + -- > describe "closeEnough" [ + -- > it "is true if two numbers are almost the same" + -- > (1.001 `closeEnough` 1.002), + -- > + -- > it "is false if two numbers are not almost the same" + -- > (not $ 1.001 `closeEnough` 1.003) + -- > ] + -- + it :: String -- ^ A description of this behavior. + -> a -- ^ An example for this behavior. + -> IO (String, Result) + +instance SpecVerifier Bool where + it description example = do + r <- safely (if example then Success else Fail "") + return (description, r) + +instance SpecVerifier Result where + it description example = do + r <- safely example + return (description, r) + +-- | Declare an example as not successful or failing but pending some other work. +-- If you want to report on a behavior but don't have an example yet, use this. +-- +-- > describe "fancyFormatter" [ +-- > it "can format text in a way that everyone likes" +-- > (pending "waiting for clarification from the designers") +-- > ] +-- +pending :: String -- ^ An explanation for why this behavior is pending. + -> Result +pending = Pending + + + +failedCount :: [Spec] -> Int +failedCount ss = length $ filter (isFailure.result) ss + +isFailure :: Result -> Bool +isFailure (Fail _) = True +isFailure _ = False + +-- | Create a more readable display of a quantity of something. +quantify :: Num a => a -> String -> String +quantify 1 s = "1 " ++ s +quantify n s = show n ++ " " ++ s ++ "s" diff --git a/src/Test/Hspec/Formatters.hs b/src/Test/Hspec/Formatters.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Formatters.hs @@ -0,0 +1,59 @@ +-- | This module contains formaatters that take a set of specs and write to a given handle. +-- They follow a structure similar to RSpec formatters. +-- +module Test.Hspec.Formatters ( + specdoc +) where + +import Test.Hspec.Core +import System.IO +import Data.List (intersperse) +import Text.Printf +import Control.Monad (when) +import System.Console.ANSI + +specdoc :: Bool -> Formatter +specdoc useColor = Formatter { + exampleGroupStarted = \ h spec -> do + when useColor (normalColor h) + hPutStr h ('\n' : name spec ++ "\n"), + + examplePassed = \ h spec _ -> do + when useColor (passColor h) + hPutStrLn h $ " - " ++ requirement spec, + + exampleFailed = \ h spec errors -> do + when useColor (failColor h) + hPutStrLn h $ " x " ++ requirement spec ++ " FAILED [" ++ (show $ (length errors) + 1) ++ "]", + + examplePending = \ h spec _ -> do + when useColor (pendingColor h) + let (Pending s) = result spec + hPutStrLn h $ " - " ++ requirement spec ++ "\n # " ++ s, + + errorsFormatter = \ h errors -> do + when useColor (failColor h) + mapM_ (hPutStrLn h) ("" : intersperse "" errors) + when (not $ null errors) (hPutStrLn h ""), + + 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 (normalColor h) + } + + +failColor :: Handle -> IO() +failColor h = hSetSGR h [ SetColor Foreground Dull Red ] + +passColor :: Handle -> IO() +passColor h = hSetSGR h [ SetColor Foreground Dull Green ] + +pendingColor :: Handle -> IO() +pendingColor h = hSetSGR h [ SetColor Foreground Dull Yellow ] + +normalColor :: Handle -> IO() +normalColor h = hSetSGR h [ Reset ] diff --git a/src/Test/Hspec/HUnit.hs b/src/Test/Hspec/HUnit.hs --- a/src/Test/Hspec/HUnit.hs +++ b/src/Test/Hspec/HUnit.hs @@ -16,7 +16,8 @@ module Test.Hspec.HUnit ( ) where -import Test.Hspec.Internal +import System.IO.Silently +import Test.Hspec.Core import qualified Test.HUnit as HU import Data.List (intersperse) @@ -25,10 +26,11 @@ instance SpecVerifier HU.Test where it description example = do - (counts, fails) <- HU.runTestText HU.putTextToShowS example - if HU.errors counts + HU.failures counts == 0 - then return (description, Success) - else return (description, Fail (details $ fails "")) + (counts, fails) <- silence $ HU.runTestText HU.putTextToShowS example + let r' = if HU.errors counts + HU.failures counts == 0 + then Success + else Fail (details $ fails "") + return (description, r') details :: String -> String details = concat . intersperse "\n" . tail . init . lines diff --git a/src/Test/Hspec/Internal.hs b/src/Test/Hspec/Internal.hs deleted file mode 100644 --- a/src/Test/Hspec/Internal.hs +++ /dev/null @@ -1,190 +0,0 @@ -{-# OPTIONS -XFlexibleInstances #-} - -module Test.Hspec.Internal where - -import System.IO -import System.Exit -import Data.List (mapAccumL, groupBy, intersperse) -import System.CPUTime (getCPUTime) -import Text.Printf -import Control.Exception -import Control.Monad (liftM) - --- | The result of running an example. -data Result = Success | Fail String | Pending String - deriving Eq - - --- | Everything needed to specify and show a specific behavior. -data Spec = Spec { - -- | What is being tested, usually the name of a type. - name::String, - -- | The specific behavior being tested. - requirement::String, - -- | The status of this behavior. - result::Result } - - --- | Create a set of specifications for a specific type being described. --- Once you know what you want specs for, use this. --- --- > describe "abs" [ --- > it "returns a positive number given a negative number" --- > (abs (-1) == 1) --- > ] --- -describe :: String -- ^ The name of what is being described, usually a function or type. - -> [IO (String, Result)] -- ^ A list of behaviors and examples, created by a list of 'it'. - -> IO [Spec] -describe n ss = do - ss' <- sequence ss - return $ map (\ (req, res) -> Spec n req res) ss' - --- | Combine a list of descriptions. -descriptions :: [IO [Spec]] -> IO [Spec] -descriptions = liftM concat . sequence - --- | Evaluate a Result. Any exceptions (undefined, etc.) are treated as failures. -safely :: Result -> IO Result -safely f = Control.Exception.catch ok failed - where ok = f `seq` return f - failed e = return $ Fail (show (e :: SomeException)) - - --- | Anything that can be used as an example of a behavior. -class SpecVerifier a where - -- | Create a description and example of a behavior, a list of these - -- is used by 'describe'. Once you know what you want to specify, use this. - -- - -- > describe "closeEnough" [ - -- > it "is true if two numbers are almost the same" - -- > (1.001 `closeEnough` 1.002), - -- > - -- > it "is false if two numbers are not almost the same" - -- > (not $ 1.001 `closeEnough` 1.003) - -- > ] - -- - it :: String -- ^ A description of this behavior. - -> a -- ^ An example for this behavior. - -> IO (String, Result) - - -instance SpecVerifier Bool where - it description example = do - r <- safely (if example then Success else Fail "") - return (description, r) - -instance SpecVerifier Result where - it description example = return (description, example) - - --- | Declare an example as not successful or failing but pending some other work. --- If you want to report on a behavior but don't have an example yet, use this. --- --- > describe "fancyFormatter" [ --- > it "can format text in a way that everyone likes" --- > (pending "waiting for clarification from the designers") --- > ] --- -pending :: String -- ^ An explanation for why this behavior is pending. - -> Result -pending = Pending - - --- | Create a document of the given specs. -documentSpecs :: [Spec] -> [String] -documentSpecs specs = lines $ unlines $ concat report ++ [""] ++ intersperse "" errors - where organize = groupBy (\ a b -> name a == name b) - (errors, report) = mapAccumL documentGroup [] $ organize specs - --- | Create a document of the given group of specs. -documentGroup :: [String] -> [Spec] -> ([String], [String]) -documentGroup errors specGroup = (errors', "" : name (head specGroup) : report) - where (errors', report) = mapAccumL documentSpec errors specGroup - --- | Create a document of the given spec. -documentSpec :: [String] -> Spec -> ([String], String) -documentSpec errors spec = case result spec of - Success -> (errors, " - " ++ requirement spec) - Fail s -> (errors ++ [errorDetails s], " x " ++ requirement spec ++ errorTag) - Pending s -> (errors, " - " ++ requirement spec ++ "\n # " ++ s) - where errorTag = " [" ++ (show $ length errors + 1) ++ "]" - errorDetails s = concat [ show (length errors + 1), ") ", name spec, - " ", requirement spec, " FAILED", - if null s then "" else "\n" ++ s ] - - --- | Create a summary of how long it took to run the examples. -timingSummary :: Double -> String -timingSummary t = printf "Finished in %1.4f seconds" (t / (10.0^(12::Integer)) :: Double) - -failedCount :: [Spec] -> Int -failedCount ss = length $ filter (isFailure.result) ss - where - isFailure (Fail _) = True - isFailure _ = False - --- | Create a summary of how many specs exist and how many examples failed. -successSummary :: [Spec] -> String -successSummary ss = quantify (length ss) "example" ++ ", " ++ quantify (failedCount ss) "failure" - - --- | Create a document of the given specs. --- This does not track how much time it took to check the examples. If you want --- a description of each spec and don't need to know how long it tacks to check, --- use this. -pureHspec :: [Spec] -- ^ The specs you are interested in. - -> [String] -pureHspec = fst . pureHspecB - - -pureHspecB :: [Spec] -- ^ The specs you are interested in. - -> ([String], Bool) -pureHspecB ss = (report, failedCount ss == 0) - where report = documentSpecs ss ++ [ "", timingSummary 0, "", successSummary ss] - - --- | Create a document of the given specs and write it to stdout. --- This does track how much time it took to check the examples. Use this if --- you want a description of each spec and do need to know how long it tacks --- to check the examples or want to write to stdout. -hspec :: IO [Spec] -> IO () -hspec ss = hspecB ss >> return () - --- | Same as 'hspec' except it returns a bool indicating if all examples ran without failures -hspecB :: IO [Spec] -> IO Bool -hspecB = hHspec stdout - --- | Same as 'hspec' except the program exits successfull if all examples ran without failures or --- with an errorcode of 1 if any examples failed. -hspecX :: IO [Spec] -> IO a -hspecX ss = hspecB ss >>= exitWith . toExitCode - -toExitCode :: Bool -> ExitCode -toExitCode True = ExitSuccess -toExitCode False = ExitFailure 1 - - --- | Create a document of the given specs and write it to the given handle. --- This does track how much time it took to check the examples. Use this if --- you want a description of each spec and do need to know how long it tacks --- to check the examples or want to write to a file or other handle. --- --- > writeReport filename specs = withFile filename WriteMode (\ h -> hHspec h specs) --- -hHspec :: Handle -- ^ A handle for the stream you want to write to. - -> IO [Spec] -- ^ The specs you are interested in. - -> IO Bool -hHspec h ss = do - t0 <- getCPUTime - ss' <- ss - mapM_ (hPutStrLn h) $ documentSpecs ss' - t1 <- getCPUTime - mapM_ (hPutStrLn h) [ "", timingSummary (fromIntegral $ t1 - t0), "", successSummary ss'] - return $ failedCount ss' == 0 - - --- | Create a more readable display of a quantity of something. -quantify :: Num a => a -> String -> String -quantify 1 s = "1 " ++ s -quantify n s = show n ++ " " ++ s ++ "s" diff --git a/src/Test/Hspec/Monadic.hs b/src/Test/Hspec/Monadic.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Monadic.hs @@ -0,0 +1,104 @@ + +-- | This module contains the runners that take a set of specs, specified in a monadic style, evaluate their examples, and +-- report to a given handle. +-- +-- The three functions you'll use the most are 'hspec', 'describe', and 'it'. Here is an +-- example of functions that format and unformat phone numbers and the specs for them. +-- +-- > import Test.Hspec +-- > import Test.Hspec.QuickCheck +-- > import Test.Hspec.HUnit +-- > import Test.QuickCheck hiding (property) +-- > import Test.HUnit +-- > +-- > main = hspec mySpecs +-- +-- Since the specs are often used to tell you what to implement, it's best to start with +-- undefined functions. Once we have some specs, then you can implement each behavior +-- one at a time, ensuring that each behavior is met and there is no undocumented behavior. +-- +-- > unformatPhoneNumber :: String -> String +-- > unformatPhoneNumber number = undefined +-- > +-- > formatPhoneNumber :: String -> String +-- > formatPhoneNumber number = undefined +-- +-- The "describe" function takes a list of behaviors and examples bound together with the "it" function +-- +-- > mySpecs = describe "unformatPhoneNumber" $ do +-- +-- A boolean expression can act as a behavior's example. +-- +-- > it "removes dashes, spaces, and parenthesies" +-- > (unformatPhoneNumber "(555) 555-1234" == "5555551234") +-- +-- The "pending" function marks a behavior as pending an example. The example doesn't count as failing. +-- +-- > it "handles non-US phone numbers" +-- > (pending "need to look up how other cultures format phone numbers") +-- +-- An HUnit "Test" 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) +-- +-- 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) +-- +-- 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) +-- > +-- > phoneNumber :: Gen String +-- > phoneNumber = do +-- > nums <- elements [7,10,11,12,13,14,15] +-- > vectorOf nums (elements "0123456789") +-- +module Test.Hspec.Monadic ( + -- types + Spec(), Result(),Specs, + -- the main api + describe, it, hspec, pending, descriptions, + -- alternate "runner" functions + hHspec +) where + +import System.IO +import Test.Hspec.Core hiding (describe,it) +import qualified Test.Hspec.Core as Core +import qualified Test.Hspec.Runner as Runner + +import Control.Monad.Trans.Writer (Writer, execWriter, tell) + +type ItSpec = IO (String, Result) + +type Specs = Writer [IO [IO Spec]] () + +-- | Create a document of the given specs and write it to stdout. +hspec :: Specs -> IO [Spec] +hspec = Runner.hspec . runSpecM + +-- | 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 [Spec] +hHspec h = Runner.hHspec h . runSpecM + +runSpecM :: Specs -> IO [IO Spec] +runSpecM specs = descriptions $ execWriter specs + +describe :: String -> Writer [ItSpec] () -> Specs +describe label action = tell [Core.describe label (execWriter action)] + +it :: SpecVerifier v => String -> v -> Writer [ItSpec] () +it label action = tell [Core.it label action] diff --git a/src/Test/Hspec/QuickCheck.hs b/src/Test/Hspec/QuickCheck.hs --- a/src/Test/Hspec/QuickCheck.hs +++ b/src/Test/Hspec/QuickCheck.hs @@ -16,7 +16,8 @@ property ) where -import Test.Hspec.Internal +import System.IO.Silently +import Test.Hspec.Core import qualified Test.QuickCheck as QC data QuickCheckProperty a = QuickCheckProperty a @@ -26,9 +27,10 @@ instance QC.Testable t => SpecVerifier (QuickCheckProperty t) where it description (QuickCheckProperty prop) = do - r <- QC.quickCheckResult prop - case r of - QC.Success {} -> return (description, Success) - f@(QC.Failure {}) -> return (description, Fail (QC.output f)) - g@(QC.GaveUp {}) -> return (description, Fail ("Gave up after " ++ quantify (QC.numTests g) "test" )) - QC.NoExpectedFailure {} -> return (description, Fail ("No expected failure")) + r <- silence $ QC.quickCheckResult prop + let r' = case r of + QC.Success {} -> Success + f@(QC.Failure {}) -> Fail (QC.output f) + g@(QC.GaveUp {}) -> Fail ("Gave up after " ++ quantify (QC.numTests g) "test" ) + QC.NoExpectedFailure {} -> Fail ("No expected failure") + return (description, r') diff --git a/src/Test/Hspec/Runner.hs b/src/Test/Hspec/Runner.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Runner.hs @@ -0,0 +1,63 @@ + +-- | This module contains the runners that take a set of specs, evaluate their examples, and +-- report to a given handle. +-- +module Test.Hspec.Runner ( + Specs, hspec, hHspec, hHspecWithFormat, describe, it +) where + +import Test.Hspec.Core +import Test.Hspec.Formatters +import System.IO +import System.CPUTime (getCPUTime) +import Control.Monad (when) + +type Specs = [IO Spec] + +-- | Evaluate and print the result of checking the spec examples. +runFormatter :: Formatter -> Handle -> String -> [String] -> Specs -> IO [Spec] +runFormatter formatter h _ errors [] = do + errorsFormatter formatter h (reverse errors) + return [] +runFormatter formatter h group errors (iospec:ioss) = do + spec <- 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 + +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 ] + _ -> "" + + +-- | Create a document of the given specs and write it to stdout. +hspec :: IO Specs -> IO [Spec] +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 -> IO Specs -> IO [Spec] +hHspec h = hHspecWithFormat (specdoc $ h == stdout) h + +-- | Create a document of the given specs and write it to the given handle. +-- THIS IS LIKELY TO CHANGE +hHspecWithFormat :: Formatter -> Handle -> IO Specs -> IO [Spec] +hHspecWithFormat formatter h ss = do + t0 <- getCPUTime + ioSpecList <- ss + specList <- (runFormatter formatter) h "" [] ioSpecList + t1 <- getCPUTime + let runTime = ((fromIntegral $ t1 - t0) / (10.0^(12::Integer)) :: Double) + (footerFormatter formatter) h specList runTime + return specList +