{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
module Test.QuickCheck.Classes.Semigroup
(
semigroupLaws
, commutativeSemigroupLaws
, exponentialSemigroupLaws
, idempotentSemigroupLaws
, rectangularBandSemigroupLaws
) where
import Prelude hiding (foldr1)
import Data.Semigroup (Semigroup(..))
import Data.Proxy (Proxy)
import Test.QuickCheck hiding ((.&.))
import Test.QuickCheck.Property (Property)
import Test.QuickCheck.Classes.Internal (Laws(..), SmallList(..), myForAllShrink)
import Data.Foldable (foldr1,toList)
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List as L
semigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
semigroupLaws :: Proxy a -> Laws
semigroupLaws p :: Proxy a
p = String -> [(String, Property)] -> Laws
Laws "Semigroup"
[ ("Associative", Proxy a -> Property
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
semigroupAssociative Proxy a
p)
, ("Concatenation", Proxy a -> Property
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
semigroupConcatenation Proxy a
p)
, ("Times", Proxy a -> Property
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
semigroupTimes Proxy a
p)
]
commutativeSemigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
commutativeSemigroupLaws :: Proxy a -> Laws
commutativeSemigroupLaws p :: Proxy a
p = String -> [(String, Property)] -> Laws
Laws "Commutative Semigroup"
[ ("Commutative", Proxy a -> Property
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
semigroupCommutative Proxy a
p)
]
idempotentSemigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
idempotentSemigroupLaws :: Proxy a -> Laws
idempotentSemigroupLaws p :: Proxy a
p = String -> [(String, Property)] -> Laws
Laws "Idempotent Semigroup"
[ ("Idempotent", Proxy a -> Property
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
semigroupIdempotent Proxy a
p)
]
rectangularBandSemigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
rectangularBandSemigroupLaws :: Proxy a -> Laws
rectangularBandSemigroupLaws p :: Proxy a
p = String -> [(String, Property)] -> Laws
Laws "Rectangular Band Semigroup"
[ ("Rectangular Band", Proxy a -> Property
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
semigroupRectangularBand Proxy a
p)
]
exponentialSemigroupLaws :: (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
exponentialSemigroupLaws :: Proxy a -> Laws
exponentialSemigroupLaws p :: Proxy a
p = String -> [(String, Property)] -> Laws
Laws "Exponential Semigroup"
[ ("Exponential", Proxy a -> Property
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
semigroupExponential Proxy a
p)
]
semigroupAssociative :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
semigroupAssociative :: Proxy a -> Property
semigroupAssociative _ = 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,b :: a
b,c :: a
c) -> ["a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a, "b = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b, "c = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
c])
"a <> (b <> c)"
(\(a :: a
a,b :: a
b,c :: a
c) -> a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (a
b a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
c))
"(a <> b) <> c"
(\(a :: a
a,b :: a
b,c :: a
c) -> (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b) a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
c)
semigroupCommutative :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
semigroupCommutative :: Proxy a -> Property
semigroupCommutative _ = 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,b :: a
b) -> ["a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a, "b = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b])
"a <> b"
(\(a :: a
a,b :: a
b) -> a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
"b <> a"
(\(a :: a
a,b :: a
b) -> a
b a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a)
semigroupConcatenation :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
semigroupConcatenation :: Proxy a -> Property
semigroupConcatenation _ = Bool
-> ((a, SmallList a) -> Bool)
-> ((a, SmallList a) -> [String])
-> String
-> ((a, SmallList a) -> a)
-> String
-> ((a, 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 -> (a, SmallList a) -> Bool
forall a b. a -> b -> a
const Bool
True)
(\(a :: a
a, SmallList ([a]
as :: [a])) -> ["as = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NonEmpty a -> String
forall a. Show a => a -> String
show (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as)])
"sconcat as"
(\(a :: a
a, SmallList as :: [a]
as) -> NonEmpty a -> a
forall a. Semigroup a => NonEmpty a -> a
sconcat (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as))
"foldr1 (<>) as"
(\(a :: a
a, SmallList as :: [a]
as) -> (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as))
semigroupTimes :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
semigroupTimes :: Proxy a -> Property
semigroupTimes _ = Bool
-> ((a, Int) -> Bool)
-> ((a, Int) -> [String])
-> String
-> ((a, Int) -> a)
-> String
-> ((a, Int) -> 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 (\(_,n :: Int
n) -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
(\(a
a :: a, Int
n :: Int) -> ["a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a, "n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n])
"stimes n a"
(\(a :: a
a,n :: Int
n) -> Int -> a -> a
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
n a
a)
"foldr1 (<>) (replicate n a)"
(\(a :: a
a,n :: Int
n) -> (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
n a
a))
semigroupExponential :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
semigroupExponential :: Proxy a -> Property
semigroupExponential _ = Bool
-> ((a, a, Int) -> Bool)
-> ((a, a, Int) -> [String])
-> String
-> ((a, a, Int) -> a)
-> String
-> ((a, a, Int) -> 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 (\(_,_,n :: Int
n) -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0)
(\(a
a :: a, b :: a
b, Int
n :: Int) -> ["a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a, "b = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b, "n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n])
"stimes n (a <> b)"
(\(a :: a
a,b :: a
b,n :: Int
n) -> Int -> a -> a
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
n (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b))
"stimes n a <> stimes n b"
(\(a :: a
a,b :: a
b,n :: Int
n) -> Int -> a -> a
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
n a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Int -> a -> a
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
n a
b)
semigroupIdempotent :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
semigroupIdempotent :: Proxy a -> Property
semigroupIdempotent _ = 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) -> ["a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a])
"a <> a"
(\a :: a
a -> a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a)
"a"
(\a :: a
a -> a
a)
semigroupRectangularBand :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
semigroupRectangularBand :: Proxy a -> Property
semigroupRectangularBand _ = 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
False (Bool -> (a, a) -> Bool
forall a b. a -> b -> a
const Bool
True)
(\(a
a :: a, b :: a
b) -> ["a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a, "b = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b])
"a <> b <> a"
(\(a :: a
a,b :: a
b) -> a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a)
"a"
(\(a :: a
a,_) -> a
a)