{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Semigroup
  ( -- * Laws
    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

-- | Tests the following properties:
--
-- [/Associative/]
--   @a '<>' (b '<>' c) ≡ (a '<>' b) '<>' c@
-- [/Concatenation/]
--   @'sconcat' as ≡ 'foldr1' ('<>') as@
-- [/Times/]
--   @'stimes' n a ≡ 'foldr1' ('<>') ('replicate' n a)@
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)
  ]

-- | Tests the following properties:
--
-- [/Commutative/]
--   @a '<>' b ≡ b '<>' a@
--
-- Note that this does not test associativity. Make sure to use
-- 'semigroupLaws' in addition to this set of laws.
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)
  ]

-- | Tests the following properties:
--
-- [/Idempotent/]
--   @a '<>' a ≡ a@
--
-- Note that this does not test associativity. Make sure to use
-- 'semigroupLaws' in addition to this set of laws. In literature,
-- this class of semigroup is known as a band.
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)
  ]

-- | Tests the following properties:
--
-- [/Rectangular Band/]
--   @a '<>' b '<>' a ≡ a@
--
-- Note that this does not test associativity. Make sure to use
-- 'semigroupLaws' in addition to this set of laws.
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)
  ]

-- | Tests the following properties:
--
-- [/Exponential/]
--   @'stimes' n (a '<>' b) ≡ 'stimes' n a '<>' 'stimes' n b@
--
-- Note that this does not test associativity. Make sure to use
-- 'semigroupLaws' in addition to this set of laws.
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)