{-# LANGUAGE ScopedTypeVariables #-}
module Hedgehog.Classes.Semigroup
( semigroupLaws
, commutativeSemigroupLaws
, exponentialSemigroupLaws
, idempotentSemigroupLaws
, rectangularBandSemigroupLaws
) where
import Data.Semigroup (Semigroup(..))
import Hedgehog
import Hedgehog.Classes.Common
import Data.List.NonEmpty
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import qualified Data.Foldable as Foldable
semigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws
semigroupLaws :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Laws
semigroupLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Semigroup"
[ (String
"Associativity", forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupAssociative Gen a
gen)
, (String
"Concatenation", forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupConcatenation Gen a
gen)
, (String
"Times", forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupTimes Gen a
gen)
]
commutativeSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws
commutativeSemigroupLaws :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Laws
commutativeSemigroupLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Commutative Semigroup"
[ (String
"Commutative", forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupCommutative Gen a
gen)
]
exponentialSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws
exponentialSemigroupLaws :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Laws
exponentialSemigroupLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Exponential Semigroup"
[ (String
"Exponential", forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupExponential Gen a
gen)
]
idempotentSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws
idempotentSemigroupLaws :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Laws
idempotentSemigroupLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Idempotent Semigroup"
[ (String
"Idempotent", forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupIdempotent Gen a
gen)
]
rectangularBandSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws
rectangularBandSemigroupLaws :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Laws
rectangularBandSemigroupLaws Gen a
gen = String -> [(String, Property)] -> Laws
Laws String
"Rectangular Band Semigroup"
[ (String
"Rectangular Band", forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupRectangularBand Gen a
gen)
]
semigroupAssociative :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupAssociative :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupAssociative Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
a
b <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
a
c <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
let lhs :: a
lhs = a
a forall a. Semigroup a => a -> a -> a
<> (a
b forall a. Semigroup a => a -> a -> a
<> a
c)
let rhs :: a
rhs = (a
a forall a. Semigroup a => a -> a -> a
<> a
b) forall a. Semigroup a => a -> a -> a
<> a
c
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Associativity", lawContextTcName :: String
lawContextTcName = String
"Semigroup"
, lawContextLawBody :: String
lawContextLawBody = String
"a <> (b <> c)" String -> String -> String
`congruency` String
"(a <> b) <> c"
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
, lawContextTcProp :: String
lawContextTcProp =
let showA :: String
showA = forall a. Show a => a -> String
show a
a; showB :: String
showB = forall a. Show a => a -> String
show a
b; showC :: String
showC = forall a. Show a => a -> String
show a
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
]
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx
semigroupCommutative :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupCommutative :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupCommutative Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
a
b <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
let lhs :: a
lhs = a
a forall a. Semigroup a => a -> a -> a
<> a
b
let rhs :: a
rhs = a
b forall a. Semigroup a => a -> a -> a
<> a
a
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Commutativity", lawContextTcName :: String
lawContextTcName = String
"Semigroup"
, lawContextLawBody :: String
lawContextLawBody = String
"a <> b" String -> String -> String
`congruency` String
"b <> a"
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
, lawContextTcProp :: String
lawContextTcProp =
let showA :: String
showA = forall a. Show a => a -> String
show a
a; showB :: String
showB = forall a. Show a => a -> String
show a
b;
in [String] -> String
lawWhere
[ String
"a <> b" String -> String -> String
`congruency` String
"b <> a, where"
, String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
, String
"b = " forall a. [a] -> [a] -> [a]
++ String
showB
]
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx
semigroupConcatenation :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupConcatenation :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupConcatenation Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
[a]
as <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll forall a b. (a -> b) -> a -> b
$ forall a. Gen a -> Gen [a]
genSmallList Gen a
gen
let ne :: NonEmpty a
ne = a
a forall a. a -> [a] -> NonEmpty a
:| [a]
as
let lhs :: a
lhs = forall a. Semigroup a => NonEmpty a -> a
sconcat NonEmpty a
ne
let rhs :: a
rhs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Foldable.foldr1 forall a. Semigroup a => a -> a -> a
(<>) NonEmpty a
ne
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Concatenation", lawContextTcName :: String
lawContextTcName = String
"Semigroup"
, lawContextLawBody :: String
lawContextLawBody = String
"sconcat" String -> String -> String
`congruency` String
"foldr1 (<>)"
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
, lawContextTcProp :: String
lawContextTcProp =
let showNE :: String
showNE = forall a. Show a => a -> String
show NonEmpty a
ne;
in [String] -> String
lawWhere
[ String
"sconcat ne" String -> String -> String
`congruency` String
"foldr1 (<>) ne, where"
, String
"ne = " forall a. [a] -> [a] -> [a]
++ String
showNE
]
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx
semigroupTimes :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupTimes :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupTimes Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
Int
n <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
2 Int
5))
let lhs :: a
lhs = forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
n a
a
let rhs :: a
rhs = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Foldable.foldr1 forall a. Semigroup a => a -> a -> a
(<>) (forall a. Int -> a -> [a]
replicate Int
n a
a)
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Times", lawContextTcName :: String
lawContextTcName = String
"Semigroup"
, lawContextLawBody :: String
lawContextLawBody = String
"stimes n a" String -> String -> String
`congruency` String
"foldr1 (<>) (replicate n a)"
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
, lawContextTcProp :: String
lawContextTcProp =
let showN :: String
showN = forall a. Show a => a -> String
show Int
n; showA :: String
showA = forall a. Show a => a -> String
show a
a;
in [String] -> String
lawWhere
[ String
"stimes n a" String -> String -> String
`congruency` String
"foldr1 (<>) (replicate n a), where"
, String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
, String
"n = " forall a. [a] -> [a] -> [a]
++ String
showN
]
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx
semigroupExponential :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupExponential :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupExponential Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
a
b <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
Int
n <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
2 Int
5))
let lhs :: a
lhs = forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
n (a
a forall a. Semigroup a => a -> a -> a
<> a
b)
let rhs :: a
rhs = forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
n a
a forall a. Semigroup a => a -> a -> a
<> forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
n a
b
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Exponential", lawContextTcName :: String
lawContextTcName = String
"Semigroup"
, lawContextLawBody :: String
lawContextLawBody = String
"stimes n (a <> b)" String -> String -> String
`congruency` String
"stimes n a <> stimes n b"
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
, lawContextTcProp :: String
lawContextTcProp =
let showN :: String
showN = forall a. Show a => a -> String
show Int
n; showA :: String
showA = forall a. Show a => a -> String
show a
a; showB :: String
showB = forall a. Show a => a -> String
show a
b;
in [String] -> String
lawWhere
[ String
"stimes n (a <> b)" String -> String -> String
`congruency` String
"stimes n a <> stimes n b, where"
, String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
, String
"b = " forall a. [a] -> [a] -> [a]
++ String
showB
, String
"n = " forall a. [a] -> [a] -> [a]
++ String
showN
]
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx
semigroupIdempotent :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupIdempotent :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupIdempotent Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
let lhs :: a
lhs = a
a forall a. Semigroup a => a -> a -> a
<> a
a
let rhs :: a
rhs = a
a
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Idempotency", lawContextTcName :: String
lawContextTcName = String
"Semigroup"
, lawContextLawBody :: String
lawContextLawBody = String
"a <> a" String -> String -> String
`congruency` String
"a"
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
, lawContextTcProp :: String
lawContextTcProp =
let showA :: String
showA = forall a. Show a => a -> String
show a
a;
in [String] -> String
lawWhere
[ String
"a <> a" String -> String -> String
`congruency` String
"a, where"
, String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
]
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx
semigroupRectangularBand :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupRectangularBand :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
semigroupRectangularBand Gen a
gen = HasCallStack => PropertyT IO () -> Property
property forall a b. (a -> b) -> a -> b
$ do
a
a <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
a
b <- forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen a
gen
let lhs :: a
lhs = a
a forall a. Semigroup a => a -> a -> a
<> a
b forall a. Semigroup a => a -> a -> a
<> a
a
let rhs :: a
rhs = a
a
let ctx :: Context
ctx = LawContext -> Context
contextualise forall a b. (a -> b) -> a -> b
$ LawContext
{ lawContextLawName :: String
lawContextLawName = String
"Rectangular Band", lawContextTcName :: String
lawContextTcName = String
"Semigroup"
, lawContextLawBody :: String
lawContextLawBody = String
"a <> b <> a" String -> String -> String
`congruency` String
"a"
, lawContextReduced :: String
lawContextReduced = forall a. Show a => a -> a -> String
reduced a
lhs a
rhs
, lawContextTcProp :: String
lawContextTcProp =
let showA :: String
showA = forall a. Show a => a -> String
show a
a; showB :: String
showB = forall a. Show a => a -> String
show a
b;
in [String] -> String
lawWhere
[ String
"a <> b <> a" String -> String -> String
`congruency` String
"a, where"
, String
"a = " forall a. [a] -> [a] -> [a]
++ String
showA
, String
"b = " forall a. [a] -> [a] -> [a]
++ String
showB
]
}
forall (m :: * -> *) a.
(MonadTest m, HasCallStack, Eq a, Show a) =>
a -> a -> Context -> m ()
heqCtx a
lhs a
rhs Context
ctx