diff --git a/Test/Hspec.hs b/Test/Hspec.hs deleted file mode 100644 --- a/Test/Hspec.hs +++ /dev/null @@ -1,129 +0,0 @@ -{-# OPTIONS_HADDOCK prune #-} --- | --- Hspec is a Behaviour-Driven Development tool for Haskell programmers. BDD is --- an approach to software development that combines Test-Driven Development, --- Domain Driven Design, and Acceptance Test-Driven Planning. Hspec helps you --- do the TDD part of that equation, focusing on the documentation and design --- aspects of TDD. --- --- Hspec (and the preceding intro) are based on the Ruby library RSpec. Much of --- what applies to RSpec also applies to Hspec. Hspec ties together --- /descriptions/ of behavior and /examples/ of that behavior. The examples can --- also be run as tests and the output summarises what needs to be implemented. --- --- NOTE: There is a monadic and a non-monadic API. This is the documentation --- for the non-monadic API. The monadic API is more stable, so you may prefer --- it over this one. For documentation on the monadic API look at --- "Test.Hspec.Monadic". - -module Test.Hspec {-# WARNING "This module will re-export Test.Hspec.Monadic in the future. Either use Test.Hspec.Core as a drop-in replacement, or migrate your code to the monadic API!" #-} ( - --- * Introduction --- $intro - --- * Types - Spec -, Specs -, Example -, Pending - --- * Defining a spec -, describe -, it -, pending - --- * Running a spec -, hspec -, hspecB -, hHspec -, Summary (..) - - - - - --- deprecated functions -, descriptions -, hspecX - - - -) where - -import Test.Hspec.Core - - - - --- $intro --- --- The three functions you'll use the most are 'hspecX', '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 --- > import Test.HUnit --- > --- > main = hspecX 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" [ --- --- 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.HUnit.Test' can act as a behavior's example. (must import --- "Test.Hspec.HUnit") --- --- > it "removes the \"ext\" prefix of the extension" $ TestCase $ do --- > let expected = "5555551234135" --- > actual = unformatPhoneNumber "(555) 555-1234 ext 135" --- > 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" --- > actual = unformatPhoneNumber "NUMBERS" --- > actual @?= expected --- > , --- --- The 'property' function allows a QuickCheck property to act as an example. --- (must import "Test.Hspec.QuickCheck") --- --- > it "can add and remove formatting without changing the number" $ property $ --- > forAll phoneNumber $ \n -> unformatPhoneNumber (formatPhoneNumber n) == n --- > ]] --- > --- > phoneNumber :: Gen String --- > phoneNumber = do --- > n <- elements [7,10,11,12,13,14,15] --- > vectorOf n (elements "0123456789") diff --git a/Test/Hspec/Core.hs b/Test/Hspec/Core.hs deleted file mode 100644 --- a/Test/Hspec/Core.hs +++ /dev/null @@ -1,144 +0,0 @@ -{-# OPTIONS_HADDOCK prune #-} --- | --- Hspec is a Behaviour-Driven Development tool for Haskell programmers. BDD is --- an approach to software development that combines Test-Driven Development, --- Domain Driven Design, and Acceptance Test-Driven Planning. Hspec helps you --- do the TDD part of that equation, focusing on the documentation and design --- aspects of TDD. --- --- Hspec (and the preceding intro) are based on the Ruby library RSpec. Much of --- what applies to RSpec also applies to Hspec. Hspec ties together --- /descriptions/ of behavior and /examples/ of that behavior. The examples can --- also be run as tests and the output summarises what needs to be implemented. --- --- NOTE: There is a monadic and a non-monadic API. This is the documentation --- for the non-monadic API. The monadic API is more stable, so you may prefer --- it over this one. For documentation on the monadic API look at --- "Test.Hspec.Monadic". - -module Test.Hspec.Core ( - - --- * Introduction --- $intro - --- * Types - Spec -, Specs -, Example (..) -, Pending - --- * Defining a spec -, describe -, it -, pending - --- * Running a spec -, hspec -, hspecB -, hHspec -, Summary (..) - --- * Internals -, quantify -, Result (..) - --- deprecated stuff -, descriptions -, hspecX -, AnyExample -, safeEvaluateExample -, UnevaluatedSpec -) where - -import Test.Hspec.Internal hiding (safeEvaluateExample) -import qualified Test.Hspec.Internal as Internal -import Test.Hspec.Pending -import Test.Hspec.Runner - --- $intro --- --- The three functions you'll use the most are 'hspecX', '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 --- > import Test.HUnit --- > --- > main = hspecX 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" [ --- --- 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.HUnit.Test' can act as a behavior's example. (must import --- "Test.Hspec.HUnit") --- --- > it "removes the \"ext\" prefix of the extension" $ TestCase $ do --- > let expected = "5555551234135" --- > actual = unformatPhoneNumber "(555) 555-1234 ext 135" --- > 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" --- > actual = unformatPhoneNumber "NUMBERS" --- > actual @?= expected --- > , --- --- The 'property' function allows a QuickCheck property to act as an example. --- (must import "Test.Hspec.QuickCheck") --- --- > it "can add and remove formatting without changing the number" $ property $ --- > forAll phoneNumber $ \n -> unformatPhoneNumber (formatPhoneNumber n) == n --- > ]] --- > --- > phoneNumber :: Gen String --- > phoneNumber = do --- > n <- elements [7,10,11,12,13,14,15] --- > vectorOf n (elements "0123456789") - -{-# DEPRECATED UnevaluatedSpec "use Spec instead" #-} -type UnevaluatedSpec = Spec - -{-# DEPRECATED descriptions "this is no longer needed, and will be removed in a future release" #-} -descriptions :: Specs -> Specs -descriptions = id - -{-# DEPRECATED AnyExample "This will be removed with the next major release. If you still need this, raise your voice!" #-} -type AnyExample = IO Result - -{-# DEPRECATED safeEvaluateExample "This will be removed with the next major release. If you still need this, raise your voice!" #-} -safeEvaluateExample :: AnyExample -> IO Result -safeEvaluateExample = Internal.safeEvaluateExample diff --git a/Test/Hspec/Formatters.hs b/Test/Hspec/Formatters.hs deleted file mode 100644 --- a/Test/Hspec/Formatters.hs +++ /dev/null @@ -1,146 +0,0 @@ --- | This module contains formatters that take a set of specs and write to a given handle. --- They follow a structure similar to RSpec formatters. --- -module Test.Hspec.Formatters ( - --- * Formatters - silent -, specdoc -, progress -, failed_examples - --- * Implementing a custom Formatter --- | --- A formatter is a set of actions. Each action is evaluated when a certain --- situation is encountered during a test run. --- --- Actions live in the `FormatM` monad. It provides access to the runner state --- and primitives for appending to the generated report. -, Formatter (..) -, FormatM - --- ** Accessing the runner state -, getSuccessCount -, getPendingCount -, getFailCount -, getTotalCount -, getFailMessages -, getCPUTime -, getRealTime - --- ** Appending to the gerenated report -, write -, writeLine - --- ** Dealing with colors -, withSuccessColor -, withPendingColor -, withFailColor -) where - -import Data.Maybe -import Test.Hspec.Internal (quantify) -import Data.List (intersperse) -import Text.Printf -import Control.Monad (unless) -import Control.Applicative - --- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make --- sure, that we only use the public API to implement formatters. --- --- Everything imported here has to be re-exported, so that users can implement --- their own formatters. -import Test.Hspec.Formatters.Internal ( - Formatter (..) - , FormatM - - , getSuccessCount - , getPendingCount - , getFailCount - , getTotalCount - , getFailMessages - , getCPUTime - , getRealTime - - , write - , writeLine - - , withSuccessColor - , withPendingColor - , withFailColor - ) - - -silent :: Formatter -silent = Formatter { - formatterName = "silent" -, exampleGroupStarted = \_ _ -> return () -, exampleSucceeded = \_ _ -> return () -, exampleFailed = \_ _ _ -> return () -, examplePending = \_ _ _ -> return () -, failedFormatter = return () -, footerFormatter = return () -} - - -specdoc :: Formatter -specdoc = silent { - formatterName = "specdoc" - -, exampleGroupStarted = \nesting name -> do - writeLine ("\n" ++ indentationForGroup nesting ++ name) - -, exampleSucceeded = \nesting requirement -> withSuccessColor $ do - writeLine $ indentationForExample nesting ++ " - " ++ requirement - -, exampleFailed = \nesting requirement _ -> withFailColor $ do - n <- getFailCount - writeLine $ indentationForExample nesting ++ " - " ++ requirement ++ " FAILED [" ++ show n ++ "]" - -, examplePending = \nesting requirement reason -> withPendingColor $ do - writeLine $ indentationForExample nesting ++ " - " ++ requirement ++ "\n # PENDING: " ++ fromMaybe "No reason given" reason - -, failedFormatter = defaultFailedFormatter - -, footerFormatter = defaultFooter -} where - indentationForExample nesting = replicate (pred nesting * 2) ' ' - indentationForGroup nesting = replicate (nesting * 2) ' ' - - -progress :: Formatter -progress = silent { - formatterName = "progress" -, exampleSucceeded = \_ _ -> withSuccessColor $ write "." -, exampleFailed = \_ _ _ -> withFailColor $ write "F" -, examplePending = \_ _ _ -> withPendingColor $ write "." -, failedFormatter = defaultFailedFormatter -, footerFormatter = defaultFooter -} - - -failed_examples :: Formatter -failed_examples = silent { - formatterName = "failed_examples" -, failedFormatter = defaultFailedFormatter -, footerFormatter = defaultFooter -} - - -defaultFailedFormatter :: FormatM () -defaultFailedFormatter = withFailColor $ do - failures <- getFailMessages - mapM_ writeLine ("" : intersperse "" failures) - unless (null failures) (writeLine "") - -defaultFooter :: FormatM () -defaultFooter = do - - writeLine =<< printf "Finished in %1.4f seconds, used %1.4f seconds of CPU time" <$> getRealTime <*> getCPUTime - - fails <- getFailCount - total <- getTotalCount - (if fails == 0 then withSuccessColor else withFailColor) $ do - writeLine "" - write $ quantify total "example" ++ ", " - writeLine $ quantify fails "failure" diff --git a/Test/Hspec/Formatters/Internal.hs b/Test/Hspec/Formatters/Internal.hs deleted file mode 100644 --- a/Test/Hspec/Formatters/Internal.hs +++ /dev/null @@ -1,193 +0,0 @@ -{-# 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.Applicative -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, Applicative, 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 -> Maybe 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/HUnit.hs b/Test/Hspec/HUnit.hs deleted file mode 100644 --- a/Test/Hspec/HUnit.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} -{-# OPTIONS -fno-warn-orphans #-} - --- | --- Importing this module allows you to use an @HUnit@ `HU.Test` as an example --- for a behavior. You can use an explicit `HU.TestCase` data constructor or --- use an `HU.Assertion`. For an @Assertion@, any exception means the example --- failed; otherwise, it's successfull. --- --- NOTE: Any output from the example to @stdout@ is ignored. If you need to --- write out for debugging, you can write to @stderr@ or a file handle. --- --- > import Test.Hspec.Monadic --- > import Test.Hspec.HUnit () --- > import Test.HUnit --- > --- > main :: IO () --- > main = hspecX $ do --- > describe "reverse" $ do --- > it "reverses a list" $ do --- > reverse [1, 2, 3] @?= [3, 2, 1] --- > --- > it "gives the original list, if applied twice" $ TestCase $ --- > (reverse . reverse) [1, 2, 3] @?= [1, 2, 3] --- -module Test.Hspec.HUnit () where - -import System.IO.Silently -import Test.Hspec.Core -import qualified Test.HUnit as HU -import Data.List (intersperse) - -instance Example HU.Assertion where - evaluateExample io = evaluateExample (HU.TestCase io) - -instance Example HU.Test where - evaluateExample test = do - (counts, fails) <- silence $ HU.runTestText HU.putTextToShowS test - let r = if HU.errors counts + HU.failures counts == 0 - then Success - else Fail (details $ fails "") - return r - where - details :: String -> String - details = concat . intersperse "\n" . tail . init . lines diff --git a/Test/Hspec/Internal.hs b/Test/Hspec/Internal.hs deleted file mode 100644 --- a/Test/Hspec/Internal.hs +++ /dev/null @@ -1,86 +0,0 @@ -module Test.Hspec.Internal ( - Spec (..) -, Specs -, Example (..) -, safeEvaluateExample -, Result (..) - -, describe -, it - -, quantify -) -where - -import Control.Exception - --- | A list of specs. -type Specs = [Spec] - --- | The result of running an example. -data Result = Success | Pending (Maybe String) | Fail String - deriving (Eq, Show) - --- | Internal representation of a spec. -data Spec = SpecGroup String [Spec] - | SpecExample String (IO Result) - --- | The @describe@ function combines a list of specs into a larger spec. -describe :: String -> [Spec] -> Spec -describe = SpecGroup - -safeEvaluateExample :: IO Result -> IO Result -safeEvaluateExample action = do - action `catches` [ - -- Re-throw AsyncException, otherwise execution will not terminate on - -- SIGINT (ctrl-c). All AsyncExceptions are re-thrown (not just - -- UserInterrupt) because all of them indicate severe conditions and - -- should not occur during normal test runs. - Handler (\e -> throw (e :: AsyncException)), - - Handler (\e -> return $ Fail (show (e :: SomeException))) - ] - - --- | 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) --- > ] --- -it :: Example a => String -> a -> Spec -it requirement = SpecExample requirement . evaluateExample - --- | A type class for examples. --- --- To use an HUnit `Test.HUnit.Test` or an `Test.HUnit.Assertion` as an example --- you need to import "Test.Hspec.HUnit". --- --- To use a QuickCheck `Test.QuickCheck.Property` as an example you need to --- import "Test.Hspec.QuickCheck". -class Example a where - evaluateExample :: a -> IO Result - -instance Example Bool where - evaluateExample b = if b then return Success else return (Fail "") - -instance Example Result where - evaluateExample r = r `seq` return r - --- | Create a more readable display of a quantity of something. --- --- Examples: --- --- >>> quantify 0 "example" --- "0 examples" --- --- >>> quantify 1 "example" --- "1 example" --- --- >>> quantify 2 "example" --- "2 examples" -quantify :: Int -> String -> String -quantify 1 s = "1 " ++ s -quantify n s = show n ++ " " ++ s ++ "s" diff --git a/Test/Hspec/Monadic.hs b/Test/Hspec/Monadic.hs deleted file mode 100644 --- a/Test/Hspec/Monadic.hs +++ /dev/null @@ -1,204 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# OPTIONS_HADDOCK prune #-} -{-# OPTIONS_GHC -fno-warn-deprecations #-} --- | --- Hspec is a Behaviour-Driven Development tool for Haskell programmers. BDD is --- an approach to software development that combines Test-Driven Development, --- Domain Driven Design, and Acceptance Test-Driven Planning. Hspec helps you --- do the TDD part of that equation, focusing on the documentation and design --- aspects of TDD. --- --- Hspec (and the preceding intro) are based on the Ruby library RSpec. Much of --- what applies to RSpec also applies to Hspec. Hspec ties together --- /descriptions/ of behavior and /examples/ of that behavior. The examples can --- also be run as tests and the output summarises what needs to be implemented. -module Test.Hspec.Monadic ( --- * Introduction --- $intro --- * Types - Spec -, Example -, Pending - --- * Defining a spec -, describe -, context -, it -, pending - --- * Running a spec -, hspec -, hspecB -, hHspec -, Summary (..) - --- * Interface to the non-monadic API -, runSpecM -, fromSpecList - --- deprecated stuff -, Specs -, descriptions -, hspecX -) where - -import System.IO -import Test.Hspec.Core (Example) -import qualified Test.Hspec.Core as Core -import qualified Test.Hspec.Runner as Runner -import Test.Hspec.Runner (Summary (..)) -import Test.Hspec.Pending (Pending) -import qualified Test.Hspec.Pending as Pending - -import Control.Monad.Trans.Writer (Writer, execWriter, tell) - --- $intro --- --- The three functions you'll use the most are 'hspecX', 'describe', and 'it'. --- Here is an example of functions that format and unformat phone numbers and --- the specs for them. --- --- > import Test.Hspec.Monadic --- > import Test.Hspec.QuickCheck --- > import Test.Hspec.HUnit () --- > import Test.QuickCheck --- > import Test.HUnit --- > --- > main = hspecX 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.HUnit.Test' can act as a behavior's example. (must import --- "Test.Hspec.HUnit") --- --- > it "removes the \"ext\" prefix of the extension" $ TestCase $ do --- > let expected = "5555551234135" --- > actual = unformatPhoneNumber "(555) 555-1234 ext 135" --- > 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" --- > actual = unformatPhoneNumber "NUMBERS" --- > actual @?= expected --- --- --- The 'property' function allows a QuickCheck property to act as an example. --- (must import "Test.Hspec.QuickCheck") --- --- > it "can add and remove formatting without changing the number" $ property $ --- > forAll phoneNumber $ \n -> unformatPhoneNumber (formatPhoneNumber n) == n --- > --- > phoneNumber :: Gen String --- > phoneNumber = do --- > n <- elements [7,10,11,12,13,14,15] --- > vectorOf n (elements "0123456789") --- - -type Spec = SpecM () - -newtype SpecM a = SpecM (Writer [Core.Spec] a) - deriving Monad - --- | Create a document of the given spec and write it to stdout. --- --- Exit the program with `exitSuccess` if all examples passed, with --- `exitFailure` otherwise. -hspec :: Spec -> IO () -hspec = Runner.hspec . runSpecM - --- | Create a document of the given spec and write it to stdout. --- --- Return `True` if all examples passed, `False` otherwise. -hspecB :: Spec -> IO Bool -hspecB = Runner.hspecB . 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 -> Spec -> IO Summary -hHspec h = Runner.hHspec h . runSpecM - --- | Convert a monadic spec into a non-monadic spec. -runSpecM :: Spec -> [Core.Spec] -runSpecM (SpecM specs) = execWriter specs - --- | Convert a non-monadic spec into a monadic spec. -fromSpecList :: [Core.Spec] -> Spec -fromSpecList = SpecM . tell - --- | The @describe@ function combines a list of specs into a larger spec. -describe :: String -> Spec -> Spec -describe label action = SpecM . tell $ [Core.describe label (runSpecM action)] - --- | An alias for `describe`. -context :: String -> Spec -> Spec -context = describe - --- | --- Create a set of specifications for a specific type being described. Once --- you know what you want specs for, use this. --- --- > describe "abs" $ do --- > it "returns a positive number given a negative number" $ --- > abs (-1) == 1 -it :: Example v => String -> v -> Spec -it label action = (SpecM . tell) [Core.it label action] - --- | A pending example. --- --- If you want to report on a behavior but don't have an example yet, use this. --- --- > describe "fancyFormatter" $ do --- > it "can format text in a way that everyone likes" $ --- > pending --- --- You can give an optional reason for why it's pending. --- --- > describe "fancyFormatter" $ do --- > it "can format text in a way that everyone likes" $ --- > pending "waiting for clarification from the designers" -pending :: String -> Pending -pending = Pending.pending - -{-# DEPRECATED Specs "use Spec instead" #-} -type Specs = SpecM () - -{-# DEPRECATED descriptions "use sequence_ instead" #-} -descriptions :: [Spec] -> Spec -descriptions = sequence_ - -{-# DEPRECATED hspecX "use hspec instead" #-} -hspecX :: Spec -> IO a -hspecX = Runner.hspecX . runSpecM diff --git a/Test/Hspec/Pending.hs b/Test/Hspec/Pending.hs deleted file mode 100644 --- a/Test/Hspec/Pending.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -module Test.Hspec.Pending where - -import qualified Test.Hspec.Internal as Internal -import Test.Hspec.Internal (Example(..)) - --- NOTE: This is defined in a separate packages, because it clashes with --- Result.Pending. - --- | A pending example. -newtype Pending = Pending (Maybe String) - -instance Example Pending where - evaluateExample (Pending reason) = evaluateExample (Internal.Pending reason) - -instance Example (String -> Pending) where - evaluateExample _ = evaluateExample (Pending Nothing) - --- | A pending example. --- --- 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 --- > ] --- --- You can give an optional reason for why it's pending. --- --- > describe "fancyFormatter" [ --- > it "can format text in a way that everyone likes" $ --- > pending "waiting for clarification from the designers" --- > ] -pending :: String -> Pending -pending = Pending . Just diff --git a/Test/Hspec/QuickCheck.hs b/Test/Hspec/QuickCheck.hs deleted file mode 100644 --- a/Test/Hspec/QuickCheck.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} --- | --- Importing this module allows you to use a QuickCheck `QC.Property` as an --- example for a behavior. Use `QC.property` to turn any `QC.Testable` into a --- @Property@. --- --- NOTE: Any output from the example to @stdout@ is ignored. If you need to --- write out for debugging, you can write to @stderr@ or a file handle. --- --- > import Test.Hspec.Monadic --- > import Test.Hspec.QuickCheck --- > --- > main :: IO () --- > main = hspecX $ do --- > describe "reverse" $ do --- > it "gives the original list, if applied twice" $ property $ --- > \xs -> (reverse . reverse) xs == (xs :: [Int]) --- -module Test.Hspec.QuickCheck ( - QC.property -, prop -) where - -import System.IO.Silently -import Test.Hspec.Core -import qualified Test.QuickCheck as QC - --- just for the prop shortcut -import qualified Test.Hspec.Monadic as DSL - --- | Monadic DSL shortcut, use this instead of `DSL.it`. -prop :: QC.Testable t => String -> t -> DSL.Spec -prop n p = DSL.it n (QC.property p) - -instance Example QC.Property where - evaluateExample p = do - r <- silence $ QC.quickCheckResult p - return $ - case r of - QC.Success {} -> Success - f@(QC.Failure {}) -> Fail (QC.output f) - QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ quantify n "test" ) - QC.NoExpectedFailure {} -> Fail ("No expected failure") diff --git a/Test/Hspec/Runner.hs b/Test/Hspec/Runner.hs deleted file mode 100644 --- a/Test/Hspec/Runner.hs +++ /dev/null @@ -1,113 +0,0 @@ --- | 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 -, hspecB -, hHspec -, hHspecWithFormat -, toExitCode - -, Summary (..) - --- * Deprecated functions -, hspecX -) where - -import Control.Monad (unless, (>=>)) -import Control.Applicative -import Data.Monoid - -import Test.Hspec.Internal -import Test.Hspec.Formatters -import Test.Hspec.Formatters.Internal -import System.IO -import System.Exit - --- | Evaluate and print the result of checking the spec examples. -runFormatter :: Formatter -> Spec -> FormatM () -runFormatter formatter = go 0 [] - where - go :: Int -> [String] -> Spec -> FormatM () - go nesting groups (SpecGroup group xs) = do - exampleGroupStarted formatter nesting group - mapM_ (go (succ nesting) (group : groups)) xs - go nesting groups (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 groups requirement err n - Pending reason -> do - increasePendingCount - examplePending formatter nesting requirement reason - -failureDetails :: [String] -> String -> String -> Int -> String -failureDetails groups requirement err i = - show i ++ ") " ++ groups_ ++ requirement ++ " FAILED" ++ err_ - where - err_ - | null err = "" - | otherwise = "\n" ++ err - groups_ = case groups of - [x] -> x ++ " " - _ -> concatMap (++ " - ") (reverse groups) - - --- | Create a document of the given specs and write it to stdout. --- --- Exit the program with `exitSuccess` if all examples passed, with --- `exitFailure` otherwise. -hspec :: Specs -> IO () -hspec = hspecB >=> (`unless` exitFailure) - -{-# DEPRECATED hspecX "use hspec instead" #-} -hspecX :: Specs -> IO a -hspecX = hspecB >=> exitWith . toExitCode - --- | Create a document of the given specs and write it to stdout. --- --- Return `True` if all examples passed, `False` otherwise. -hspecB :: Specs -> IO Bool -hspecB = fmap success . hHspec stdout - where - success :: Summary -> Bool - success s = summaryFailures s == 0 - --- | 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 Summary -hHspec h specs = do - useColor <- hIsTerminalDevice h - 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 -> Bool -> Handle -> Specs -> IO Summary -hHspecWithFormat formatter useColor h ss = runFormatM useColor h $ do - mapM_ (runFormatter formatter) ss - failedFormatter formatter - footerFormatter formatter - Summary <$> getTotalCount <*> getFailCount - -toExitCode :: Bool -> ExitCode -toExitCode True = ExitSuccess -toExitCode False = ExitFailure 1 - --- | Summary of a test run. -data Summary = Summary { - summaryExamples :: Int -, summaryFailures :: Int -} deriving (Eq, Show) - -instance Monoid Summary where - mempty = Summary 0 0 - (Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2) diff --git a/hspec.cabal b/hspec.cabal --- a/hspec.cabal +++ b/hspec.cabal @@ -1,5 +1,5 @@ name: hspec -version: 1.2.0 +version: 1.2.0.1 license: BSD3 license-file: LICENSE copyright: (c) 2011 Trystan Spangler @@ -29,7 +29,8 @@ Library ghc-options: -Wall - + hs-source-dirs: + src build-depends: base >= 4 && <= 5 , silently >= 1.1.1 && < 2 @@ -38,7 +39,6 @@ , transformers >= 0.2.0 && < 0.4.0 , HUnit >= 1 && <= 2 , QuickCheck >= 2.4.0.1 && <= 2.5 - exposed-modules: Test.Hspec , Test.Hspec.Core @@ -47,7 +47,6 @@ , Test.Hspec.Formatters , Test.Hspec.HUnit , Test.Hspec.QuickCheck - other-modules: Test.Hspec.Pending Test.Hspec.Internal @@ -57,7 +56,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: - ., test + src, test main-is: Spec.hs ghc-options: diff --git a/src/Test/Hspec.hs b/src/Test/Hspec.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec.hs @@ -0,0 +1,129 @@ +{-# OPTIONS_HADDOCK prune #-} +-- | +-- Hspec is a Behaviour-Driven Development tool for Haskell programmers. BDD is +-- an approach to software development that combines Test-Driven Development, +-- Domain Driven Design, and Acceptance Test-Driven Planning. Hspec helps you +-- do the TDD part of that equation, focusing on the documentation and design +-- aspects of TDD. +-- +-- Hspec (and the preceding intro) are based on the Ruby library RSpec. Much of +-- what applies to RSpec also applies to Hspec. Hspec ties together +-- /descriptions/ of behavior and /examples/ of that behavior. The examples can +-- also be run as tests and the output summarises what needs to be implemented. +-- +-- NOTE: There is a monadic and a non-monadic API. This is the documentation +-- for the non-monadic API. The monadic API is more stable, so you may prefer +-- it over this one. For documentation on the monadic API look at +-- "Test.Hspec.Monadic". + +module Test.Hspec {-# WARNING "This module will re-export Test.Hspec.Monadic in the future. Either use Test.Hspec.Core as a drop-in replacement, or migrate your code to the monadic API!" #-} ( + +-- * Introduction +-- $intro + +-- * Types + Spec +, Specs +, Example +, Pending + +-- * Defining a spec +, describe +, it +, pending + +-- * Running a spec +, hspec +, hspecB +, hHspec +, Summary (..) + + + + + +-- deprecated functions +, descriptions +, hspecX + + + +) where + +import Test.Hspec.Core + + + + +-- $intro +-- +-- The three functions you'll use the most are 'hspec', 'describe', and 'it'. +-- Here is an example of functions that format and unformat phone numbers and +-- the specs for them. +-- +-- > import Test.Hspec +-- > import Test.Hspec.QuickCheck +-- > import Test.Hspec.HUnit () +-- > import Test.QuickCheck +-- > 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" [ +-- +-- 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.HUnit.Test' can act as a behavior's example. (must import +-- "Test.Hspec.HUnit") +-- +-- > it "removes the \"ext\" prefix of the extension" $ TestCase $ do +-- > let expected = "5555551234135" +-- > actual = unformatPhoneNumber "(555) 555-1234 ext 135" +-- > 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" +-- > actual = unformatPhoneNumber "NUMBERS" +-- > actual @?= expected +-- > , +-- +-- The 'property' function allows a QuickCheck property to act as an example. +-- (must import "Test.Hspec.QuickCheck") +-- +-- > it "can add and remove formatting without changing the number" $ property $ +-- > forAll phoneNumber $ \n -> unformatPhoneNumber (formatPhoneNumber n) == n +-- > ]] +-- > +-- > phoneNumber :: Gen String +-- > phoneNumber = do +-- > n <- elements [7,10,11,12,13,14,15] +-- > vectorOf n (elements "0123456789") 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,144 @@ +{-# OPTIONS_HADDOCK prune #-} +-- | +-- Hspec is a Behaviour-Driven Development tool for Haskell programmers. BDD is +-- an approach to software development that combines Test-Driven Development, +-- Domain Driven Design, and Acceptance Test-Driven Planning. Hspec helps you +-- do the TDD part of that equation, focusing on the documentation and design +-- aspects of TDD. +-- +-- Hspec (and the preceding intro) are based on the Ruby library RSpec. Much of +-- what applies to RSpec also applies to Hspec. Hspec ties together +-- /descriptions/ of behavior and /examples/ of that behavior. The examples can +-- also be run as tests and the output summarises what needs to be implemented. +-- +-- NOTE: There is a monadic and a non-monadic API. This is the documentation +-- for the non-monadic API. The monadic API is more stable, so you may prefer +-- it over this one. For documentation on the monadic API look at +-- "Test.Hspec.Monadic". + +module Test.Hspec.Core ( + + +-- * Introduction +-- $intro + +-- * Types + Spec +, Specs +, Example (..) +, Pending + +-- * Defining a spec +, describe +, it +, pending + +-- * Running a spec +, hspec +, hspecB +, hHspec +, Summary (..) + +-- * Internals +, quantify +, Result (..) + +-- deprecated stuff +, descriptions +, hspecX +, AnyExample +, safeEvaluateExample +, UnevaluatedSpec +) where + +import Test.Hspec.Internal hiding (safeEvaluateExample) +import qualified Test.Hspec.Internal as Internal +import Test.Hspec.Pending +import Test.Hspec.Runner + +-- $intro +-- +-- The three functions you'll use the most are 'hspec', 'describe', and 'it'. +-- Here is an example of functions that format and unformat phone numbers and +-- the specs for them. +-- +-- > import Test.Hspec +-- > import Test.Hspec.QuickCheck +-- > import Test.Hspec.HUnit () +-- > import Test.QuickCheck +-- > 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" [ +-- +-- 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.HUnit.Test' can act as a behavior's example. (must import +-- "Test.Hspec.HUnit") +-- +-- > it "removes the \"ext\" prefix of the extension" $ TestCase $ do +-- > let expected = "5555551234135" +-- > actual = unformatPhoneNumber "(555) 555-1234 ext 135" +-- > 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" +-- > actual = unformatPhoneNumber "NUMBERS" +-- > actual @?= expected +-- > , +-- +-- The 'property' function allows a QuickCheck property to act as an example. +-- (must import "Test.Hspec.QuickCheck") +-- +-- > it "can add and remove formatting without changing the number" $ property $ +-- > forAll phoneNumber $ \n -> unformatPhoneNumber (formatPhoneNumber n) == n +-- > ]] +-- > +-- > phoneNumber :: Gen String +-- > phoneNumber = do +-- > n <- elements [7,10,11,12,13,14,15] +-- > vectorOf n (elements "0123456789") + +{-# DEPRECATED UnevaluatedSpec "use Spec instead" #-} +type UnevaluatedSpec = Spec + +{-# DEPRECATED descriptions "this is no longer needed, and will be removed in a future release" #-} +descriptions :: Specs -> Specs +descriptions = id + +{-# DEPRECATED AnyExample "This will be removed with the next major release. If you still need this, raise your voice!" #-} +type AnyExample = IO Result + +{-# DEPRECATED safeEvaluateExample "This will be removed with the next major release. If you still need this, raise your voice!" #-} +safeEvaluateExample :: AnyExample -> IO Result +safeEvaluateExample = Internal.safeEvaluateExample 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,146 @@ +-- | This module contains formatters that take a set of specs and write to a given handle. +-- They follow a structure similar to RSpec formatters. +-- +module Test.Hspec.Formatters ( + +-- * Formatters + silent +, specdoc +, progress +, failed_examples + +-- * Implementing a custom Formatter +-- | +-- A formatter is a set of actions. Each action is evaluated when a certain +-- situation is encountered during a test run. +-- +-- Actions live in the `FormatM` monad. It provides access to the runner state +-- and primitives for appending to the generated report. +, Formatter (..) +, FormatM + +-- ** Accessing the runner state +, getSuccessCount +, getPendingCount +, getFailCount +, getTotalCount +, getFailMessages +, getCPUTime +, getRealTime + +-- ** Appending to the gerenated report +, write +, writeLine + +-- ** Dealing with colors +, withSuccessColor +, withPendingColor +, withFailColor +) where + +import Data.Maybe +import Test.Hspec.Internal (quantify) +import Data.List (intersperse) +import Text.Printf +import Control.Monad (unless) +import Control.Applicative + +-- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make +-- sure, that we only use the public API to implement formatters. +-- +-- Everything imported here has to be re-exported, so that users can implement +-- their own formatters. +import Test.Hspec.Formatters.Internal ( + Formatter (..) + , FormatM + + , getSuccessCount + , getPendingCount + , getFailCount + , getTotalCount + , getFailMessages + , getCPUTime + , getRealTime + + , write + , writeLine + + , withSuccessColor + , withPendingColor + , withFailColor + ) + + +silent :: Formatter +silent = Formatter { + formatterName = "silent" +, exampleGroupStarted = \_ _ -> return () +, exampleSucceeded = \_ _ -> return () +, exampleFailed = \_ _ _ -> return () +, examplePending = \_ _ _ -> return () +, failedFormatter = return () +, footerFormatter = return () +} + + +specdoc :: Formatter +specdoc = silent { + formatterName = "specdoc" + +, exampleGroupStarted = \nesting name -> do + writeLine ("\n" ++ indentationForGroup nesting ++ name) + +, exampleSucceeded = \nesting requirement -> withSuccessColor $ do + writeLine $ indentationForExample nesting ++ " - " ++ requirement + +, exampleFailed = \nesting requirement _ -> withFailColor $ do + n <- getFailCount + writeLine $ indentationForExample nesting ++ " - " ++ requirement ++ " FAILED [" ++ show n ++ "]" + +, examplePending = \nesting requirement reason -> withPendingColor $ do + writeLine $ indentationForExample nesting ++ " - " ++ requirement ++ "\n # PENDING: " ++ fromMaybe "No reason given" reason + +, failedFormatter = defaultFailedFormatter + +, footerFormatter = defaultFooter +} where + indentationForExample nesting = replicate (pred nesting * 2) ' ' + indentationForGroup nesting = replicate (nesting * 2) ' ' + + +progress :: Formatter +progress = silent { + formatterName = "progress" +, exampleSucceeded = \_ _ -> withSuccessColor $ write "." +, exampleFailed = \_ _ _ -> withFailColor $ write "F" +, examplePending = \_ _ _ -> withPendingColor $ write "." +, failedFormatter = defaultFailedFormatter +, footerFormatter = defaultFooter +} + + +failed_examples :: Formatter +failed_examples = silent { + formatterName = "failed_examples" +, failedFormatter = defaultFailedFormatter +, footerFormatter = defaultFooter +} + + +defaultFailedFormatter :: FormatM () +defaultFailedFormatter = withFailColor $ do + failures <- getFailMessages + mapM_ writeLine ("" : intersperse "" failures) + unless (null failures) (writeLine "") + +defaultFooter :: FormatM () +defaultFooter = do + + writeLine =<< printf "Finished in %1.4f seconds, used %1.4f seconds of CPU time" <$> getRealTime <*> getCPUTime + + fails <- getFailCount + total <- getTotalCount + (if fails == 0 then withSuccessColor else withFailColor) $ do + writeLine "" + write $ quantify total "example" ++ ", " + writeLine $ quantify fails "failure" diff --git a/src/Test/Hspec/Formatters/Internal.hs b/src/Test/Hspec/Formatters/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Formatters/Internal.hs @@ -0,0 +1,193 @@ +{-# 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.Applicative +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, Applicative, 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 -> Maybe 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/src/Test/Hspec/HUnit.hs b/src/Test/Hspec/HUnit.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/HUnit.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS -fno-warn-orphans #-} + +-- | +-- Importing this module allows you to use an @HUnit@ `HU.Test` as an example +-- for a behavior. You can use an explicit `HU.TestCase` data constructor or +-- use an `HU.Assertion`. For an @Assertion@, any exception means the example +-- failed; otherwise, it's successfull. +-- +-- NOTE: Any output from the example to @stdout@ is ignored. If you need to +-- write out for debugging, you can write to @stderr@ or a file handle. +-- +-- > import Test.Hspec.Monadic +-- > import Test.Hspec.HUnit () +-- > import Test.HUnit +-- > +-- > main :: IO () +-- > main = hspec $ do +-- > describe "reverse" $ do +-- > it "reverses a list" $ do +-- > reverse [1, 2, 3] @?= [3, 2, 1] +-- > +-- > it "gives the original list, if applied twice" $ TestCase $ +-- > (reverse . reverse) [1, 2, 3] @?= [1, 2, 3] +-- +module Test.Hspec.HUnit () where + +import System.IO.Silently +import Test.Hspec.Core +import qualified Test.HUnit as HU +import Data.List (intersperse) + +instance Example HU.Assertion where + evaluateExample io = evaluateExample (HU.TestCase io) + +instance Example HU.Test where + evaluateExample test = do + (counts, fails) <- silence $ HU.runTestText HU.putTextToShowS test + let r = if HU.errors counts + HU.failures counts == 0 + then Success + else Fail (details $ fails "") + return r + where + details :: String -> String + details = concat . intersperse "\n" . tail . init . lines diff --git a/src/Test/Hspec/Internal.hs b/src/Test/Hspec/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Internal.hs @@ -0,0 +1,86 @@ +module Test.Hspec.Internal ( + Spec (..) +, Specs +, Example (..) +, safeEvaluateExample +, Result (..) + +, describe +, it + +, quantify +) +where + +import Control.Exception + +-- | A list of specs. +type Specs = [Spec] + +-- | The result of running an example. +data Result = Success | Pending (Maybe String) | Fail String + deriving (Eq, Show) + +-- | Internal representation of a spec. +data Spec = SpecGroup String [Spec] + | SpecExample String (IO Result) + +-- | The @describe@ function combines a list of specs into a larger spec. +describe :: String -> [Spec] -> Spec +describe = SpecGroup + +safeEvaluateExample :: IO Result -> IO Result +safeEvaluateExample action = do + action `catches` [ + -- Re-throw AsyncException, otherwise execution will not terminate on + -- SIGINT (ctrl-c). All AsyncExceptions are re-thrown (not just + -- UserInterrupt) because all of them indicate severe conditions and + -- should not occur during normal test runs. + Handler (\e -> throw (e :: AsyncException)), + + Handler (\e -> return $ Fail (show (e :: SomeException))) + ] + + +-- | 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) +-- > ] +-- +it :: Example a => String -> a -> Spec +it requirement = SpecExample requirement . evaluateExample + +-- | A type class for examples. +-- +-- To use an HUnit `Test.HUnit.Test` or an `Test.HUnit.Assertion` as an example +-- you need to import "Test.Hspec.HUnit". +-- +-- To use a QuickCheck `Test.QuickCheck.Property` as an example you need to +-- import "Test.Hspec.QuickCheck". +class Example a where + evaluateExample :: a -> IO Result + +instance Example Bool where + evaluateExample b = if b then return Success else return (Fail "") + +instance Example Result where + evaluateExample r = r `seq` return r + +-- | Create a more readable display of a quantity of something. +-- +-- Examples: +-- +-- >>> quantify 0 "example" +-- "0 examples" +-- +-- >>> quantify 1 "example" +-- "1 example" +-- +-- >>> quantify 2 "example" +-- "2 examples" +quantify :: Int -> String -> String +quantify 1 s = "1 " ++ s +quantify n s = show n ++ " " ++ s ++ "s" 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,204 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS_HADDOCK prune #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} +-- | +-- Hspec is a Behaviour-Driven Development tool for Haskell programmers. BDD is +-- an approach to software development that combines Test-Driven Development, +-- Domain Driven Design, and Acceptance Test-Driven Planning. Hspec helps you +-- do the TDD part of that equation, focusing on the documentation and design +-- aspects of TDD. +-- +-- Hspec (and the preceding intro) are based on the Ruby library RSpec. Much of +-- what applies to RSpec also applies to Hspec. Hspec ties together +-- /descriptions/ of behavior and /examples/ of that behavior. The examples can +-- also be run as tests and the output summarises what needs to be implemented. +module Test.Hspec.Monadic ( +-- * Introduction +-- $intro +-- * Types + Spec +, Example +, Pending + +-- * Defining a spec +, describe +, context +, it +, pending + +-- * Running a spec +, hspec +, hspecB +, hHspec +, Summary (..) + +-- * Interface to the non-monadic API +, runSpecM +, fromSpecList + +-- deprecated stuff +, Specs +, descriptions +, hspecX +) where + +import System.IO +import Test.Hspec.Core (Example) +import qualified Test.Hspec.Core as Core +import qualified Test.Hspec.Runner as Runner +import Test.Hspec.Runner (Summary (..)) +import Test.Hspec.Pending (Pending) +import qualified Test.Hspec.Pending as Pending + +import Control.Monad.Trans.Writer (Writer, execWriter, tell) + +-- $intro +-- +-- The three functions you'll use the most are 'hspec', 'describe', and 'it'. +-- Here is an example of functions that format and unformat phone numbers and +-- the specs for them. +-- +-- > import Test.Hspec.Monadic +-- > import Test.Hspec.QuickCheck +-- > import Test.Hspec.HUnit () +-- > import Test.QuickCheck +-- > 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.HUnit.Test' can act as a behavior's example. (must import +-- "Test.Hspec.HUnit") +-- +-- > it "removes the \"ext\" prefix of the extension" $ TestCase $ do +-- > let expected = "5555551234135" +-- > actual = unformatPhoneNumber "(555) 555-1234 ext 135" +-- > 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" +-- > actual = unformatPhoneNumber "NUMBERS" +-- > actual @?= expected +-- +-- +-- The 'property' function allows a QuickCheck property to act as an example. +-- (must import "Test.Hspec.QuickCheck") +-- +-- > it "can add and remove formatting without changing the number" $ property $ +-- > forAll phoneNumber $ \n -> unformatPhoneNumber (formatPhoneNumber n) == n +-- > +-- > phoneNumber :: Gen String +-- > phoneNumber = do +-- > n <- elements [7,10,11,12,13,14,15] +-- > vectorOf n (elements "0123456789") +-- + +type Spec = SpecM () + +newtype SpecM a = SpecM (Writer [Core.Spec] a) + deriving Monad + +-- | Create a document of the given spec and write it to stdout. +-- +-- Exit the program with `exitSuccess` if all examples passed, with +-- `exitFailure` otherwise. +hspec :: Spec -> IO () +hspec = Runner.hspec . runSpecM + +-- | Create a document of the given spec and write it to stdout. +-- +-- Return `True` if all examples passed, `False` otherwise. +hspecB :: Spec -> IO Bool +hspecB = Runner.hspecB . 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 -> Spec -> IO Summary +hHspec h = Runner.hHspec h . runSpecM + +-- | Convert a monadic spec into a non-monadic spec. +runSpecM :: Spec -> [Core.Spec] +runSpecM (SpecM specs) = execWriter specs + +-- | Convert a non-monadic spec into a monadic spec. +fromSpecList :: [Core.Spec] -> Spec +fromSpecList = SpecM . tell + +-- | The @describe@ function combines a list of specs into a larger spec. +describe :: String -> Spec -> Spec +describe label action = SpecM . tell $ [Core.describe label (runSpecM action)] + +-- | An alias for `describe`. +context :: String -> Spec -> Spec +context = describe + +-- | +-- Create a set of specifications for a specific type being described. Once +-- you know what you want specs for, use this. +-- +-- > describe "abs" $ do +-- > it "returns a positive number given a negative number" $ +-- > abs (-1) == 1 +it :: Example v => String -> v -> Spec +it label action = (SpecM . tell) [Core.it label action] + +-- | A pending example. +-- +-- If you want to report on a behavior but don't have an example yet, use this. +-- +-- > describe "fancyFormatter" $ do +-- > it "can format text in a way that everyone likes" $ +-- > pending +-- +-- You can give an optional reason for why it's pending. +-- +-- > describe "fancyFormatter" $ do +-- > it "can format text in a way that everyone likes" $ +-- > pending "waiting for clarification from the designers" +pending :: String -> Pending +pending = Pending.pending + +{-# DEPRECATED Specs "use Spec instead" #-} +type Specs = SpecM () + +{-# DEPRECATED descriptions "use sequence_ instead" #-} +descriptions :: [Spec] -> Spec +descriptions = sequence_ + +{-# DEPRECATED hspecX "use hspec instead" #-} +hspecX :: Spec -> IO a +hspecX = Runner.hspecX . runSpecM diff --git a/src/Test/Hspec/Pending.hs b/src/Test/Hspec/Pending.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Pending.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE FlexibleInstances #-} +module Test.Hspec.Pending where + +import qualified Test.Hspec.Internal as Internal +import Test.Hspec.Internal (Example(..)) + +-- NOTE: This is defined in a separate packages, because it clashes with +-- Result.Pending. + +-- | A pending example. +newtype Pending = Pending (Maybe String) + +instance Example Pending where + evaluateExample (Pending reason) = evaluateExample (Internal.Pending reason) + +instance Example (String -> Pending) where + evaluateExample _ = evaluateExample (Pending Nothing) + +-- | A pending example. +-- +-- 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 +-- > ] +-- +-- You can give an optional reason for why it's pending. +-- +-- > describe "fancyFormatter" [ +-- > it "can format text in a way that everyone likes" $ +-- > pending "waiting for clarification from the designers" +-- > ] +pending :: String -> Pending +pending = Pending . Just diff --git a/src/Test/Hspec/QuickCheck.hs b/src/Test/Hspec/QuickCheck.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/QuickCheck.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | +-- Importing this module allows you to use a QuickCheck `QC.Property` as an +-- example for a behavior. Use `QC.property` to turn any `QC.Testable` into a +-- @Property@. +-- +-- NOTE: Any output from the example to @stdout@ is ignored. If you need to +-- write out for debugging, you can write to @stderr@ or a file handle. +-- +-- > import Test.Hspec.Monadic +-- > import Test.Hspec.QuickCheck +-- > +-- > main :: IO () +-- > main = hspec $ do +-- > describe "reverse" $ do +-- > it "gives the original list, if applied twice" $ property $ +-- > \xs -> (reverse . reverse) xs == (xs :: [Int]) +-- +module Test.Hspec.QuickCheck ( + QC.property +, prop +) where + +import System.IO.Silently +import Test.Hspec.Core +import qualified Test.QuickCheck as QC + +-- just for the prop shortcut +import qualified Test.Hspec.Monadic as DSL + +-- | Monadic DSL shortcut, use this instead of `DSL.it`. +prop :: QC.Testable t => String -> t -> DSL.Spec +prop n p = DSL.it n (QC.property p) + +instance Example QC.Property where + evaluateExample p = do + r <- silence $ QC.quickCheckResult p + return $ + case r of + QC.Success {} -> Success + f@(QC.Failure {}) -> Fail (QC.output f) + QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ quantify n "test" ) + QC.NoExpectedFailure {} -> Fail ("No expected failure") 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,113 @@ +-- | 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 +, hspecB +, hHspec +, hHspecWithFormat +, toExitCode + +, Summary (..) + +-- * Deprecated functions +, hspecX +) where + +import Control.Monad (unless, (>=>)) +import Control.Applicative +import Data.Monoid + +import Test.Hspec.Internal +import Test.Hspec.Formatters +import Test.Hspec.Formatters.Internal +import System.IO +import System.Exit + +-- | Evaluate and print the result of checking the spec examples. +runFormatter :: Formatter -> Spec -> FormatM () +runFormatter formatter = go 0 [] + where + go :: Int -> [String] -> Spec -> FormatM () + go nesting groups (SpecGroup group xs) = do + exampleGroupStarted formatter nesting group + mapM_ (go (succ nesting) (group : groups)) xs + go nesting groups (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 groups requirement err n + Pending reason -> do + increasePendingCount + examplePending formatter nesting requirement reason + +failureDetails :: [String] -> String -> String -> Int -> String +failureDetails groups requirement err i = + show i ++ ") " ++ groups_ ++ requirement ++ " FAILED" ++ err_ + where + err_ + | null err = "" + | otherwise = "\n" ++ err + groups_ = case groups of + [x] -> x ++ " " + _ -> concatMap (++ " - ") (reverse groups) + + +-- | Create a document of the given specs and write it to stdout. +-- +-- Exit the program with `exitSuccess` if all examples passed, with +-- `exitFailure` otherwise. +hspec :: Specs -> IO () +hspec = hspecB >=> (`unless` exitFailure) + +{-# DEPRECATED hspecX "use hspec instead" #-} +hspecX :: Specs -> IO a +hspecX = hspecB >=> exitWith . toExitCode + +-- | Create a document of the given specs and write it to stdout. +-- +-- Return `True` if all examples passed, `False` otherwise. +hspecB :: Specs -> IO Bool +hspecB = fmap success . hHspec stdout + where + success :: Summary -> Bool + success s = summaryFailures s == 0 + +-- | 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 Summary +hHspec h specs = do + useColor <- hIsTerminalDevice h + 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 -> Bool -> Handle -> Specs -> IO Summary +hHspecWithFormat formatter useColor h ss = runFormatM useColor h $ do + mapM_ (runFormatter formatter) ss + failedFormatter formatter + footerFormatter formatter + Summary <$> getTotalCount <*> getFailCount + +toExitCode :: Bool -> ExitCode +toExitCode True = ExitSuccess +toExitCode False = ExitFailure 1 + +-- | Summary of a test run. +data Summary = Summary { + summaryExamples :: Int +, summaryFailures :: Int +} deriving (Eq, Show) + +instance Monoid Summary where + mempty = Summary 0 0 + (Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2) diff --git a/test/doctests.hs b/test/doctests.hs --- a/test/doctests.hs +++ b/test/doctests.hs @@ -3,4 +3,4 @@ import Test.DocTest main :: IO () -main = doctest ["Test/Hspec/Internal.hs"] +main = doctest ["--optghc=-isrc", "src/Test/Hspec/Internal.hs"]