Safe Haskell | Safe-Infered |
---|
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.
- data Spec
- type Specs = [Spec]
- class Example a where
- evaluateExample :: a -> IO Result
- data Pending
- describe :: String -> [Spec] -> Spec
- it :: Example a => String -> a -> Spec
- pending :: String -> Pending
- hspec :: Specs -> IO ()
- hspecB :: Specs -> IO Bool
- hHspec :: Handle -> Specs -> IO Summary
- data Summary = Summary {}
- quantify :: Int -> String -> String
- data Result
Introduction
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 :: IO () main = hspec spec
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
spec = [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
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")
Types
A type class for examples.
evaluateExample :: a -> IO ResultSource
Defining a spec
describe :: String -> [Spec] -> SpecSource
The describe
function combines a list of specs into a larger spec.
it :: Example a => String -> a -> SpecSource
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) ]
pending :: String -> PendingSource
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" ]
Running a spec
Create a document of the given specs and write it to stdout.
Exit the program with exitSuccess
if all examples passed, with
exitFailure
otherwise.
hHspec :: Handle -> Specs -> IO SummarySource
Create a document of the given specs and write it to the given handle.
writeReport filename specs = withFile filename WriteMode (\h -> hHspec h specs)
Summary of a test run.