{-# LANGUAGE DeriveDataTypeable, CPP #-}
module Test.Hspec (
SpecM
, Spec
, describe
, context
, it
, Expectation
, expect
, shouldBe
, shouldReturn
, hspec
#ifdef TEST
, evaluateExpectation
, Result (..)
#endif
) where
#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative
import Data.Monoid
#endif
import Control.Monad
import Data.List (intercalate)
import Data.Typeable
import qualified Control.Exception as E
import System.Exit
data SpecM a = SpecM a [SpecTree]
add :: SpecTree -> SpecM ()
add :: SpecTree -> SpecM ()
add SpecTree
s = forall a. a -> [SpecTree] -> SpecM a
SpecM () [SpecTree
s]
instance Functor SpecM where
fmap :: forall a b. (a -> b) -> SpecM a -> SpecM b
fmap = forall a. HasCallStack => a
undefined
instance Applicative SpecM where
pure :: forall a. a -> SpecM a
pure a
a = forall a. a -> [SpecTree] -> SpecM a
SpecM a
a []
<*> :: forall a b. SpecM (a -> b) -> SpecM a -> SpecM b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad SpecM where
return :: forall a. a -> SpecM a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
SpecM a
a [SpecTree]
xs >>= :: forall a b. SpecM a -> (a -> SpecM b) -> SpecM b
>>= a -> SpecM b
f = case a -> SpecM b
f a
a of
SpecM b
b [SpecTree]
ys -> forall a. a -> [SpecTree] -> SpecM a
SpecM b
b ([SpecTree]
xs forall a. [a] -> [a] -> [a]
++ [SpecTree]
ys)
data SpecTree = SpecGroup String Spec
| SpecExample String (IO Result)
data Result = Success | Failure String
deriving (Result -> Result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show)
type Spec = SpecM ()
describe :: String -> Spec -> Spec
describe :: String -> SpecM () -> SpecM ()
describe String
label = SpecTree -> SpecM ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SpecM () -> SpecTree
SpecGroup String
label
context :: String -> Spec -> Spec
context :: String -> SpecM () -> SpecM ()
context = String -> SpecM () -> SpecM ()
describe
it :: String -> Expectation -> Spec
it :: String -> Expectation -> SpecM ()
it String
label = SpecTree -> SpecM ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Result -> SpecTree
SpecExample String
label forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> IO Result
evaluateExpectation
data Summary = Summary Int Int
instance Monoid Summary where
mempty :: Summary
mempty = Int -> Int -> Summary
Summary Int
0 Int
0
#if !MIN_VERSION_base(4,11,0)
(Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2)
#else
instance Semigroup Summary where
(Summary Int
x1 Int
x2) <> :: Summary -> Summary -> Summary
<> (Summary Int
y1 Int
y2) = Int -> Int -> Summary
Summary (Int
x1 forall a. Num a => a -> a -> a
+ Int
y1) (Int
x2 forall a. Num a => a -> a -> a
+ Int
y2)
#endif
runSpec :: Spec -> IO Summary
runSpec :: SpecM () -> IO Summary
runSpec = [String] -> SpecM () -> IO Summary
runForrest []
where
runForrest :: [String] -> Spec -> IO Summary
runForrest :: [String] -> SpecM () -> IO Summary
runForrest [String]
labels (SpecM () [SpecTree]
xs) = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([String] -> SpecTree -> IO Summary
runTree [String]
labels) [SpecTree]
xs
runTree :: [String] -> SpecTree -> IO Summary
runTree :: [String] -> SpecTree -> IO Summary
runTree [String]
labels SpecTree
spec = case SpecTree
spec of
SpecExample String
label IO Result
x -> do
String -> Expectation
putStr forall a b. (a -> b) -> a -> b
$ String
"/" forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [[a]] -> [a]
intercalate String
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse) (String
labelforall a. a -> [a] -> [a]
:[String]
labels) forall a. [a] -> [a] -> [a]
++ String
"/ "
Result
r <- IO Result
x
case Result
r of
Result
Success -> do
String -> Expectation
putStrLn String
"OK"
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Summary
Summary Int
1 Int
0)
Failure String
err -> do
String -> Expectation
putStrLn String
"FAILED"
String -> Expectation
putStrLn String
err
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Summary
Summary Int
1 Int
1)
SpecGroup String
label SpecM ()
xs -> do
[String] -> SpecM () -> IO Summary
runForrest (String
labelforall a. a -> [a] -> [a]
:[String]
labels) SpecM ()
xs
hspec :: Spec -> IO ()
hspec :: SpecM () -> Expectation
hspec SpecM ()
spec = do
Summary Int
total Int
failures <- SpecM () -> IO Summary
runSpec SpecM ()
spec
String -> Expectation
putStrLn (forall a. Show a => a -> String
show Int
total forall a. [a] -> [a] -> [a]
++ String
" example(s), " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
failures forall a. [a] -> [a] -> [a]
++ String
" failure(s)")
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
failures forall a. Eq a => a -> a -> Bool
/= Int
0) forall a. IO a
exitFailure
type Expectation = IO ()
infix 1 `shouldBe`, `shouldReturn`
shouldBe :: (Show a, Eq a) => a -> a -> Expectation
a
actual shouldBe :: forall a. (Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
expected =
String -> Bool -> Expectation
expect (String
"expected: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
expected forall a. [a] -> [a] -> [a]
++ String
"\n but got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
actual) (a
actual forall a. Eq a => a -> a -> Bool
== a
expected)
shouldReturn :: (Show a, Eq a) => IO a -> a -> Expectation
IO a
action shouldReturn :: forall a. (Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` a
expected = IO a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. (Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
expected)
expect :: String -> Bool -> Expectation
expect :: String -> Bool -> Expectation
expect String
label Bool
f
| Bool
f = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = forall e a. Exception e => e -> IO a
E.throwIO (String -> ExpectationFailure
ExpectationFailure String
label)
data ExpectationFailure = ExpectationFailure String
deriving (Int -> ExpectationFailure -> ShowS
[ExpectationFailure] -> ShowS
ExpectationFailure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectationFailure] -> ShowS
$cshowList :: [ExpectationFailure] -> ShowS
show :: ExpectationFailure -> String
$cshow :: ExpectationFailure -> String
showsPrec :: Int -> ExpectationFailure -> ShowS
$cshowsPrec :: Int -> ExpectationFailure -> ShowS
Show, ExpectationFailure -> ExpectationFailure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpectationFailure -> ExpectationFailure -> Bool
$c/= :: ExpectationFailure -> ExpectationFailure -> Bool
== :: ExpectationFailure -> ExpectationFailure -> Bool
$c== :: ExpectationFailure -> ExpectationFailure -> Bool
Eq, Typeable)
instance E.Exception ExpectationFailure
evaluateExpectation :: Expectation -> IO Result
evaluateExpectation :: Expectation -> IO Result
evaluateExpectation Expectation
action = (Expectation
action forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Result
Success)
forall a. IO a -> [Handler a] -> IO a
`E.catches` [
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler forall a b. (a -> b) -> a -> b
$ \AsyncException
e -> forall a e. Exception e => e -> a
E.throw (AsyncException
e :: E.AsyncException)
, forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler forall a b. (a -> b) -> a -> b
$ \(ExpectationFailure String
err) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Result
Failure String
err)
, forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler forall a b. (a -> b) -> a -> b
$ \SomeException
e -> (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Result
Failure) (String
"*** Exception: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SomeException
e :: E.SomeException))
]