{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
module Hedgehog.Classes.Alternative (alternativeLaws) where
import Control.Applicative (Alternative(..))
import Hedgehog
import Hedgehog.Classes.Common
alternativeLaws ::
( Alternative f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Laws
alternativeLaws :: forall (f :: * -> *).
(Alternative f, forall x. Eq x => Eq (f x),
forall x. Show x => Show (f x)) =>
(forall x. Gen x -> Gen (f x)) -> Laws
alternativeLaws forall x. Gen x -> Gen (f x)
gen = String -> [(String, Property)] -> Laws
Laws String
"Alternative"
[ (String
"Left Identity", forall (f :: * -> *). AlternativeProp f
alternativeLeftIdentity forall x. Gen x -> Gen (f x)
gen)
, (String
"Right Identity", forall (f :: * -> *). AlternativeProp f
alternativeRightIdentity forall x. Gen x -> Gen (f x)
gen)
, (String
"Associativity", forall (f :: * -> *). AlternativeProp f
alternativeAssociativity forall x. Gen x -> Gen (f x)
gen)
]
type AlternativeProp f =
( Alternative f
, forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)
) => (forall x. Gen x -> Gen (f x)) -> Property
alternativeLeftIdentity :: forall f. AlternativeProp f
alternativeLeftIdentity :: forall (f :: * -> *). AlternativeProp f
alternativeLeftIdentity forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
f Integer
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
let lhs :: f Integer
lhs = forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f Integer
a
let rhs :: f Integer
rhs = f Integer
a
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Left Identity", lawContextLawBody :: String
lawContextLawBody = String
"empty <|> a" String -> String -> String
`congruency` String
"a"
, lawContextTcName :: String
lawContextTcName = String
"Alternative", lawContextTcProp :: String
lawContextTcProp =
let showA :: String
showA = forall a. Show a => a -> String
show f Integer
a;
in [String] -> String
lawWhere
[ String
"empty <|> a" String -> String -> String
`congruency` String
"a, where"
, String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced f Integer
lhs f Integer
rhs
}
forall (m :: * -> *) a (f :: * -> *).
(MonadTest m, HasCallStack, Eq a, Show a,
forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)) =>
f a -> f a -> Context -> m ()
heqCtx1 f Integer
lhs f Integer
rhs Context
ctx
alternativeRightIdentity :: forall f. AlternativeProp f
alternativeRightIdentity :: forall (f :: * -> *). AlternativeProp f
alternativeRightIdentity forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
f Integer
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
let lhs :: f Integer
lhs = f Integer
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Alternative f => f a
empty
let rhs :: f Integer
rhs = f Integer
a
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Right Identity", lawContextLawBody :: String
lawContextLawBody = String
"a <|> empty" String -> String -> String
`congruency` String
"a"
, lawContextTcName :: String
lawContextTcName = String
"Alternative", lawContextTcProp :: String
lawContextTcProp =
let showA :: String
showA = forall a. Show a => a -> String
show f Integer
a;
in [String] -> String
lawWhere
[ String
"a <|> empty" String -> String -> String
`congruency` String
"a, where"
, String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced f Integer
lhs f Integer
rhs
}
forall (m :: * -> *) a (f :: * -> *).
(MonadTest m, HasCallStack, Eq a, Show a,
forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)) =>
f a -> f a -> Context -> m ()
heqCtx1 f Integer
lhs f Integer
rhs Context
ctx
alternativeAssociativity :: forall f. AlternativeProp f
alternativeAssociativity :: forall (f :: * -> *). AlternativeProp f
alternativeAssociativity forall x. Gen x -> Gen (f x)
fgen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
f Integer
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
f Integer
b <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
f Integer
c <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall x. Gen x -> Gen (f x)
fgen Gen Integer
genSmallInteger
let lhs :: f Integer
lhs = (f Integer
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (f Integer
b forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f Integer
c))
let rhs :: f Integer
rhs = ((f Integer
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f Integer
b) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f Integer
c)
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Associativity", lawContextLawBody :: String
lawContextLawBody = String
"a <|> (b <|> c)" String -> String -> String
`congruency` String
"(a <|> b) <|> c"
, lawContextTcName :: String
lawContextTcName = String
"Alternative", lawContextTcProp :: String
lawContextTcProp =
let showA :: String
showA = forall a. Show a => a -> String
show f Integer
a; showB :: String
showB = forall a. Show a => a -> String
show f Integer
b; showC :: String
showC = forall a. Show a => a -> String
show f Integer
c;
in [String] -> String
lawWhere
[ String
"a <|> (b <|> c)" String -> String -> String
`congruency` String
"(a <|> b) <|> c), where"
, String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
, String
"b = " forall a. [a] -> [a] -> [a]
++ String
showB
, String
"c = " forall a. [a] -> [a] -> [a]
++ String
showC
]
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced f Integer
lhs f Integer
rhs
}
forall (m :: * -> *) a (f :: * -> *).
(MonadTest m, HasCallStack, Eq a, Show a,
forall x. Eq x => Eq (f x), forall x. Show x => Show (f x)) =>
f a -> f a -> Context -> m ()
heqCtx1 f Integer
lhs f Integer
rhs Context
ctx