{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
#ifndef NO_TYPEABLE
{-# LANGUAGE DeriveDataTypeable #-}
#endif
#ifndef NO_SAFE_HASKELL
{-# LANGUAGE Safe #-}
#endif
module Test.QuickCheck.Property where
import Test.QuickCheck.Gen
import Test.QuickCheck.Gen.Unsafe
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Text( isOneLine, putLine )
import Test.QuickCheck.Exception
import Test.QuickCheck.State( State(terminal), Confidence(..) )
#ifndef NO_TIMEOUT
import System.Timeout(timeout)
#endif
import Data.Maybe
import Control.Applicative
import Control.Monad
import qualified Data.Map as Map
import Data.Map(Map)
import qualified Data.Set as Set
import Data.Set(Set)
#ifndef NO_DEEPSEQ
import Control.DeepSeq
#endif
#ifndef NO_TYPEABLE
import Data.Typeable (Typeable)
#endif
import Data.Maybe
infixr 0 ==>
infixr 1 .&.
infixr 1 .&&.
infixr 1 .||.
newtype Property = MkProperty { Property -> Gen Prop
unProperty :: Gen Prop }
#ifndef NO_TYPEABLE
deriving (Typeable)
#endif
class Testable prop where
property :: prop -> Property
propertyForAllShrinkShow :: Gen a -> (a -> [a]) -> (a -> [String]) -> (a -> prop) -> Property
propertyForAllShrinkShow Gen a
gen a -> [a]
shr a -> [String]
shw a -> prop
f =
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrinkBlind Gen a
gen a -> [a]
shr forall a b. (a -> b) -> a -> b
$
\a
x -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall prop. Testable prop => String -> prop -> Property
counterexample (forall prop. Testable prop => prop -> Property
property (a -> prop
f a
x)) (a -> [String]
shw a
x)
data Discard = Discard
instance Testable Discard where
property :: Discard -> Property
property Discard
_ = forall prop. Testable prop => prop -> Property
property Result
rejected
instance Testable () where
property :: () -> Property
property = forall prop. Testable prop => prop -> Property
property forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Result
liftUnit
where
liftUnit :: () -> Result
liftUnit () = Result
succeeded
instance Testable prop => Testable (Maybe prop) where
property :: Maybe prop -> Property
property = forall prop. Testable prop => prop -> Property
property forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => Maybe prop -> Property
liftMaybe
where
liftMaybe :: Maybe prop -> Property
liftMaybe Maybe prop
Nothing = forall prop. Testable prop => prop -> Property
property Discard
Discard
liftMaybe (Just prop
prop) = forall prop. Testable prop => prop -> Property
property prop
prop
instance Testable Bool where
property :: Bool -> Property
property = forall prop. Testable prop => prop -> Property
property forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Result
liftBool
instance Testable Result where
property :: Result -> Property
property = Gen Prop -> Property
MkProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rose Result -> Prop
MkProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rose Result -> Rose Result
protectResults forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
instance Testable Prop where
property :: Prop -> Property
property Prop
p = Gen Prop -> Property
MkProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prop -> Prop
protectProp forall a b. (a -> b) -> a -> b
$ Prop
p
instance Testable prop => Testable (Gen prop) where
property :: Gen prop -> Property
property Gen prop
mp = Gen Prop -> Property
MkProperty forall a b. (a -> b) -> a -> b
$ do prop
p <- Gen prop
mp; Property -> Gen Prop
unProperty (forall prop. Testable prop => prop -> Property
again prop
p)
instance Testable Property where
property :: Property -> Property
property (MkProperty Gen Prop
mp) = Gen Prop -> Property
MkProperty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> Prop
protectProp Gen Prop
mp)
{-# DEPRECATED morallyDubiousIOProperty "Use 'ioProperty' instead" #-}
morallyDubiousIOProperty :: Testable prop => IO prop -> Property
morallyDubiousIOProperty :: forall prop. Testable prop => IO prop -> Property
morallyDubiousIOProperty = forall prop. Testable prop => IO prop -> Property
ioProperty
ioProperty :: Testable prop => IO prop -> Property
ioProperty :: forall prop. Testable prop => IO prop -> Property
ioProperty IO prop
prop = forall prop. Testable prop => IO prop -> Property
idempotentIOProperty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall prop. Testable prop => prop -> Property
noShrinking IO prop
prop)
idempotentIOProperty :: Testable prop => IO prop -> Property
idempotentIOProperty :: forall prop. Testable prop => IO prop -> Property
idempotentIOProperty =
Gen Prop -> Property
MkProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rose Result -> Prop
MkProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Rose Result) -> Rose Result
ioRose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> Rose Result
unProp) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (m :: * -> *) a. Monad m => m (Gen a) -> Gen (m a)
promote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Property -> Gen Prop
unProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => prop -> Property
property)
instance (Arbitrary a, Show a, Testable prop) => Testable (a -> prop) where
property :: (a -> prop) -> Property
property a -> prop
f =
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> [String]) -> (a -> prop) -> Property
propertyForAllShrinkShow forall a. Arbitrary a => Gen a
arbitrary forall a. Arbitrary a => a -> [a]
shrink (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) a -> prop
f
propertyForAllShrinkShow :: forall a.
Gen a
-> (a -> [a]) -> (a -> [String]) -> (a -> a -> prop) -> Property
propertyForAllShrinkShow Gen a
gen a -> [a]
shr a -> [String]
shw a -> a -> prop
f =
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> [String]) -> (a -> prop) -> Property
propertyForAllShrinkShow
(forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Gen a
gen forall a. Arbitrary a => Gen a
arbitrary)
(forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
liftShrink2 a -> [a]
shr forall a. Arbitrary a => a -> [a]
shrink)
(\(a
x, a
y) -> a -> [String]
shw a
x forall a. [a] -> [a] -> [a]
++ [forall a. Show a => a -> String
show a
y])
(forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> prop
f)
protect :: (AnException -> a) -> IO a -> IO a
protect :: forall a. (AnException -> a) -> IO a -> IO a
protect AnException -> a
f IO a
x = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either AnException -> a
f forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. IO a -> IO (Either AnException a)
tryEvaluateIO IO a
x
newtype Prop = MkProp{ Prop -> Rose Result
unProp :: Rose Result }
data Rose a = MkRose a [Rose a] | IORose (IO (Rose a))
ioRose :: IO (Rose Result) -> Rose Result
ioRose :: IO (Rose Result) -> Rose Result
ioRose = forall a. IO (Rose a) -> Rose a
IORose forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Rose Result) -> IO (Rose Result)
protectRose
joinRose :: Rose (Rose a) -> Rose a
joinRose :: forall a. Rose (Rose a) -> Rose a
joinRose (IORose IO (Rose (Rose a))
rs) = forall a. IO (Rose a) -> Rose a
IORose (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Rose (Rose a) -> Rose a
joinRose IO (Rose (Rose a))
rs)
joinRose (MkRose (IORose IO (Rose a)
rm) [Rose (Rose a)]
rs) = forall a. IO (Rose a) -> Rose a
IORose forall a b. (a -> b) -> a -> b
$ do Rose a
r <- IO (Rose a)
rm; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Rose (Rose a) -> Rose a
joinRose (forall a. a -> [Rose a] -> Rose a
MkRose Rose a
r [Rose (Rose a)]
rs))
joinRose (MkRose (MkRose a
x [Rose a]
ts) [Rose (Rose a)]
tts) =
forall a. a -> [Rose a] -> Rose a
MkRose a
x (forall a b. (a -> b) -> [a] -> [b]
map forall a. Rose (Rose a) -> Rose a
joinRose [Rose (Rose a)]
tts forall a. [a] -> [a] -> [a]
++ [Rose a]
ts)
instance Functor Rose where
fmap :: forall a b. (a -> b) -> Rose a -> Rose b
fmap a -> b
f (IORose IO (Rose a)
rs) = forall a. IO (Rose a) -> Rose a
IORose (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) IO (Rose a)
rs)
fmap a -> b
f (MkRose a
x [Rose a]
rs) = forall a. a -> [Rose a] -> Rose a
MkRose (a -> b
f a
x) [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Rose a
r | Rose a
r <- [Rose a]
rs ]
instance Applicative Rose where
pure :: forall a. a -> Rose a
pure a
x = forall a. a -> [Rose a] -> Rose a
MkRose a
x []
<*> :: forall a b. Rose (a -> b) -> Rose a -> Rose b
(<*>) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a b. (a -> b) -> a -> b
($)
instance Monad Rose where
return :: forall a. a -> Rose a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Rose a
m >>= :: forall a b. Rose a -> (a -> Rose b) -> Rose b
>>= a -> Rose b
k = forall a. Rose (Rose a) -> Rose a
joinRose (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Rose b
k Rose a
m)
reduceRose :: Rose Result -> IO (Rose Result)
reduceRose :: Rose Result -> IO (Rose Result)
reduceRose r :: Rose Result
r@(MkRose Result
_ [Rose Result]
_) = forall (m :: * -> *) a. Monad m => a -> m a
return Rose Result
r
reduceRose (IORose IO (Rose Result)
m) = IO (Rose Result)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Rose Result -> IO (Rose Result)
reduceRose
onRose :: (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
onRose :: forall a. (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
onRose a -> [Rose a] -> Rose a
f (MkRose a
x [Rose a]
rs) = a -> [Rose a] -> Rose a
f a
x [Rose a]
rs
onRose a -> [Rose a] -> Rose a
f (IORose IO (Rose a)
m) = forall a. IO (Rose a) -> Rose a
IORose (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
onRose a -> [Rose a] -> Rose a
f) IO (Rose a)
m)
protectRose :: IO (Rose Result) -> IO (Rose Result)
protectRose :: IO (Rose Result) -> IO (Rose Result)
protectRose = forall a. (AnException -> a) -> IO a -> IO a
protect (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AnException -> Result
exception String
"Exception")
protectProp :: Prop -> Prop
protectProp :: Prop -> Prop
protectProp (MkProp Rose Result
r) = Rose Result -> Prop
MkProp (forall a. IO (Rose a) -> Rose a
IORose forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Rose Result) -> IO (Rose Result)
protectRose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Rose Result
r)
protectResults :: Rose Result -> Rose Result
protectResults :: Rose Result -> Rose Result
protectResults = forall a. (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
onRose forall a b. (a -> b) -> a -> b
$ \Result
x [Rose Result]
rs ->
forall a. IO (Rose a) -> Rose a
IORose forall a b. (a -> b) -> a -> b
$ do
Result
y <- IO Result -> IO Result
protectResult (forall (m :: * -> *) a. Monad m => a -> m a
return Result
x)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> [Rose a] -> Rose a
MkRose Result
y (forall a b. (a -> b) -> [a] -> [b]
map Rose Result -> Rose Result
protectResults [Rose Result]
rs))
data Callback
= PostTest CallbackKind (State -> Result -> IO ())
| PostFinalFailure CallbackKind (State -> Result -> IO ())
data CallbackKind = Counterexample
| NotCounterexample
data Result
= MkResult
{ Result -> Maybe Bool
ok :: Maybe Bool
, Result -> Bool
expect :: Bool
, Result -> String
reason :: String
, Result -> Maybe AnException
theException :: Maybe AnException
, Result -> Bool
abort :: Bool
, Result -> Maybe Int
maybeNumTests :: Maybe Int
, Result -> Maybe Confidence
maybeCheckCoverage :: Maybe Confidence
, Result -> [String]
labels :: [String]
, Result -> [String]
classes :: [String]
, Result -> [(String, String)]
tables :: [(String, String)]
, Result -> [(Maybe String, String, Double)]
requiredCoverage :: [(Maybe String, String, Double)]
, Result -> [Callback]
callbacks :: [Callback]
, Result -> [String]
testCase :: [String]
}
exception :: String -> AnException -> Result
exception :: String -> AnException -> Result
exception String
msg AnException
err
| AnException -> Bool
isDiscard AnException
err = Result
rejected
| Bool
otherwise = Result
failed{ reason :: String
reason = String -> AnException -> String
formatException String
msg AnException
err,
theException :: Maybe AnException
theException = forall a. a -> Maybe a
Just AnException
err }
formatException :: String -> AnException -> String
formatException :: String -> AnException -> String
formatException String
msg AnException
err = String
msg forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ String -> String
format (forall a. Show a => a -> String
show AnException
err)
where format :: String -> String
format String
xs | String -> Bool
isOneLine String
xs = String
" '" forall a. [a] -> [a] -> [a]
++ String
xs forall a. [a] -> [a] -> [a]
++ String
"'"
| Bool
otherwise = String
"\n" forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [ String
" " forall a. [a] -> [a] -> [a]
++ String
l | String
l <- String -> [String]
lines String
xs ]
protectResult :: IO Result -> IO Result
protectResult :: IO Result -> IO Result
protectResult = forall a. (AnException -> a) -> IO a -> IO a
protect (String -> AnException -> Result
exception String
"Exception")
succeeded, failed, rejected :: Result
(Result
succeeded, Result
failed, Result
rejected) =
(Result
result{ ok :: Maybe Bool
ok = forall a. a -> Maybe a
Just Bool
True },
Result
result{ ok :: Maybe Bool
ok = forall a. a -> Maybe a
Just Bool
False },
Result
result{ ok :: Maybe Bool
ok = forall a. Maybe a
Nothing })
where
result :: Result
result =
MkResult
{ ok :: Maybe Bool
ok = forall a. HasCallStack => a
undefined
, expect :: Bool
expect = Bool
True
, reason :: String
reason = String
""
, theException :: Maybe AnException
theException = forall a. Maybe a
Nothing
, abort :: Bool
abort = Bool
True
, maybeNumTests :: Maybe Int
maybeNumTests = forall a. Maybe a
Nothing
, maybeCheckCoverage :: Maybe Confidence
maybeCheckCoverage = forall a. Maybe a
Nothing
, labels :: [String]
labels = []
, classes :: [String]
classes = []
, tables :: [(String, String)]
tables = []
, requiredCoverage :: [(Maybe String, String, Double)]
requiredCoverage = []
, callbacks :: [Callback]
callbacks = []
, testCase :: [String]
testCase = []
}
liftBool :: Bool -> Result
liftBool :: Bool -> Result
liftBool Bool
True = Result
succeeded
liftBool Bool
False = Result
failed { reason :: String
reason = String
"Falsified" }
mapResult :: Testable prop => (Result -> Result) -> prop -> Property
mapResult :: forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapResult Result -> Result
f = forall prop.
Testable prop =>
(Rose Result -> Rose Result) -> prop -> Property
mapRoseResult (Rose Result -> Rose Result
protectResults forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Result -> Result
f)
mapTotalResult :: Testable prop => (Result -> Result) -> prop -> Property
mapTotalResult :: forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult Result -> Result
f = forall prop.
Testable prop =>
(Rose Result -> Rose Result) -> prop -> Property
mapRoseResult (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Result -> Result
f)
mapRoseResult :: Testable prop => (Rose Result -> Rose Result) -> prop -> Property
mapRoseResult :: forall prop.
Testable prop =>
(Rose Result -> Rose Result) -> prop -> Property
mapRoseResult Rose Result -> Rose Result
f = forall prop. Testable prop => (Prop -> Prop) -> prop -> Property
mapProp (\(MkProp Rose Result
t) -> Rose Result -> Prop
MkProp (Rose Result -> Rose Result
f Rose Result
t))
mapProp :: Testable prop => (Prop -> Prop) -> prop -> Property
mapProp :: forall prop. Testable prop => (Prop -> Prop) -> prop -> Property
mapProp Prop -> Prop
f = Gen Prop -> Property
MkProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> Prop
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Gen Prop
unProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => prop -> Property
property
mapSize :: Testable prop => (Int -> Int) -> prop -> Property
mapSize :: forall prop. Testable prop => (Int -> Int) -> prop -> Property
mapSize Int -> Int
f = forall prop. Testable prop => prop -> Property
property forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Gen Prop
unProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => prop -> Property
property
shrinking :: Testable prop =>
(a -> [a])
-> a
-> (a -> prop) -> Property
shrinking :: forall prop a.
Testable prop =>
(a -> [a]) -> a -> (a -> prop) -> Property
shrinking a -> [a]
shrinker a
x0 a -> prop
pf = Gen Prop -> Property
MkProperty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rose Result -> Prop
MkProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Rose (Rose a) -> Rose a
joinRose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> Rose Result
unProp) (forall (m :: * -> *) a. Monad m => m (Gen a) -> Gen (m a)
promote (a -> Rose (Gen Prop)
props a
x0)))
where
props :: a -> Rose (Gen Prop)
props a
x =
forall a. a -> [Rose a] -> Rose a
MkRose (Property -> Gen Prop
unProperty (forall prop. Testable prop => prop -> Property
property (a -> prop
pf a
x))) [ a -> Rose (Gen Prop)
props a
x' | a
x' <- a -> [a]
shrinker a
x ]
noShrinking :: Testable prop => prop -> Property
noShrinking :: forall prop. Testable prop => prop -> Property
noShrinking = forall prop.
Testable prop =>
(Rose Result -> Rose Result) -> prop -> Property
mapRoseResult (forall a. (a -> [Rose a] -> Rose a) -> Rose a -> Rose a
onRose (\Result
res [Rose Result]
_ -> forall a. a -> [Rose a] -> Rose a
MkRose Result
res []))
callback :: Testable prop => Callback -> prop -> Property
callback :: forall prop. Testable prop => Callback -> prop -> Property
callback Callback
cb = forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult (\Result
res -> Result
res{ callbacks :: [Callback]
callbacks = Callback
cb forall a. a -> [a] -> [a]
: Result -> [Callback]
callbacks Result
res })
counterexample :: Testable prop => String -> prop -> Property
counterexample :: forall prop. Testable prop => String -> prop -> Property
counterexample String
s =
forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult (\Result
res -> Result
res{ testCase :: [String]
testCase = String
sforall a. a -> [a] -> [a]
:Result -> [String]
testCase Result
res }) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall prop. Testable prop => Callback -> prop -> Property
callback (CallbackKind -> (State -> Result -> IO ()) -> Callback
PostFinalFailure CallbackKind
Counterexample forall a b. (a -> b) -> a -> b
$ \State
st Result
_res -> do
String
s <- String -> IO String
showCounterexample String
s
Terminal -> String -> IO ()
putLine (State -> Terminal
terminal State
st) String
s)
showCounterexample :: String -> IO String
showCounterexample :: String -> IO String
showCounterexample String
s = do
let force :: [a] -> m ()
force [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
force (a
x:[a]
xs) = a
x seq :: forall a b. a -> b -> b
`seq` [a] -> m ()
force [a]
xs
Either AnException ()
res <- forall a. IO a -> IO (Either AnException a)
tryEvaluateIO (forall {m :: * -> *} {a}. Monad m => [a] -> m ()
force String
s)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case Either AnException ()
res of
Left AnException
err ->
String -> AnException -> String
formatException String
"Exception thrown while showing test case" AnException
err
Right () ->
String
s
{-# DEPRECATED printTestCase "Use counterexample instead" #-}
printTestCase :: Testable prop => String -> prop -> Property
printTestCase :: forall prop. Testable prop => String -> prop -> Property
printTestCase = forall prop. Testable prop => String -> prop -> Property
counterexample
whenFail :: Testable prop => IO () -> prop -> Property
whenFail :: forall prop. Testable prop => IO () -> prop -> Property
whenFail IO ()
m =
forall prop. Testable prop => Callback -> prop -> Property
callback forall a b. (a -> b) -> a -> b
$ CallbackKind -> (State -> Result -> IO ()) -> Callback
PostFinalFailure CallbackKind
NotCounterexample forall a b. (a -> b) -> a -> b
$ \State
_st Result
_res ->
IO ()
m
whenFail' :: Testable prop => IO () -> prop -> Property
whenFail' :: forall prop. Testable prop => IO () -> prop -> Property
whenFail' IO ()
m =
forall prop. Testable prop => Callback -> prop -> Property
callback forall a b. (a -> b) -> a -> b
$ CallbackKind -> (State -> Result -> IO ()) -> Callback
PostTest CallbackKind
NotCounterexample forall a b. (a -> b) -> a -> b
$ \State
_st Result
res ->
if Result -> Maybe Bool
ok Result
res forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
False
then IO ()
m
else forall (m :: * -> *) a. Monad m => a -> m a
return ()
verbose :: Testable prop => prop -> Property
verbose :: forall prop. Testable prop => prop -> Property
verbose = forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapResult (\Result
res -> Result
res { callbacks :: [Callback]
callbacks = [Callback] -> Callback
newCallback (Result -> [Callback]
callbacks Result
res)forall a. a -> [a] -> [a]
:Result -> [Callback]
callbacks Result
res })
where newCallback :: [Callback] -> Callback
newCallback [Callback]
cbs =
CallbackKind -> (State -> Result -> IO ()) -> Callback
PostTest CallbackKind
Counterexample forall a b. (a -> b) -> a -> b
$ \State
st Result
res -> do
Terminal -> String -> IO ()
putLine (State -> Terminal
terminal State
st) (Result -> String
status Result
res forall a. [a] -> [a] -> [a]
++ String
":")
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ State -> Result -> IO ()
f State
st Result
res | PostFinalFailure CallbackKind
Counterexample State -> Result -> IO ()
f <- [Callback]
cbs ]
Terminal -> String -> IO ()
putLine (State -> Terminal
terminal State
st) String
""
status :: Result -> String
status MkResult{ok :: Result -> Maybe Bool
ok = Just Bool
True} = String
"Passed"
status MkResult{ok :: Result -> Maybe Bool
ok = Just Bool
False} = String
"Failed"
status MkResult{ok :: Result -> Maybe Bool
ok = Maybe Bool
Nothing} = String
"Skipped (precondition false)"
verboseShrinking :: Testable prop => prop -> Property
verboseShrinking :: forall prop. Testable prop => prop -> Property
verboseShrinking = forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapResult (\Result
res -> Result
res { callbacks :: [Callback]
callbacks = [Callback] -> Callback
newCallback (Result -> [Callback]
callbacks Result
res)forall a. a -> [a] -> [a]
:Result -> [Callback]
callbacks Result
res })
where newCallback :: [Callback] -> Callback
newCallback [Callback]
cbs =
CallbackKind -> (State -> Result -> IO ()) -> Callback
PostTest CallbackKind
Counterexample forall a b. (a -> b) -> a -> b
$ \State
st Result
res ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result -> Maybe Bool
ok Result
res forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
False) forall a b. (a -> b) -> a -> b
$ do
Terminal -> String -> IO ()
putLine (State -> Terminal
terminal State
st) String
"Failed:"
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ State -> Result -> IO ()
f State
st Result
res | PostFinalFailure CallbackKind
Counterexample State -> Result -> IO ()
f <- [Callback]
cbs ]
Terminal -> String -> IO ()
putLine (State -> Terminal
terminal State
st) String
""
expectFailure :: Testable prop => prop -> Property
expectFailure :: forall prop. Testable prop => prop -> Property
expectFailure = forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult (\Result
res -> Result
res{ expect :: Bool
expect = Bool
False })
once :: Testable prop => prop -> Property
once :: forall prop. Testable prop => prop -> Property
once = forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult (\Result
res -> Result
res{ abort :: Bool
abort = Bool
True })
again :: Testable prop => prop -> Property
again :: forall prop. Testable prop => prop -> Property
again = forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult (\Result
res -> Result
res{ abort :: Bool
abort = Bool
False })
withMaxSuccess :: Testable prop => Int -> prop -> Property
withMaxSuccess :: forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
n = Int
n seq :: forall a b. a -> b -> b
`seq` forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult (\Result
res -> Result
res{ maybeNumTests :: Maybe Int
maybeNumTests = forall a. a -> Maybe a
Just Int
n })
checkCoverage :: Testable prop => prop -> Property
checkCoverage :: forall prop. Testable prop => prop -> Property
checkCoverage = forall prop. Testable prop => Confidence -> prop -> Property
checkCoverageWith Confidence
stdConfidence
checkCoverageWith :: Testable prop => Confidence -> prop -> Property
checkCoverageWith :: forall prop. Testable prop => Confidence -> prop -> Property
checkCoverageWith Confidence
confidence =
Confidence -> Integer
certainty Confidence
confidence seq :: forall a b. a -> b -> b
`seq`
Confidence -> Double
tolerance Confidence
confidence seq :: forall a b. a -> b -> b
`seq`
forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult (\Result
res -> Result
res{ maybeCheckCoverage :: Maybe Confidence
maybeCheckCoverage = forall a. a -> Maybe a
Just Confidence
confidence })
stdConfidence :: Confidence
stdConfidence :: Confidence
stdConfidence =
Confidence {
certainty :: Integer
certainty = Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^Integer
9,
tolerance :: Double
tolerance = Double
0.9 }
label :: Testable prop => String -> prop -> Property
label :: forall prop. Testable prop => String -> prop -> Property
label String
s =
#ifndef NO_DEEPSEQ
String
s forall a b. NFData a => a -> b -> b
`deepseq`
#endif
forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult forall a b. (a -> b) -> a -> b
$
\Result
res -> Result
res { labels :: [String]
labels = String
sforall a. a -> [a] -> [a]
:Result -> [String]
labels Result
res }
collect :: (Show a, Testable prop) => a -> prop -> Property
collect :: forall a prop. (Show a, Testable prop) => a -> prop -> Property
collect a
x = forall prop. Testable prop => String -> prop -> Property
label (forall a. Show a => a -> String
show a
x)
classify :: Testable prop =>
Bool
-> String
-> prop -> Property
classify :: forall prop. Testable prop => Bool -> String -> prop -> Property
classify Bool
False String
_ = forall prop. Testable prop => prop -> Property
property
classify Bool
True String
s =
#ifndef NO_DEEPSEQ
String
s forall a b. NFData a => a -> b -> b
`deepseq`
#endif
forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult forall a b. (a -> b) -> a -> b
$
\Result
res -> Result
res { classes :: [String]
classes = String
sforall a. a -> [a] -> [a]
:Result -> [String]
classes Result
res }
cover :: Testable prop =>
Double
-> Bool
-> String
-> prop -> Property
cover :: forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
p Bool
x String
s = forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult Result -> Result
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => Bool -> String -> prop -> Property
classify Bool
x String
s
where
f :: Result -> Result
f Result
res = Result
res { requiredCoverage :: [(Maybe String, String, Double)]
requiredCoverage = (forall a. Maybe a
Nothing, String
s, Double
pforall a. Fractional a => a -> a -> a
/Double
100)forall a. a -> [a] -> [a]
:Result -> [(Maybe String, String, Double)]
requiredCoverage Result
res }
tabulate :: Testable prop => String -> [String] -> prop -> Property
tabulate :: forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
key [String]
values =
#ifndef NO_DEEPSEQ
String
key forall a b. NFData a => a -> b -> b
`deepseq` [String]
values forall a b. NFData a => a -> b -> b
`deepseq`
#endif
forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult forall a b. (a -> b) -> a -> b
$
\Result
res -> Result
res { tables :: [(String, String)]
tables = [(String
key, String
value) | String
value <- [String]
values] forall a. [a] -> [a] -> [a]
++ Result -> [(String, String)]
tables Result
res }
coverTable :: Testable prop =>
String -> [(String, Double)] -> prop -> Property
coverTable :: forall prop.
Testable prop =>
String -> [(String, Double)] -> prop -> Property
coverTable String
table [(String, Double)]
xs =
#ifndef NO_DEEPSEQ
String
table forall a b. NFData a => a -> b -> b
`deepseq` [(String, Double)]
xs forall a b. NFData a => a -> b -> b
`deepseq`
#endif
forall prop.
Testable prop =>
(Result -> Result) -> prop -> Property
mapTotalResult forall a b. (a -> b) -> a -> b
$
\Result
res -> Result
res { requiredCoverage :: [(Maybe String, String, Double)]
requiredCoverage = [(Maybe String, String, Double)]
ys forall a. [a] -> [a] -> [a]
++ Result -> [(Maybe String, String, Double)]
requiredCoverage Result
res }
where
ys :: [(Maybe String, String, Double)]
ys = [(forall a. a -> Maybe a
Just String
table, String
x, Double
pforall a. Fractional a => a -> a -> a
/Double
100) | (String
x, Double
p) <- [(String, Double)]
xs]
(==>) :: Testable prop => Bool -> prop -> Property
Bool
False ==> :: forall prop. Testable prop => Bool -> prop -> Property
==> prop
_ = forall prop. Testable prop => prop -> Property
property Discard
Discard
Bool
True ==> prop
p = forall prop. Testable prop => prop -> Property
property prop
p
within :: Testable prop => Int -> prop -> Property
within :: forall prop. Testable prop => Int -> prop -> Property
within Int
n = forall prop. Testable prop => Result -> Int -> prop -> Property
onTimeout
(Result
failed { reason :: String
reason = String
"Timeout of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" microseconds exceeded." })
Int
n
discardAfter :: Testable prop => Int -> prop -> Property
discardAfter :: forall prop. Testable prop => Int -> prop -> Property
discardAfter Int
n = forall prop. Testable prop => Result -> Int -> prop -> Property
onTimeout
(Result
rejected { reason :: String
reason = String
"Timeout of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" microseconds exceeded." })
Int
n
onTimeout :: Testable prop => Result -> Int -> prop -> Property
onTimeout :: forall prop. Testable prop => Result -> Int -> prop -> Property
onTimeout Result
timeoutResult Int
n = forall prop.
Testable prop =>
(Rose Result -> Rose Result) -> prop -> Property
mapRoseResult Rose Result -> Rose Result
f
where
f :: Rose Result -> Rose Result
f Rose Result
rose = IO (Rose Result) -> Rose Result
ioRose forall a b. (a -> b) -> a -> b
$ do
let f (Maybe b)
m orError :: f (Maybe b) -> b -> f b
`orError` b
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe b
x) f (Maybe b)
m
MkRose Result
res [Rose Result]
roses <- forall a. Int -> IO a -> IO (Maybe a)
timeout Int
n (Rose Result -> IO (Rose Result)
reduceRose Rose Result
rose) forall {f :: * -> *} {b}. Functor f => f (Maybe b) -> b -> f b
`orError`
forall (m :: * -> *) a. Monad m => a -> m a
return Result
timeoutResult
Result
res' <- forall a. Int -> IO a -> IO (Maybe a)
timeout Int
n (IO Result -> IO Result
protectResult (forall (m :: * -> *) a. Monad m => a -> m a
return Result
res)) forall {f :: * -> *} {b}. Functor f => f (Maybe b) -> b -> f b
`orError`
Result
timeoutResult
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> [Rose a] -> Rose a
MkRose Result
res' (forall a b. (a -> b) -> [a] -> [b]
map Rose Result -> Rose Result
f [Rose Result]
roses))
#ifdef NO_TIMEOUT
timeout _ = fmap Just
#endif
forAll :: (Show a, Testable prop)
=> Gen a -> (a -> prop) -> Property
forAll :: forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen a -> prop
pf = forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen (\a
_ -> []) a -> prop
pf
forAllShow :: Testable prop
=> Gen a -> (a -> String) -> (a -> prop) -> Property
forAllShow :: forall prop a.
Testable prop =>
Gen a -> (a -> String) -> (a -> prop) -> Property
forAllShow Gen a
gen a -> String
shower a -> prop
pf = forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
forAllShrinkShow Gen a
gen (\a
_ -> []) a -> String
shower a -> prop
pf
forAllBlind :: Testable prop
=> Gen a -> (a -> prop) -> Property
forAllBlind :: forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen a
gen a -> prop
pf = forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrinkBlind Gen a
gen (\a
_ -> []) a -> prop
pf
forAllShrink :: (Show a, Testable prop)
=> Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink :: forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
shrinker = forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
forAllShrinkShow Gen a
gen a -> [a]
shrinker forall a. Show a => a -> String
show
forAllShrinkShow
:: Testable prop
=> Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
forAllShrinkShow :: forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
forAllShrinkShow Gen a
gen a -> [a]
shrinker a -> String
shower a -> prop
pf =
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrinkBlind Gen a
gen a -> [a]
shrinker (\a
x -> forall prop. Testable prop => String -> prop -> Property
counterexample (a -> String
shower a
x) (a -> prop
pf a
x))
forAllShrinkBlind
:: Testable prop
=> Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrinkBlind :: forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrinkBlind Gen a
gen a -> [a]
shrinker a -> prop
pf =
forall prop. Testable prop => prop -> Property
again forall a b. (a -> b) -> a -> b
$
Gen Prop -> Property
MkProperty forall a b. (a -> b) -> a -> b
$
Gen a
gen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x ->
Property -> Gen Prop
unProperty forall a b. (a -> b) -> a -> b
$
forall prop a.
Testable prop =>
(a -> [a]) -> a -> (a -> prop) -> Property
shrinking a -> [a]
shrinker a
x a -> prop
pf
(.&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property
prop1
p1 .&. :: forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&. prop2
p2 =
forall prop. Testable prop => prop -> Property
again forall a b. (a -> b) -> a -> b
$
Gen Prop -> Property
MkProperty forall a b. (a -> b) -> a -> b
$
forall a. Arbitrary a => Gen a
arbitrary forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b ->
Property -> Gen Prop
unProperty forall a b. (a -> b) -> a -> b
$
forall prop. Testable prop => String -> prop -> Property
counterexample (if Bool
b then String
"LHS" else String
"RHS") forall a b. (a -> b) -> a -> b
$
if Bool
b then forall prop. Testable prop => prop -> Property
property prop1
p1 else forall prop. Testable prop => prop -> Property
property prop2
p2
(.&&.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property
prop1
p1 .&&. :: forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. prop2
p2 = forall prop. Testable prop => [prop] -> Property
conjoin [forall prop. Testable prop => prop -> Property
property prop1
p1, forall prop. Testable prop => prop -> Property
property prop2
p2]
conjoin :: Testable prop => [prop] -> Property
conjoin :: forall prop. Testable prop => [prop] -> Property
conjoin [prop]
ps =
forall prop. Testable prop => prop -> Property
again forall a b. (a -> b) -> a -> b
$
Gen Prop -> Property
MkProperty forall a b. (a -> b) -> a -> b
$
do [Rose Result]
roses <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> Rose Result
unProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Gen Prop
unProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => prop -> Property
property) [prop]
ps
forall (m :: * -> *) a. Monad m => a -> m a
return (Rose Result -> Prop
MkProp ((Result -> Result) -> [Rose Result] -> Rose Result
conj forall a. a -> a
id [Rose Result]
roses))
where
conj :: (Result -> Result) -> [Rose Result] -> Rose Result
conj Result -> Result
k [] =
forall a. a -> [Rose a] -> Rose a
MkRose (Result -> Result
k Result
succeeded) []
conj Result -> Result
k (Rose Result
p : [Rose Result]
ps) = forall a. IO (Rose a) -> Rose a
IORose forall a b. (a -> b) -> a -> b
$ do
rose :: Rose Result
rose@(MkRose Result
result [Rose Result]
_) <- Rose Result -> IO (Rose Result)
reduceRose Rose Result
p
case Result -> Maybe Bool
ok Result
result of
Maybe Bool
_ | Bool -> Bool
not (Result -> Bool
expect Result
result) ->
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return Result
failed { reason :: String
reason = String
"expectFailure may not occur inside a conjunction" })
Just Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return ((Result -> Result) -> [Rose Result] -> Rose Result
conj (Result -> Result -> Result
addLabels Result
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Result -> Result
addCallbacksAndCoverage Result
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Result
k) [Rose Result]
ps)
Just Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return Rose Result
rose
Maybe Bool
Nothing -> do
rose2 :: Rose Result
rose2@(MkRose Result
result2 [Rose Result]
_) <- Rose Result -> IO (Rose Result)
reduceRose ((Result -> Result) -> [Rose Result] -> Rose Result
conj (Result -> Result -> Result
addCallbacksAndCoverage Result
result forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Result
k) [Rose Result]
ps)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case Result -> Maybe Bool
ok Result
result2 of
Just Bool
True -> forall a. a -> [Rose a] -> Rose a
MkRose (Result
result2 { ok :: Maybe Bool
ok = forall a. Maybe a
Nothing }) []
Just Bool
False -> Rose Result
rose2
Maybe Bool
Nothing -> Rose Result
rose2
addCallbacksAndCoverage :: Result -> Result -> Result
addCallbacksAndCoverage Result
result Result
r =
Result
r { callbacks :: [Callback]
callbacks = Result -> [Callback]
callbacks Result
result forall a. [a] -> [a] -> [a]
++ Result -> [Callback]
callbacks Result
r,
requiredCoverage :: [(Maybe String, String, Double)]
requiredCoverage = Result -> [(Maybe String, String, Double)]
requiredCoverage Result
result forall a. [a] -> [a] -> [a]
++ Result -> [(Maybe String, String, Double)]
requiredCoverage Result
r }
addLabels :: Result -> Result -> Result
addLabels Result
result Result
r =
Result
r { labels :: [String]
labels = Result -> [String]
labels Result
result forall a. [a] -> [a] -> [a]
++ Result -> [String]
labels Result
r,
classes :: [String]
classes = Result -> [String]
classes Result
result forall a. [a] -> [a] -> [a]
++ Result -> [String]
classes Result
r,
tables :: [(String, String)]
tables = Result -> [(String, String)]
tables Result
result forall a. [a] -> [a] -> [a]
++ Result -> [(String, String)]
tables Result
r }
(.||.) :: (Testable prop1, Testable prop2) => prop1 -> prop2 -> Property
prop1
p1 .||. :: forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.||. prop2
p2 = forall prop. Testable prop => [prop] -> Property
disjoin [forall prop. Testable prop => prop -> Property
property prop1
p1, forall prop. Testable prop => prop -> Property
property prop2
p2]
disjoin :: Testable prop => [prop] -> Property
disjoin :: forall prop. Testable prop => [prop] -> Property
disjoin [prop]
ps =
forall prop. Testable prop => prop -> Property
again forall a b. (a -> b) -> a -> b
$
Gen Prop -> Property
MkProperty forall a b. (a -> b) -> a -> b
$
do [Rose Result]
roses <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prop -> Rose Result
unProp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Gen Prop
unProperty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => prop -> Property
property) [prop]
ps
forall (m :: * -> *) a. Monad m => a -> m a
return (Rose Result -> Prop
MkProp (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Rose Result -> Rose Result -> Rose Result
disj (forall a. a -> [Rose a] -> Rose a
MkRose Result
failed []) [Rose Result]
roses))
where
disj :: Rose Result -> Rose Result -> Rose Result
disj :: Rose Result -> Rose Result -> Rose Result
disj Rose Result
p Rose Result
q =
do Result
result1 <- Rose Result
p
case Result -> Maybe Bool
ok Result
result1 of
Maybe Bool
_ | Bool -> Bool
not (Result -> Bool
expect Result
result1) -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
expectFailureError
Just Bool
False -> do
Result
result2 <- Rose Result
q
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
case Result -> Maybe Bool
ok Result
result2 of
Maybe Bool
_ | Bool -> Bool
not (Result -> Bool
expect Result
result2) -> Result
expectFailureError
Just Bool
True -> Result -> Result -> Result
addCoverage Result
result1 Result
result2
Just Bool
False ->
MkResult {
ok :: Maybe Bool
ok = forall a. a -> Maybe a
Just Bool
False,
expect :: Bool
expect = Bool
True,
reason :: String
reason = String -> String -> String
sep (Result -> String
reason Result
result1) (Result -> String
reason Result
result2),
theException :: Maybe AnException
theException = Result -> Maybe AnException
theException Result
result1 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Result -> Maybe AnException
theException Result
result2,
abort :: Bool
abort = Bool
False,
maybeNumTests :: Maybe Int
maybeNumTests = forall a. Maybe a
Nothing,
maybeCheckCoverage :: Maybe Confidence
maybeCheckCoverage = forall a. Maybe a
Nothing,
labels :: [String]
labels = [],
classes :: [String]
classes = [],
tables :: [(String, String)]
tables = [],
requiredCoverage :: [(Maybe String, String, Double)]
requiredCoverage = [],
callbacks :: [Callback]
callbacks =
Result -> [Callback]
callbacks Result
result1 forall a. [a] -> [a] -> [a]
++
[CallbackKind -> (State -> Result -> IO ()) -> Callback
PostFinalFailure CallbackKind
Counterexample forall a b. (a -> b) -> a -> b
$ \State
st Result
_res -> Terminal -> String -> IO ()
putLine (State -> Terminal
terminal State
st) String
""] forall a. [a] -> [a] -> [a]
++
Result -> [Callback]
callbacks Result
result2,
testCase :: [String]
testCase =
Result -> [String]
testCase Result
result1 forall a. [a] -> [a] -> [a]
++
Result -> [String]
testCase Result
result2 }
Maybe Bool
Nothing -> Result
result2
Maybe Bool
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
result1
expectFailureError :: Result
expectFailureError = Result
failed { reason :: String
reason = String
"expectFailure may not occur inside a disjunction" }
sep :: String -> String -> String
sep [] String
s = String
s
sep String
s [] = String
s
sep String
s String
s' = String
s forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ String
s'
addCoverage :: Result -> Result -> Result
addCoverage Result
result Result
r =
Result
r { requiredCoverage :: [(Maybe String, String, Double)]
requiredCoverage = Result -> [(Maybe String, String, Double)]
requiredCoverage Result
result forall a. [a] -> [a] -> [a]
++ Result -> [(Maybe String, String, Double)]
requiredCoverage Result
r }
infix 4 ===
(===) :: (Eq a, Show a) => a -> a -> Property
a
x === :: forall a. (Eq a, Show a) => a -> a -> Property
=== a
y =
forall prop. Testable prop => String -> prop -> Property
counterexample (forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ Bool -> String
interpret Bool
res forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y) Bool
res
where
res :: Bool
res = a
x forall a. Eq a => a -> a -> Bool
== a
y
interpret :: Bool -> String
interpret Bool
True = String
" == "
interpret Bool
False = String
" /= "
infix 4 =/=
(=/=) :: (Eq a, Show a) => a -> a -> Property
a
x =/= :: forall a. (Eq a, Show a) => a -> a -> Property
=/= a
y =
forall prop. Testable prop => String -> prop -> Property
counterexample (forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ Bool -> String
interpret Bool
res forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
y) Bool
res
where
res :: Bool
res = a
x forall a. Eq a => a -> a -> Bool
/= a
y
interpret :: Bool -> String
interpret Bool
True = String
" /= "
interpret Bool
False = String
" == "
#ifndef NO_DEEPSEQ
total :: NFData a => a -> Property
total :: forall a. NFData a => a -> Property
total a
x = forall prop. Testable prop => prop -> Property
property (forall a. NFData a => a -> ()
rnf a
x)
#endif