{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
module Test.QuickCheck.Classes.Monoid
( monoidLaws
, commutativeMonoidLaws
, semigroupMonoidLaws
) where
import Data.Semigroup
import Data.Monoid
import Data.Proxy (Proxy)
import Test.QuickCheck hiding ((.&.))
import Test.QuickCheck.Property (Property)
import Test.QuickCheck.Classes.Internal (Laws(..), SmallList(..), myForAllShrink)
monoidLaws :: (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
monoidLaws :: Proxy a -> Laws
monoidLaws Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Monoid"
[ (String
"Associative", Proxy a -> Property
forall a.
(Monoid a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
monoidAssociative Proxy a
p)
, (String
"Left Identity", Proxy a -> Property
forall a.
(Monoid a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
monoidLeftIdentity Proxy a
p)
, (String
"Right Identity", Proxy a -> Property
forall a.
(Monoid a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
monoidRightIdentity Proxy a
p)
, (String
"Concatenation", Proxy a -> Property
forall a.
(Monoid a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
monoidConcatenation Proxy a
p)
]
commutativeMonoidLaws :: (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
commutativeMonoidLaws :: Proxy a -> Laws
commutativeMonoidLaws Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Commutative Monoid"
[ (String
"Commutative", Proxy a -> Property
forall a.
(Monoid a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
monoidCommutative Proxy a
p)
]
semigroupMonoidLaws :: forall a. (Semigroup a, Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
semigroupMonoidLaws :: Proxy a -> Laws
semigroupMonoidLaws Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Semigroup/Monoid"
[ (String
"mappend == <>", Proxy a -> Property
forall a.
(Semigroup a, Monoid a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
semigroupMonoid Proxy a
p)
]
semigroupMonoid :: forall a. (Semigroup a, Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
semigroupMonoid :: Proxy a -> Property
semigroupMonoid Proxy a
_ = Bool
-> ((a, a) -> Bool)
-> ((a, a) -> [String])
-> String
-> ((a, a) -> a)
-> String
-> ((a, a) -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> (a, a) -> Bool
forall a b. a -> b -> a
const Bool
True)
(\(a
a :: a,a
b) -> [String
"a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a, String
"b = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b])
String
"mappend a b"
(\(a
a,a
b) -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
a a
b)
String
"a <> b"
(\(a
a,a
b) -> a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
Data.Semigroup.<> a
b)
monoidConcatenation :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
monoidConcatenation :: Proxy a -> Property
monoidConcatenation Proxy a
_ = Bool
-> (SmallList a -> Bool)
-> (SmallList a -> [String])
-> String
-> (SmallList a -> a)
-> String
-> (SmallList a -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> SmallList a -> Bool
forall a b. a -> b -> a
const Bool
True)
(\(SmallList ([a]
as :: [a])) -> [String
"as = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
as])
String
"mconcat as"
(\(SmallList [a]
as) -> [a] -> a
forall a. Monoid a => [a] -> a
mconcat [a]
as)
String
"foldr mappend mempty as"
(\(SmallList [a]
as) -> (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
forall a. Monoid a => a
mempty [a]
as)
monoidAssociative :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
monoidAssociative :: Proxy a -> Property
monoidAssociative Proxy a
_ = Bool
-> ((a, a, a) -> Bool)
-> ((a, a, a) -> [String])
-> String
-> ((a, a, a) -> a)
-> String
-> ((a, a, a) -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> (a, a, a) -> Bool
forall a b. a -> b -> a
const Bool
True)
(\(a
a :: a,a
b,a
c) -> [String
"a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a, String
"b = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b, String
"c = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c])
String
"mappend a (mappend b c)"
(\(a
a,a
b,a
c) -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
a (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
b a
c))
String
"mappend (mappend a b) c"
(\(a
a,a
b,a
c) -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
a a
b) a
c)
monoidLeftIdentity :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
monoidLeftIdentity :: Proxy a -> Property
monoidLeftIdentity Proxy a
_ = Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> a)
-> String
-> (a -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
False (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
(\(a
a :: a) -> [String
"a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a])
String
"mappend mempty a"
(\a
a -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
forall a. Monoid a => a
mempty a
a)
String
"a"
(\a
a -> a
a)
monoidRightIdentity :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
monoidRightIdentity :: Proxy a -> Property
monoidRightIdentity Proxy a
_ = Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> a)
-> String
-> (a -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
False (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
(\(a
a :: a) -> [String
"a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a])
String
"mappend a mempty"
(\a
a -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
a a
forall a. Monoid a => a
mempty)
String
"a"
(\a
a -> a
a)
monoidCommutative :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
monoidCommutative :: Proxy a -> Property
monoidCommutative Proxy a
_ = Bool
-> ((a, a) -> Bool)
-> ((a, a) -> [String])
-> String
-> ((a, a) -> a)
-> String
-> ((a, a) -> a)
-> Property
forall a b.
(Arbitrary a, Show b, Eq b) =>
Bool
-> (a -> Bool)
-> (a -> [String])
-> String
-> (a -> b)
-> String
-> (a -> b)
-> Property
myForAllShrink Bool
True (Bool -> (a, a) -> Bool
forall a b. a -> b -> a
const Bool
True)
(\(a
a :: a,a
b) -> [String
"a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a, String
"b = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b])
String
"mappend a b"
(\(a
a,a
b) -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
a a
b)
String
"mappend b a"
(\(a
a,a
b) -> a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
b a
a)