{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances
, FlexibleContexts, TypeSynonymInstances, GeneralizedNewtypeDeriving
, UndecidableInstances, ScopedTypeVariables, DefaultSignatures
, TypeOperators, CPP
#-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
module Test.QuickCheck.Checkers
(
Test, TestBatch, unbatch, checkBatch, quickBatch, verboseBatch
, Unop, Binop, genR, involution, inverseL, inverse
, FracT, NumT, OrdT, T
, EqProp(..), eq
, BinRel, reflexive, transitive, symmetric, antiSymmetric
, leftId, rightId, bothId, isAssoc, isCommut, commutes
, MonoidD, monoidD, endoMonoidD, homomorphism
, idempotent, idempotent2, idemElem
, Model(..)
, meq, meq1, meq2, meq3, meq4, meq5
, eqModels, denotationFor
, Model1(..)
, arbs, gens
, (.&.)
, arbitrarySatisfying
) where
import Data.Function (on)
import Control.Applicative
import Control.Arrow ((***),first)
import qualified Control.Exception as Ex
import Data.List (foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Monoid hiding (First, Last)
import Data.Complex
import Data.Proxy
import Data.Ratio
import Data.Functor.Identity
#if __GLASGOW_HASKELL__ >= 800
import Data.Functor.Compose
import qualified Data.Functor.Product as F
import qualified Data.Functor.Sum as F
#endif
import Data.Semigroup
import GHC.Generics
import System.Random
import Test.QuickCheck hiding (generate)
import Test.QuickCheck.Random (QCGen, newQCGen)
import Test.QuickCheck.Gen (Gen (..))
import Test.QuickCheck.Utils
type Test = (String,Property)
type TestBatch = (String,[Test])
unbatch :: TestBatch -> [Test]
unbatch :: TestBatch -> [Test]
unbatch (String
batchName,[Test]
props) = (Test -> Test) -> [Test] -> [Test]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> Test -> Test
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((String
batchName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": ")String -> String -> String
forall a. [a] -> [a] -> [a]
++)) [Test]
props
type QuickCheckRunner = Args -> Property -> IO ()
checkBatch' :: QuickCheckRunner -> Args -> TestBatch -> IO ()
checkBatch' :: QuickCheckRunner -> Args -> TestBatch -> IO ()
checkBatch' QuickCheckRunner
runner Args
args (String
name,[Test]
tests) =
do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
(Test -> IO ()) -> [Test] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Test -> IO ()
pr [Test]
tests
where
pr :: Test -> IO ()
pr (String
s,Property
p) = do String -> IO ()
putStr (Int -> String -> String
padTo (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"))
IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Ex.catch (QuickCheckRunner
runner Args
args Property
p)
(SomeException -> IO ()
forall a. Show a => a -> IO ()
print :: Ex.SomeException -> IO ())
width :: Int
width = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ((Test -> Int) -> [Test] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length(String -> Int) -> (Test -> String) -> Test -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Test -> String
forall a b. (a, b) -> a
fst) [Test]
tests)
checkBatch :: Args -> TestBatch -> IO ()
checkBatch :: Args -> TestBatch -> IO ()
checkBatch = QuickCheckRunner -> Args -> TestBatch -> IO ()
checkBatch' QuickCheckRunner
forall prop. Testable prop => Args -> prop -> IO ()
quickCheckWith
padTo :: Int -> String -> String
padTo :: Int -> String -> String
padTo Int
n = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat Char
' ')
quickBatch :: TestBatch -> IO ()
quickBatch :: TestBatch -> IO ()
quickBatch = Args -> TestBatch -> IO ()
checkBatch Args
quick'
verboseBatch :: TestBatch -> IO ()
verboseBatch :: TestBatch -> IO ()
verboseBatch = QuickCheckRunner -> Args -> TestBatch -> IO ()
checkBatch' QuickCheckRunner
forall prop. Testable prop => Args -> prop -> IO ()
verboseCheckWith Args
quick'
quick' :: Args
quick' :: Args
quick' = Args
stdArgs { maxSuccess :: Int
maxSuccess = Int
500 }
type Unop a = a -> a
type Binop a = a -> a -> a
type FracT = Float
type NumT = Int
type OrdT = Int
type T = Char
genR :: Random a => (a, a) -> Gen a
genR :: (a, a) -> Gen a
genR (a
lo,a
hi) = (QCGen -> a) -> Gen QCGen -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, QCGen) -> a
forall a b. (a, b) -> a
fst ((a, QCGen) -> a) -> (QCGen -> (a, QCGen)) -> QCGen -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> QCGen -> (a, QCGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (a
lo,a
hi)) Gen QCGen
rand
involution :: (Show a, Arbitrary a, EqProp a) =>
(a -> a) -> Property
involution :: (a -> a) -> Property
involution a -> a
f = a -> a
f (a -> a) -> (a -> a) -> Property
forall b a.
(EqProp b, Arbitrary b, Show b) =>
(a -> b) -> (b -> a) -> Property
`inverseL` a -> a
f
inverseL :: (EqProp b, Arbitrary b, Show b) =>
(a -> b) -> (b -> a) -> Property
a -> b
f inverseL :: (a -> b) -> (b -> a) -> Property
`inverseL` b -> a
g = a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g (b -> b) -> (b -> b) -> Property
forall a. EqProp a => a -> a -> Property
=-= b -> b
forall a. a -> a
id
inverse :: ( EqProp a, Arbitrary a, Show a
, EqProp b, Arbitrary b, Show b ) =>
(a -> b) -> (b -> a) -> Property
a -> b
f inverse :: (a -> b) -> (b -> a) -> Property
`inverse` b -> a
g = a -> b
f (a -> b) -> (b -> a) -> Property
forall b a.
(EqProp b, Arbitrary b, Show b) =>
(a -> b) -> (b -> a) -> Property
`inverseL` b -> a
g Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&. b -> a
g (b -> a) -> (a -> b) -> Property
forall b a.
(EqProp b, Arbitrary b, Show b) =>
(a -> b) -> (b -> a) -> Property
`inverseL` a -> b
f
infix 4 =-=
class EqProp a where
(=-=) :: a -> a -> Property
default (=-=) :: (Generic a, GEqProp (Rep a)) => a -> a -> Property
(=-=) = Rep a Any -> Rep a Any -> Property
forall (g :: * -> *) x. GEqProp g => g x -> g x -> Property
geq (Rep a Any -> Rep a Any -> Property)
-> (a -> Rep a Any) -> a -> a -> Property
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
{-# INLINEABLE (=-=) #-}
class GEqProp g where
geq :: g x -> g x -> Property
instance GEqProp g => GEqProp (M1 _1 _2 g) where
geq :: M1 _1 _2 g x -> M1 _1 _2 g x -> Property
geq = g x -> g x -> Property
forall (g :: * -> *) x. GEqProp g => g x -> g x -> Property
geq (g x -> g x -> Property)
-> (M1 _1 _2 g x -> g x)
-> M1 _1 _2 g x
-> M1 _1 _2 g x
-> Property
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` M1 _1 _2 g x -> g x
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
{-# INLINEABLE geq #-}
instance (GEqProp g1, GEqProp g2) => GEqProp (g1 :*: g2) where
geq :: (:*:) g1 g2 x -> (:*:) g1 g2 x -> Property
geq (g1 x
g1a :*: g2 x
g1b) (g1 x
g2a :*: g2 x
g2b) = g1 x -> g1 x -> Property
forall (g :: * -> *) x. GEqProp g => g x -> g x -> Property
geq g1 x
g1a g1 x
g2a Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. g2 x -> g2 x -> Property
forall (g :: * -> *) x. GEqProp g => g x -> g x -> Property
geq g2 x
g1b g2 x
g2b
{-# INLINEABLE geq #-}
instance (GEqProp g1, GEqProp g2) => GEqProp (g1 :+: g2) where
geq :: (:+:) g1 g2 x -> (:+:) g1 g2 x -> Property
geq (L1 g1 x
g1) (L1 g1 x
g2) = g1 x -> g1 x -> Property
forall (g :: * -> *) x. GEqProp g => g x -> g x -> Property
geq g1 x
g1 g1 x
g2
geq (R1 g2 x
g1) (R1 g2 x
g2) = g2 x -> g2 x -> Property
forall (g :: * -> *) x. GEqProp g => g x -> g x -> Property
geq g2 x
g1 g2 x
g2
geq (:+:) g1 g2 x
_ (:+:) g1 g2 x
_ = Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
{-# INLINEABLE geq #-}
instance EqProp a => GEqProp (K1 _1 a) where
geq :: K1 _1 a x -> K1 _1 a x -> Property
geq = a -> a -> Property
forall a. EqProp a => a -> a -> Property
(=-=) (a -> a -> Property)
-> (K1 _1 a x -> a) -> K1 _1 a x -> K1 _1 a x -> Property
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` K1 _1 a x -> a
forall i c k (p :: k). K1 i c p -> c
unK1
{-# INLINEABLE geq #-}
instance GEqProp U1 where
geq :: U1 x -> U1 x -> Property
geq U1 x
U1 U1 x
U1 = Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
{-# INLINEABLE geq #-}
instance GEqProp V1 where
geq :: V1 x -> V1 x -> Property
geq V1 x
_ V1 x
_ = Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
{-# INLINEABLE geq #-}
eq :: Eq a => a -> a -> Property
a
a eq :: a -> a -> Property
`eq` a
a' = Bool -> Property
forall prop. Testable prop => prop -> Property
property (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a')
instance EqProp ()
instance EqProp Bool
instance EqProp Char where =-= :: Char -> Char -> Property
(=-=) = Char -> Char -> Property
forall a. Eq a => a -> a -> Property
eq
instance EqProp Ordering
instance EqProp Int where =-= :: Int -> Int -> Property
(=-=) = Int -> Int -> Property
forall a. Eq a => a -> a -> Property
eq
instance EqProp Float where =-= :: Float -> Float -> Property
(=-=) = Float -> Float -> Property
forall a. Eq a => a -> a -> Property
eq
instance EqProp Double where =-= :: Double -> Double -> Property
(=-=) = Double -> Double -> Property
forall a. Eq a => a -> a -> Property
eq
instance EqProp Integer where =-= :: Integer -> Integer -> Property
(=-=) = Integer -> Integer -> Property
forall a. Eq a => a -> a -> Property
eq
instance Eq a => EqProp (Complex a) where =-= :: Complex a -> Complex a -> Property
(=-=) = Complex a -> Complex a -> Property
forall a. Eq a => a -> a -> Property
eq
instance Eq a => EqProp (Ratio a) where =-= :: Ratio a -> Ratio a -> Property
(=-=) = Ratio a -> Ratio a -> Property
forall a. Eq a => a -> a -> Property
eq
instance EqProp a => EqProp (Min a)
instance EqProp a => EqProp (Max a)
instance EqProp a => EqProp (First a)
instance EqProp a => EqProp (Last a)
instance EqProp a => EqProp (Dual a)
instance (Show a, Arbitrary a, EqProp a) => EqProp (Endo a)
instance EqProp All
instance EqProp Any
instance EqProp a => EqProp (Sum a)
instance EqProp a => EqProp (Product a)
instance EqProp (f a) => EqProp (Alt f a)
#if __GLASGOW_HASKELL__ >= 806
instance EqProp (f a) => EqProp (Ap f a)
#endif
instance EqProp a => EqProp [a]
instance EqProp a => EqProp (NonEmpty a)
instance EqProp a => EqProp (ZipList a)
instance EqProp a => EqProp (Maybe a)
instance (EqProp a, EqProp b) => EqProp (a,b)
instance (EqProp a, EqProp b, EqProp c) => EqProp (a,b,c)
instance (EqProp a, EqProp b, EqProp c, EqProp d) => EqProp (a,b,c,d)
instance (EqProp a, EqProp b) => EqProp (Either a b)
#if __GLASGOW_HASKELL__ >= 800
instance EqProp (f (g a)) => EqProp (Compose f g a)
instance (EqProp (f a), EqProp (g a)) => EqProp (F.Sum f g a)
instance (EqProp (f a), EqProp (g a)) => EqProp (F.Product f g a)
#endif
instance EqProp a => EqProp (Identity a)
instance EqProp a => EqProp (Const a b)
instance EqProp (Proxy a)
instance (Show a, Arbitrary a, EqProp b) => EqProp (a -> b) where
a -> b
f =-= :: (a -> b) -> (a -> b) -> Property
=-= a -> b
f' = (a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((b -> b -> Property) -> (a -> b) -> (a -> b) -> a -> Property
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> Property
forall a. EqProp a => a -> a -> Property
(=-=) a -> b
f a -> b
f')
eqModels :: (Model a b, EqProp b) => a -> a -> Property
eqModels :: a -> a -> Property
eqModels = b -> b -> Property
forall a. EqProp a => a -> a -> Property
(=-=) (b -> b -> Property) -> (a -> b) -> a -> a -> Property
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
forall a b. Model a b => a -> b
model
denotationFor
:: (Model b b', Arbitrary a, EqProp b', Show a)
=> (a -> b')
-> (a -> b)
-> TestBatch
denotationFor :: (a -> b') -> (a -> b) -> TestBatch
denotationFor a -> b'
f a -> b
g =
( String
"denotation"
, [(String
"eq", b -> b'
forall a b. Model a b => a -> b
model (b -> b') -> (a -> b) -> a -> b'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g (a -> b') -> (a -> b') -> Property
forall a. EqProp a => a -> a -> Property
=-= a -> b'
f)]
)
type BinRel a = a -> a -> Bool
reflexive :: (Arbitrary a, Show a) =>
BinRel a -> Property
reflexive :: BinRel a -> Property
reflexive BinRel a
rel = (a -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> Bool) -> Property) -> (a -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
a -> a
a BinRel a
`rel` a
a
transitive :: (Arbitrary a, Show a) =>
BinRel a -> (a -> Gen a) -> Property
transitive :: BinRel a -> (a -> Gen a) -> Property
transitive BinRel a
rel a -> Gen a
gen =
(a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
a ->
Gen a -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (a -> Gen a
gen a
a) ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
b ->
Gen a -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (a -> Gen a
gen a
b) ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
c ->
(a
a BinRel a
`rel` a
b) Bool -> Bool -> Bool
&& (a
b BinRel a
`rel` a
c) Bool -> Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> (a
a BinRel a
`rel` a
c)
symmetric :: (Arbitrary a, Show a) =>
BinRel a -> (a -> Gen a) -> Property
symmetric :: BinRel a -> (a -> Gen a) -> Property
symmetric BinRel a
rel a -> Gen a
gen =
(a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
a ->
Gen a -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (a -> Gen a
gen a
a) ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
b ->
(a
a BinRel a
`rel` a
b) Bool -> Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> (a
b BinRel a
`rel` a
a)
antiSymmetric :: (Arbitrary a, Show a, Eq a) =>
BinRel a -> Property
antiSymmetric :: BinRel a -> Property
antiSymmetric BinRel a
rel =
(a -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> a -> Property) -> Property)
-> (a -> a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
a a
b -> (a
a BinRel a
`rel` a
b) Bool -> Bool -> Bool
&& (a
a BinRel a
forall a. Eq a => a -> a -> Bool
/= a
b) Bool -> Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> Bool -> Bool
not (a
b BinRel a
`rel` a
a)
leftId :: (Show a, Arbitrary a, EqProp a) => (i -> a -> a) -> i -> Property
leftId :: (i -> a -> a) -> i -> Property
leftId i -> a -> a
op i
i = (i
i i -> a -> a
`op`) (a -> a) -> (a -> a) -> Property
forall a. EqProp a => a -> a -> Property
=-= a -> a
forall a. a -> a
id
rightId :: (Show a, Arbitrary a, EqProp a) => (a -> i -> a) -> i -> Property
rightId :: (a -> i -> a) -> i -> Property
rightId a -> i -> a
op i
i = (a -> i -> a
`op` i
i) (a -> a) -> (a -> a) -> Property
forall a. EqProp a => a -> a -> Property
=-= a -> a
forall a. a -> a
id
bothId :: (Show a, Arbitrary a, EqProp a) => (a -> a -> a) -> a -> Property
bothId :: (a -> a -> a) -> a -> Property
bothId = (((a -> Property) -> (a -> Property) -> a -> Property)
-> ((a -> a -> a) -> a -> Property)
-> ((a -> a -> a) -> a -> Property)
-> (a -> a -> a)
-> a
-> Property
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2(((a -> Property) -> (a -> Property) -> a -> Property)
-> ((a -> a -> a) -> a -> Property)
-> ((a -> a -> a) -> a -> Property)
-> (a -> a -> a)
-> a
-> Property)
-> ((Property -> Property -> Property)
-> (a -> Property) -> (a -> Property) -> a -> Property)
-> (Property -> Property -> Property)
-> ((a -> a -> a) -> a -> Property)
-> ((a -> a -> a) -> a -> Property)
-> (a -> a -> a)
-> a
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Property -> Property -> Property)
-> (a -> Property) -> (a -> Property) -> a -> Property
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
(.&.) (a -> a -> a) -> a -> Property
forall a i.
(Show a, Arbitrary a, EqProp a) =>
(i -> a -> a) -> i -> Property
leftId (a -> a -> a) -> a -> Property
forall a i.
(Show a, Arbitrary a, EqProp a) =>
(a -> i -> a) -> i -> Property
rightId
isAssoc :: (EqProp a, Show a, Arbitrary a) => (a -> a -> a) -> Property
isAssoc :: (a -> a -> a) -> Property
isAssoc = (a -> a -> Property) -> Gen a -> (a -> a -> a) -> Property
forall a prop.
(Show a, Testable prop) =>
(a -> a -> prop) -> Gen a -> (a -> a -> a) -> Property
isAssociativeBy a -> a -> Property
forall a. EqProp a => a -> a -> Property
(=-=) Gen a
forall a. Arbitrary a => Gen a
arbitrary
commutes :: EqProp z => (a -> a -> z) -> a -> a -> Property
commutes :: (a -> a -> z) -> a -> a -> Property
commutes a -> a -> z
(#) a
a a
b = a
a a -> a -> z
# a
b z -> z -> Property
forall a. EqProp a => a -> a -> Property
=-= a
b a -> a -> z
# a
a
isCommut :: (EqProp a, Show a, Arbitrary a) => (a -> a -> a) -> Property
isCommut :: (a -> a -> a) -> Property
isCommut = (a -> a -> Property) -> Gen a -> (a -> a -> a) -> Property
forall a prop b.
(Show a, Testable prop) =>
(b -> b -> prop) -> Gen a -> (a -> a -> b) -> Property
isCommutableBy a -> a -> Property
forall a. EqProp a => a -> a -> Property
(=-=) Gen a
forall a. Arbitrary a => Gen a
arbitrary
data MonoidD a = MonoidD a (a -> a -> a)
monoidD :: Monoid a => MonoidD a
monoidD :: MonoidD a
monoidD = a -> (a -> a -> a) -> MonoidD a
forall a. a -> (a -> a -> a) -> MonoidD a
MonoidD a
forall a. Monoid a => a
mempty a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
endoMonoidD :: MonoidD (a -> a)
endoMonoidD :: MonoidD (a -> a)
endoMonoidD = (a -> a) -> ((a -> a) -> (a -> a) -> a -> a) -> MonoidD (a -> a)
forall a. a -> (a -> a -> a) -> MonoidD a
MonoidD a -> a
forall a. a -> a
id (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
homomorphism :: (EqProp b, Show a, Arbitrary a) =>
MonoidD a -> MonoidD b -> (a -> b) -> [(String,Property)]
homomorphism :: MonoidD a -> MonoidD b -> (a -> b) -> [Test]
homomorphism (MonoidD a
ida a -> a -> a
opa) (MonoidD b
idb b -> b -> b
opb) a -> b
q =
[ (String
"identity" , a -> b
q a
ida b -> b -> Property
forall a. EqProp a => a -> a -> Property
=-= b
idb)
, (String
"binop", (a -> a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> a -> Property) -> Property)
-> (a -> a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ a
u a
v -> a -> b
q (a
u a -> a -> a
`opa` a
v) b -> b -> Property
forall a. EqProp a => a -> a -> Property
=-= a -> b
q a
u b -> b -> b
`opb` a -> b
q a
v)
]
idempotent :: (Show a, Arbitrary a, EqProp a) =>
(a -> a) -> Property
idempotent :: (a -> a) -> Property
idempotent a -> a
f = ((a -> a) -> (a -> a) -> a -> a) -> (a -> a) -> Property
forall a. EqProp a => (a -> a -> a) -> a -> Property
idemElem (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) a -> a
f
idempotent2 :: (Show a, Arbitrary a, EqProp a) =>
(a -> a -> a) -> Property
idempotent2 :: (a -> a -> a) -> Property
idempotent2 = (a -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((a -> Property) -> Property)
-> ((a -> a -> a) -> a -> Property) -> (a -> a -> a) -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> a -> Property
forall a. EqProp a => (a -> a -> a) -> a -> Property
idemElem
idemElem :: EqProp a => (a -> a -> a) -> a -> Property
idemElem :: (a -> a -> a) -> a -> Property
idemElem a -> a -> a
op a
x = a
x a -> a -> a
`op` a
x a -> a -> Property
forall a. EqProp a => a -> a -> Property
=-= a
x
class Model a b | a -> b where
model :: a -> b
meq :: (Model a b, EqProp b) => a -> b -> Property
meq1 :: (Model a b, Model a1 b1, EqProp b) =>
(a1 -> a) -> (b1 -> b) -> a1 -> Property
meq2 :: (Model a b, Model a1 b1, Model a2 b2, EqProp b) =>
(a1 -> a2 -> a) -> (b1 -> b2 -> b) -> a1 -> a2 -> Property
meq3 :: (Model a b, Model a1 b1, Model a2 b2, Model a3 b3, EqProp b) =>
(a1 -> a2 -> a3 -> a)
-> (b1 -> b2 -> b3 -> b)
-> a1 -> a2 -> a3 -> Property
meq4 :: ( Model a b, Model a1 b1, Model a2 b2
, Model a3 b3, Model a4 b4, EqProp b) =>
(a1 -> a2 -> a3 -> a4 -> a)
-> (b1 -> b2 -> b3 -> b4 -> b)
-> a1 -> a2 -> a3 -> a4 -> Property
meq5 :: ( Model a b, Model a1 b1, Model a2 b2, Model a3 b3
, Model a4 b4, Model a5 b5, EqProp b) =>
(a1 -> a2 -> a3 -> a4 -> a5 -> a)
-> (b1 -> b2 -> b3 -> b4 -> b5 -> b)
-> a1 -> a2 -> a3 -> a4 -> a5 -> Property
meq :: a -> b -> Property
meq a
a b
b =
a -> b
forall a b. Model a b => a -> b
model a
a b -> b -> Property
forall a. EqProp a => a -> a -> Property
=-= b
b
meq1 :: (a1 -> a) -> (b1 -> b) -> a1 -> Property
meq1 a1 -> a
f b1 -> b
g = \a1
a ->
a -> b
forall a b. Model a b => a -> b
model (a1 -> a
f a1
a) b -> b -> Property
forall a. EqProp a => a -> a -> Property
=-= b1 -> b
g (a1 -> b1
forall a b. Model a b => a -> b
model a1
a)
meq2 :: (a1 -> a2 -> a) -> (b1 -> b2 -> b) -> a1 -> a2 -> Property
meq2 a1 -> a2 -> a
f b1 -> b2 -> b
g = \a1
a a2
b ->
a -> b
forall a b. Model a b => a -> b
model (a1 -> a2 -> a
f a1
a a2
b) b -> b -> Property
forall a. EqProp a => a -> a -> Property
=-= b1 -> b2 -> b
g (a1 -> b1
forall a b. Model a b => a -> b
model a1
a) (a2 -> b2
forall a b. Model a b => a -> b
model a2
b)
meq3 :: (a1 -> a2 -> a3 -> a)
-> (b1 -> b2 -> b3 -> b) -> a1 -> a2 -> a3 -> Property
meq3 a1 -> a2 -> a3 -> a
f b1 -> b2 -> b3 -> b
g = \a1
a a2
b a3
c ->
a -> b
forall a b. Model a b => a -> b
model (a1 -> a2 -> a3 -> a
f a1
a a2
b a3
c) b -> b -> Property
forall a. EqProp a => a -> a -> Property
=-= b1 -> b2 -> b3 -> b
g (a1 -> b1
forall a b. Model a b => a -> b
model a1
a) (a2 -> b2
forall a b. Model a b => a -> b
model a2
b) (a3 -> b3
forall a b. Model a b => a -> b
model a3
c)
meq4 :: (a1 -> a2 -> a3 -> a4 -> a)
-> (b1 -> b2 -> b3 -> b4 -> b) -> a1 -> a2 -> a3 -> a4 -> Property
meq4 a1 -> a2 -> a3 -> a4 -> a
f b1 -> b2 -> b3 -> b4 -> b
g = \a1
a a2
b a3
c a4
d ->
a -> b
forall a b. Model a b => a -> b
model (a1 -> a2 -> a3 -> a4 -> a
f a1
a a2
b a3
c a4
d) b -> b -> Property
forall a. EqProp a => a -> a -> Property
=-= b1 -> b2 -> b3 -> b4 -> b
g (a1 -> b1
forall a b. Model a b => a -> b
model a1
a) (a2 -> b2
forall a b. Model a b => a -> b
model a2
b) (a3 -> b3
forall a b. Model a b => a -> b
model a3
c) (a4 -> b4
forall a b. Model a b => a -> b
model a4
d)
meq5 :: (a1 -> a2 -> a3 -> a4 -> a5 -> a)
-> (b1 -> b2 -> b3 -> b4 -> b5 -> b)
-> a1
-> a2
-> a3
-> a4
-> a5
-> Property
meq5 a1 -> a2 -> a3 -> a4 -> a5 -> a
f b1 -> b2 -> b3 -> b4 -> b5 -> b
g = \a1
a a2
b a3
c a4
d a5
e ->
a -> b
forall a b. Model a b => a -> b
model (a1 -> a2 -> a3 -> a4 -> a5 -> a
f a1
a a2
b a3
c a4
d a5
e) b -> b -> Property
forall a. EqProp a => a -> a -> Property
=-= b1 -> b2 -> b3 -> b4 -> b5 -> b
g (a1 -> b1
forall a b. Model a b => a -> b
model a1
a) (a2 -> b2
forall a b. Model a b => a -> b
model a2
b) (a3 -> b3
forall a b. Model a b => a -> b
model a3
c) (a4 -> b4
forall a b. Model a b => a -> b
model a4
d) (a5 -> b5
forall a b. Model a b => a -> b
model a5
e)
instance Model Bool Bool where model :: Bool -> Bool
model = Bool -> Bool
forall a. a -> a
id
instance Model Char Char where model :: Char -> Char
model = Char -> Char
forall a. a -> a
id
instance Model Int Int where model :: Int -> Int
model = Int -> Int
forall a. a -> a
id
instance Model Float Float where model :: Float -> Float
model = Float -> Float
forall a. a -> a
id
instance Model Double Double where model :: Double -> Double
model = Double -> Double
forall a. a -> a
id
instance Model String String where model :: String -> String
model = String -> String
forall a. a -> a
id
instance (Model a b, Model a' b') => Model (a,a') (b,b') where
model :: (a, a') -> (b, b')
model = a -> b
forall a b. Model a b => a -> b
model (a -> b) -> (a' -> b') -> (a, a') -> (b, b')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** a' -> b'
forall a b. Model a b => a -> b
model
instance Model b b' => Model (a -> b) (a -> b') where
model :: (a -> b) -> a -> b'
model a -> b
f = b -> b'
forall a b. Model a b => a -> b
model (b -> b') -> (a -> b) -> a -> b'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
class Model1 f g | f -> g where
model1 :: forall a. f a -> g a
arbitrarySatisfying :: Arbitrary a => (a -> Bool) -> Gen a
arbitrarySatisfying :: (a -> Bool) -> Gen a
arbitrarySatisfying = (Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen a -> (a -> Bool) -> Gen a
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat`)
arbs :: Arbitrary a => Int -> IO [a]
arbs :: Int -> IO [a]
arbs Int
n = (QCGen -> [a]) -> IO QCGen -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ QCGen
rnd -> Int -> QCGen -> Gen [a] -> [a]
forall a. Int -> QCGen -> Gen a -> a
generate Int
n QCGen
rnd (Int -> Gen [a]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
n)) IO QCGen
newQCGen
gens :: Int -> Gen a -> IO [a]
gens :: Int -> Gen a -> IO [a]
gens Int
n Gen a
gen =
(QCGen -> [a]) -> IO QCGen -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ QCGen
rnd -> Int -> QCGen -> Gen [a] -> [a]
forall a. Int -> QCGen -> Gen a -> a
generate Int
1000 QCGen
rnd ([Gen a] -> Gen [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Int -> Gen a -> [Gen a]
forall a. Int -> a -> [a]
replicate Int
n Gen a
gen))) IO QCGen
newQCGen
instance Testable a => Testable [a] where
property :: [a] -> Property
property [] = Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
property [a]
props = (Int -> a) -> Property
forall prop. Testable prop => prop -> Property
property ((Int -> a) -> Property) -> (Int -> a) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
n -> [a]
props [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
len)
where len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
props
instance (Testable a, Testable b) => Testable (a,b) where
property :: (a, b) -> Property
property = (a -> b -> Property) -> (a, b) -> Property
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
(.&.)
rand :: Gen QCGen
rand :: Gen QCGen
rand = (QCGen -> Int -> QCGen) -> Gen QCGen
forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
_ -> QCGen
r)
generate :: Int -> QCGen -> Gen a -> a
generate :: Int -> QCGen -> Gen a -> a
generate Int
n QCGen
rnd (MkGen QCGen -> Int -> a
m) = QCGen -> Int -> a
m QCGen
rnd' Int
size
where
(Int
size, QCGen
rnd') = (Int, Int) -> QCGen -> (Int, QCGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
0, Int
n) QCGen
rnd