module Test.Hspec.Core.Type (
Spec
, SpecM (..)
, runSpecM
, fromSpecList
, SpecTree (..)
, Example (..)
, Result (..)
, Params (..)
, defaultParams
, describe
, it
) where
import qualified Control.Exception as E
import Control.Applicative
import Control.Monad (when)
import Control.Monad.Trans.Writer (Writer, execWriter, tell)
import Test.Hspec.Util
import Test.Hspec.Expectations
import Test.HUnit.Lang (HUnitFailure(..))
import qualified Test.QuickCheck as QC
type Spec = SpecM ()
newtype SpecM a = SpecM (Writer [SpecTree] a)
deriving (Functor, Applicative, Monad)
runSpecM :: Spec -> [SpecTree]
runSpecM (SpecM specs) = execWriter specs
fromSpecList :: [SpecTree] -> Spec
fromSpecList = SpecM . tell
data Result = Success | Pending (Maybe String) | Fail String
deriving (Eq, Show)
data Params = Params {
paramsQuickCheckArgs :: QC.Args
}
defaultParams :: Params
defaultParams = Params QC.stdArgs
data SpecTree =
SpecGroup String [SpecTree]
| SpecItem String (Params -> IO Result)
describe :: String -> [SpecTree] -> SpecTree
describe = SpecGroup
it :: Example a => String -> a -> SpecTree
it s e = SpecItem s (`evaluateExample` e)
class Example a where
evaluateExample :: Params -> a -> IO Result
instance Example Bool where
evaluateExample _ b = if b then return Success else return (Fail "")
instance Example Expectation where
evaluateExample _ action = (action >> return Success) `E.catch` \(HUnitFailure err) -> return (Fail err)
instance Example Result where
evaluateExample _ r = return r
instance Example QC.Property where
evaluateExample c p = do
r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) p
when (isUserInterrupt r) $ do
E.throwIO E.UserInterrupt
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")
where
isUserInterrupt :: QC.Result -> Bool
isUserInterrupt r = case r of
QC.Failure {QC.reason = "Exception: 'user interrupt'"} -> True
_ -> False