{-# 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 s :: SpecTree
s = () -> [SpecTree] -> SpecM ()
forall a. a -> [SpecTree] -> SpecM a
SpecM () [SpecTree
s]
instance Functor SpecM where
fmap :: (a -> b) -> SpecM a -> SpecM b
fmap = (a -> b) -> SpecM a -> SpecM b
forall a. HasCallStack => a
undefined
instance Applicative SpecM where
pure :: a -> SpecM a
pure a :: a
a = a -> [SpecTree] -> SpecM a
forall a. a -> [SpecTree] -> SpecM a
SpecM a
a []
<*> :: SpecM (a -> b) -> SpecM a -> SpecM 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 :: a -> SpecM a
return = a -> SpecM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
SpecM a :: a
a xs :: [SpecTree]
xs >>= :: SpecM a -> (a -> SpecM b) -> SpecM b
>>= f :: a -> SpecM b
f = case a -> SpecM b
f a
a of
SpecM b :: b
b ys :: [SpecTree]
ys -> b -> [SpecTree] -> SpecM b
forall a. a -> [SpecTree] -> SpecM a
SpecM b
b ([SpecTree]
xs [SpecTree] -> [SpecTree] -> [SpecTree]
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
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
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
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
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 label :: String
label = SpecTree -> SpecM ()
add (SpecTree -> SpecM ())
-> (SpecM () -> SpecTree) -> SpecM () -> SpecM ()
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 label :: String
label = SpecTree -> SpecM ()
add (SpecTree -> SpecM ())
-> (Expectation -> SpecTree) -> Expectation -> SpecM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Result -> SpecTree
SpecExample String
label (IO Result -> SpecTree)
-> (Expectation -> IO Result) -> Expectation -> SpecTree
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 0 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 x1 :: Int
x1 x2 :: Int
x2) <> :: Summary -> Summary -> Summary
<> (Summary y1 :: Int
y1 y2 :: Int
y2) = Int -> Int -> Summary
Summary (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y1) (Int
x2 Int -> Int -> Int
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 labels :: [String]
labels (SpecM () xs :: [SpecTree]
xs) = [Summary] -> Summary
forall a. Monoid a => [a] -> a
mconcat ([Summary] -> Summary) -> IO [Summary] -> IO Summary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SpecTree -> IO Summary) -> [SpecTree] -> IO [Summary]
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 labels :: [String]
labels spec :: SpecTree
spec = case SpecTree
spec of
SpecExample label :: String
label x :: IO Result
x -> do
String -> Expectation
putStr (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$ "/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "/" ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse) (String
labelString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
labels) String -> ShowS
forall a. [a] -> [a] -> [a]
++ "/ "
Result
r <- IO Result
x
case Result
r of
Success -> do
String -> Expectation
putStrLn "OK"
Summary -> IO Summary
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Summary
Summary 1 0)
Failure err :: String
err -> do
String -> Expectation
putStrLn "FAILED"
String -> Expectation
putStrLn String
err
Summary -> IO Summary
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Summary
Summary 1 1)
SpecGroup label :: String
label xs :: SpecM ()
xs -> do
[String] -> SpecM () -> IO Summary
runForrest (String
labelString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
labels) SpecM ()
xs
hspec :: Spec -> IO ()
hspec :: SpecM () -> Expectation
hspec spec :: SpecM ()
spec = do
Summary total :: Int
total failures :: Int
failures <- SpecM () -> IO Summary
runSpec SpecM ()
spec
String -> Expectation
putStrLn (Int -> String
forall a. Show a => a -> String
show Int
total String -> ShowS
forall a. [a] -> [a] -> [a]
++ " example(s), " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
failures String -> ShowS
forall a. [a] -> [a] -> [a]
++ " failure(s)")
Bool -> Expectation -> Expectation
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
failures Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) Expectation
forall a. IO a
exitFailure
type Expectation = IO ()
infix 1 `shouldBe`, `shouldReturn`
shouldBe :: (Show a, Eq a) => a -> a -> Expectation
actual :: a
actual shouldBe :: a -> a -> Expectation
`shouldBe` expected :: a
expected =
String -> Bool -> Expectation
expect ("expected: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n but got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
actual) (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected)
shouldReturn :: (Show a, Eq a) => IO a -> a -> Expectation
action :: IO a
action shouldReturn :: IO a -> a -> Expectation
`shouldReturn` expected :: a
expected = IO a
action IO a -> (a -> Expectation) -> Expectation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> a -> Expectation
forall a. (Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
expected)
expect :: String -> Bool -> Expectation
expect :: String -> Bool -> Expectation
expect label :: String
label f :: Bool
f
| Bool
f = () -> Expectation
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = ExpectationFailure -> Expectation
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
(Int -> ExpectationFailure -> ShowS)
-> (ExpectationFailure -> String)
-> ([ExpectationFailure] -> ShowS)
-> Show ExpectationFailure
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
(ExpectationFailure -> ExpectationFailure -> Bool)
-> (ExpectationFailure -> ExpectationFailure -> Bool)
-> Eq ExpectationFailure
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 action :: Expectation
action = (Expectation
action Expectation -> IO Result -> IO Result
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
Success)
IO Result -> [Handler Result] -> IO Result
forall a. IO a -> [Handler a] -> IO a
`E.catches` [
(AsyncException -> IO Result) -> Handler Result
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler ((AsyncException -> IO Result) -> Handler Result)
-> (AsyncException -> IO Result) -> Handler Result
forall a b. (a -> b) -> a -> b
$ \e :: AsyncException
e -> AsyncException -> IO Result
forall a e. Exception e => e -> a
E.throw (AsyncException
e :: E.AsyncException)
, (ExpectationFailure -> IO Result) -> Handler Result
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler ((ExpectationFailure -> IO Result) -> Handler Result)
-> (ExpectationFailure -> IO Result) -> Handler Result
forall a b. (a -> b) -> a -> b
$ \(ExpectationFailure err :: String
err) -> Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Result
Failure String
err)
, (SomeException -> IO Result) -> Handler Result
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler ((SomeException -> IO Result) -> Handler Result)
-> (SomeException -> IO Result) -> Handler Result
forall a b. (a -> b) -> a -> b
$ \e :: SomeException
e -> (Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> (String -> Result) -> String -> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Result
Failure) ("*** Exception: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: E.SomeException))
]