{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if HAVE_QUANTIFIED_CONSTRAINTS
{-# LANGUAGE QuantifiedConstraints #-}
#endif
{-# OPTIONS_GHC -Wall #-}
module Test.QuickCheck.Classes.Apply
(
#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS)
applyLaws
#endif
) where
#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS)
import Data.Functor
import qualified Data.Functor.Apply as FunctorApply
import Test.QuickCheck hiding ((.&.))
import Test.QuickCheck.Arbitrary (Arbitrary1(..))
import Data.Functor.Classes (Eq1,Show1)
import Test.QuickCheck.Property (Property)
import Test.QuickCheck.Classes.Internal
type ApplyProp proxy f =
#if HAVE_QUANTIFIED_CONSTRAINTS
(FunctorApply.Apply f, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x), forall x. Arbitrary x => Arbitrary (f x))
#else
(FunctorApply.Apply f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
=> proxy f -> Property
applyLaws ::
#if HAVE_QUANTIFIED_CONSTRAINTS
(FunctorApply.Apply f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
(FunctorApply.Apply f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
=> proxy f -> Laws
applyLaws :: proxy f -> Laws
applyLaws proxy f
p = String -> [(String, Property)] -> Laws
Laws String
"Apply"
[ (String
"LiftF2 part 1", proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *). ApplyProp proxy f
applyLiftF2_1 proxy f
p)
, (String
"Associativity", proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *). ApplyProp proxy f
applyAssociativity proxy f
p)
]
applyLiftF2_1 :: forall proxy f. ApplyProp proxy f
applyLiftF2_1 :: proxy f -> Property
applyLiftF2_1 proxy f
_ = (Apply f QuadraticEquation -> Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f QuadraticEquation -> Apply f Integer -> Bool)
-> Property)
-> (Apply f QuadraticEquation -> Apply f Integer -> Bool)
-> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f QuadraticEquation
f' :: f QuadraticEquation)) (Apply (f Integer
x :: f Integer)) ->
let f :: f (Integer -> Integer)
f = (QuadraticEquation -> Integer -> Integer)
-> f QuadraticEquation -> f (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QuadraticEquation -> Integer -> Integer
runQuadraticEquation f QuadraticEquation
f'
in f Integer -> f Integer -> Bool
forall (f :: * -> *) a.
(forall x. Eq x => Eq (f x), Eq a) =>
f a -> f a -> Bool
eq1 (((Integer -> Integer) -> Integer -> Integer)
-> f (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b c.
Apply f =>
(a -> b -> c) -> f a -> f b -> f c
FunctorApply.liftF2 (Integer -> Integer) -> Integer -> Integer
forall a. a -> a
id f (Integer -> Integer)
f f Integer
x) (f (Integer -> Integer)
f f (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
FunctorApply.<.> f Integer
x)
applyAssociativity :: forall proxy f. ApplyProp proxy f
applyAssociativity :: proxy f -> Property
applyAssociativity proxy f
_ = (Apply f QuadraticEquation
-> Apply f QuadraticEquation -> Apply f Integer -> Bool)
-> Property
forall prop. Testable prop => prop -> Property
property ((Apply f QuadraticEquation
-> Apply f QuadraticEquation -> Apply f Integer -> Bool)
-> Property)
-> (Apply f QuadraticEquation
-> Apply f QuadraticEquation -> Apply f Integer -> Bool)
-> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f QuadraticEquation
u' :: f QuadraticEquation)) (Apply (f QuadraticEquation
v' :: f QuadraticEquation)) (Apply (f Integer
w :: f Integer)) ->
let u :: f (Integer -> Integer)
u = (QuadraticEquation -> Integer -> Integer)
-> f QuadraticEquation -> f (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QuadraticEquation -> Integer -> Integer
runQuadraticEquation f QuadraticEquation
u'
v :: f (Integer -> Integer)
v = (QuadraticEquation -> Integer -> Integer)
-> f QuadraticEquation -> f (Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QuadraticEquation -> Integer -> Integer
runQuadraticEquation f QuadraticEquation
v'
in f Integer -> f Integer -> Bool
forall (f :: * -> *) a.
(forall x. Eq x => Eq (f x), Eq a) =>
f a -> f a -> Bool
eq1 (((Integer -> Integer)
-> (Integer -> Integer) -> Integer -> Integer)
-> f (Integer -> Integer)
-> f ((Integer -> Integer) -> Integer -> Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) f (Integer -> Integer)
u f ((Integer -> Integer) -> Integer -> Integer)
-> f (Integer -> Integer) -> f (Integer -> Integer)
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
FunctorApply.<.> f (Integer -> Integer)
v f (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
FunctorApply.<.> f Integer
w) (f (Integer -> Integer)
u f (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
FunctorApply.<.> (f (Integer -> Integer)
v f (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
FunctorApply.<.> f Integer
w))
#endif