module Test.QuickCheck.Simple
( Property (..)
, boolTest', boolTest
, eqTest', eqTest
, qcTest
, Test, TestError (..)
, runTest_, runTest
, defaultMain_, defaultMain, verboseMain
, defaultMain'
) where
import Control.Applicative ((<$>))
import Control.Monad (unless)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import Test.QuickCheck
(Testable, Result (..), quickCheckResult, label)
import qualified Test.QuickCheck as QC
data Property
= Bool (Maybe String ) Bool
| QuickCheck QC.Property
type Test = (String , Property)
mkBoolTest :: String -> Maybe String -> Bool -> Test
mkBoolTest :: String -> Maybe String -> Bool -> Test
mkBoolTest String
n Maybe String
m = ((,) String
n) (Property -> Test) -> (Bool -> Property) -> Bool -> Test
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> Bool -> Property
Bool Maybe String
m
boolTest' :: String
-> String
-> Bool
-> Test
boolTest' :: String -> String -> Bool -> Test
boolTest' String
n String
m = String -> Maybe String -> Bool -> Test
mkBoolTest String
n (String -> Maybe String
forall a. a -> Maybe a
Just String
m)
boolTest :: String
-> Bool
-> Test
boolTest :: String -> Bool -> Test
boolTest String
n = String -> Maybe String -> Bool -> Test
mkBoolTest String
n Maybe String
forall a. Maybe a
Nothing
eqTest' :: (a -> a -> Bool) -> (a -> String) -> String -> a -> a -> Test
eqTest' :: forall a.
(a -> a -> Bool) -> (a -> String) -> String -> a -> a -> Test
eqTest' a -> a -> Bool
eq a -> String
show' String
n a
x a
y = String -> String -> Bool -> Test
boolTest' String
n String
msg (Bool -> Test) -> Bool -> Test
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> Bool
`eq` a
y where
msg :: String
msg = [String] -> String
unlines [a -> String
show' a
x, String
"** NOT EQUALS **", a -> String
show' a
y]
eqTest :: (Eq a, Show a) => String -> a -> a -> Test
eqTest :: forall a. (Eq a, Show a) => String -> a -> a -> Test
eqTest = (a -> a -> Bool) -> (a -> String) -> String -> a -> a -> Test
forall a.
(a -> a -> Bool) -> (a -> String) -> String -> a -> a -> Test
eqTest' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) a -> String
forall a. Show a => a -> String
show
qcTest :: Testable prop
=> String
-> prop
-> Test
qcTest :: forall prop. Testable prop => String -> prop -> Test
qcTest String
n = ((,) String
n) (Property -> Test) -> (prop -> Property) -> prop -> Test
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Property
QuickCheck (Property -> Property) -> (prop -> Property) -> prop -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> prop -> Property
forall prop. Testable prop => String -> prop -> Property
label String
n
data TestError
= BFalse (Maybe String )
| QCError Result
deriving Int -> TestError -> ShowS
[TestError] -> ShowS
TestError -> String
(Int -> TestError -> ShowS)
-> (TestError -> String)
-> ([TestError] -> ShowS)
-> Show TestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestError -> ShowS
showsPrec :: Int -> TestError -> ShowS
$cshow :: TestError -> String
show :: TestError -> String
$cshowList :: [TestError] -> ShowS
showList :: [TestError] -> ShowS
Show
putErrorLn :: String -> IO ()
putErrorLn :: String -> IO ()
putErrorLn = String -> IO ()
putStrLn (String -> IO ()) -> ShowS -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"*** " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>)
printVerbose :: String -> TestError -> IO ()
printVerbose :: String -> TestError -> IO ()
printVerbose String
lb TestError
te = case TestError
te of
BFalse Maybe String
m -> IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) String -> IO ()
format Maybe String
m
QCError Result
r -> String -> IO ()
format (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Result -> String
forall a. Show a => a -> String
show Result
r
where
format :: String -> IO ()
format String
s =
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putErrorLn
([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ (String
"label: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
lb String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s)
runBool :: String
-> Maybe String
-> Bool
-> IO (Maybe TestError)
runBool :: String -> Maybe String -> Bool -> IO (Maybe TestError)
runBool String
lb Maybe String
vmsg = Bool -> IO (Maybe TestError)
d where
d :: Bool -> IO (Maybe TestError)
d Bool
True = do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"+++ OK, success (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
lb String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
Maybe TestError -> IO (Maybe TestError)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TestError
forall a. Maybe a
Nothing
d Bool
False = do
String -> IO ()
putErrorLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Failed! (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
lb String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
let r :: TestError
r = Maybe String -> TestError
BFalse Maybe String
vmsg
String -> TestError -> IO ()
printVerbose String
lb TestError
r
Maybe TestError -> IO (Maybe TestError)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TestError -> IO (Maybe TestError))
-> Maybe TestError -> IO (Maybe TestError)
forall a b. (a -> b) -> a -> b
$ TestError -> Maybe TestError
forall a. a -> Maybe a
Just TestError
r
runQcProp :: Bool
-> String
-> QC.Property
-> IO (Maybe TestError)
runQcProp :: Bool -> String -> Property -> IO (Maybe TestError)
runQcProp Bool
verbose String
lb Property
p = Result -> IO (Maybe TestError)
err (Result -> IO (Maybe TestError))
-> IO Result -> IO (Maybe TestError)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Property -> IO Result
forall prop. Testable prop => prop -> IO Result
quickCheckResult Property
p where
err :: Result -> IO (Maybe TestError)
err (Success {}) =
Maybe TestError -> IO (Maybe TestError)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TestError
forall a. Maybe a
Nothing
err Result
x = do
let r :: TestError
r = Result -> TestError
QCError Result
x
if Bool
verbose
then String -> TestError -> IO ()
printVerbose String
lb TestError
r
else String -> IO ()
putErrorLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"label: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
lb
Maybe TestError -> IO (Maybe TestError)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TestError -> IO (Maybe TestError))
-> Maybe TestError -> IO (Maybe TestError)
forall a b. (a -> b) -> a -> b
$ TestError -> Maybe TestError
forall a. a -> Maybe a
Just TestError
r
runProp :: Bool
-> String
-> Property
-> IO (Maybe TestError)
runProp :: Bool -> String -> Property -> IO (Maybe TestError)
runProp Bool
verbose String
lb Property
prop = case Property
prop of
Bool Maybe String
m Bool
b -> String -> Maybe String -> Bool -> IO (Maybe TestError)
runBool String
lb (if Bool
verbose then Maybe String
m else Maybe String
forall a. Maybe a
Nothing) Bool
b
QuickCheck Property
p -> Bool -> String -> Property -> IO (Maybe TestError)
runQcProp Bool
verbose String
lb Property
p
runTest_ :: Bool
-> Test
-> IO (Maybe TestError)
runTest_ :: Bool -> Test -> IO (Maybe TestError)
runTest_ Bool
verbose = (String -> Property -> IO (Maybe TestError))
-> Test -> IO (Maybe TestError)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> Property -> IO (Maybe TestError))
-> Test -> IO (Maybe TestError))
-> (String -> Property -> IO (Maybe TestError))
-> Test
-> IO (Maybe TestError)
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Property -> IO (Maybe TestError)
runProp Bool
verbose
runTest :: Test
-> IO (Maybe TestError)
runTest :: Test -> IO (Maybe TestError)
runTest = Bool -> Test -> IO (Maybe TestError)
runTest_ Bool
False
defaultMain_ :: Bool -> [Test] -> IO ()
defaultMain_ :: Bool -> [Test] -> IO ()
defaultMain_ Bool
verbose [Test]
xs = do
[TestError]
es <- [Maybe TestError] -> [TestError]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TestError] -> [TestError])
-> IO [Maybe TestError] -> IO [TestError]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Test -> IO (Maybe TestError)) -> [Test] -> IO [Maybe TestError]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool -> Test -> IO (Maybe TestError)
runTest_ Bool
verbose) [Test]
xs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TestError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestError]
es) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Some failures are found."
defaultMain' :: Bool -> [Test] -> IO ()
defaultMain' :: Bool -> [Test] -> IO ()
defaultMain' = Bool -> [Test] -> IO ()
defaultMain_
{-# DEPRECATED defaultMain' "Use defaultMain_ instead of this." #-}
defaultMain :: [Test] -> IO ()
defaultMain :: [Test] -> IO ()
defaultMain = Bool -> [Test] -> IO ()
defaultMain_ Bool
False
verboseMain :: [Test] -> IO ()
verboseMain :: [Test] -> IO ()
verboseMain = Bool -> [Test] -> IO ()
defaultMain_ Bool
True