module Test.QuickCheck.Simple
( Property (..), boolTest, qcTest
, Test, TestError (..)
, runTest
, defaultMain', defaultMain
) where
import Control.Applicative ((<$>))
import Control.Monad (when, unless)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import Test.QuickCheck
(Testable, Result (..), quickCheckResult, label)
import qualified Test.QuickCheck as QC
data Property
= Bool Bool
| QuickCheck QC.Property
type Test = (String, Property)
data TestError
= BFalse
| QCError Result
deriving Show
boolTest :: String
-> Bool
-> Test
boolTest n = ((,) n) . Bool
qcTest :: Testable prop
=> String
-> prop
-> Test
qcTest n = ((,) n) . QuickCheck . label n
putErrorLn :: String -> IO ()
putErrorLn = putStrLn . ("*** " <>)
runBool :: String -> Bool -> IO (Maybe TestError)
runBool n = d where
d True = do
putStrLn $ "+++ OK, success (" <> n <> ")"
return Nothing
d False = do
putErrorLn $ "Failed! (" <> n <> ")"
return . Just $ BFalse
runQcProp :: String -> QC.Property -> IO (Maybe TestError)
runQcProp n p = err =<< quickCheckResult p where
err (Success {}) =
return Nothing
err x = do
putErrorLn $ " label: " <> n
return . Just $ QCError x
runProp :: String -> Property -> IO (Maybe TestError)
runProp n = d where
d (Bool b) = runBool n b
d (QuickCheck p) = runQcProp n p
runTest :: Test
-> IO (Maybe TestError)
runTest = uncurry runProp
runPropL :: String -> Property -> IO (Maybe (String, TestError))
runPropL n p = do
me <- runProp n p
return $ fmap ((,) n) me
defaultMain' :: Bool -> [Test] -> IO ()
defaultMain' verbose xs = do
es <- catMaybes <$> mapM (uncurry runPropL) xs
let rlines m r = (m <> ":") : [ " " <> x | x <- lines $ show r ]
when verbose $ mapM_ (\(m, r) -> mapM_ putStrLn $ rlines m r) es
unless (null es) $ fail "Some failures are found."
defaultMain :: [Test] -> IO ()
defaultMain = defaultMain' False