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 n :: String
n m :: 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' n :: String
n m :: 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 n :: 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' :: (a -> a -> Bool) -> (a -> String) -> String -> a -> a -> Test
eqTest' eq :: a -> a -> Bool
eq show' :: a -> String
show' n :: String
n x :: a
x y :: 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, "** NOT EQUALS **", a -> String
show' a
y]
eqTest :: (Eq a, Show a) => String -> a -> a -> Test
eqTest :: 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 :: String -> prop -> Test
qcTest n :: 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
showList :: [TestError] -> ShowS
$cshowList :: [TestError] -> ShowS
show :: TestError -> String
$cshow :: TestError -> String
showsPrec :: Int -> TestError -> ShowS
$cshowsPrec :: Int -> 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 -> ShowS
forall a. Semigroup a => a -> a -> a
<>)
printVerbose :: String -> TestError -> IO ()
printVerbose :: String -> TestError -> IO ()
printVerbose lb :: String
lb te :: TestError
te = case TestError
te of
BFalse m :: Maybe String
m -> IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) String -> IO ()
format Maybe String
m
QCError r :: 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 s :: 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
$ ("label: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
lb String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ":") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (" " 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 lb :: String
lb vmsg :: Maybe String
vmsg = Bool -> IO (Maybe TestError)
d where
d :: Bool -> IO (Maybe TestError)
d True = do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "+++ OK, success (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
lb String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ")"
Maybe TestError -> IO (Maybe TestError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TestError
forall a. Maybe a
Nothing
d False = do
String -> IO ()
putErrorLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Failed! (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
lb String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ")"
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 (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 verbose :: Bool
verbose lb :: String
lb p :: 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 (m :: * -> *) a. Monad m => a -> m a
return Maybe TestError
forall a. Maybe a
Nothing
err x :: 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
$ "label: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
lb
Maybe TestError -> IO (Maybe TestError)
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 verbose :: Bool
verbose lb :: String
lb prop :: Property
prop = case Property
prop of
Bool m :: Maybe String
m b :: 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 p :: 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_ verbose :: 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_ verbose :: Bool
verbose xs :: [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)
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 (t :: * -> *) a. Foldable t => t a -> Bool
null [TestError]
es) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "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