{-# 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 Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Semigroup"
  [ (String
"Associative", Proxy a -> Property
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
semigroupAssociative Proxy a
p)
  , (String
"Concatenation", Proxy a -> Property
forall a.
(Semigroup a, Eq a, Arbitrary a, Show a) =>
Proxy a -> Property
semigroupConcatenation Proxy a
p)
  , (String
"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 Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Commutative Semigroup"
  [ (String
"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 Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Idempotent Semigroup"
  [ (String
"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 Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Rectangular Band Semigroup"
  [ (String
"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 Proxy a
p = String -> [(String, Property)] -> Laws
Laws String
"Exponential Semigroup"
  [ (String
"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 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
"a <> (b <> c)"
  (\(a
a,a
b,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))
  String
"(a <> b) <> c"
  (\(a
a,a
b,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 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
"a <> b"
  (\(a
a,a
b) -> a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
  String
"b <> a"
  (\(a
a,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 Proxy a
_ = 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, SmallList ([a]
as :: [a])) -> [String
"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)])
  String
"sconcat as"
  (\(a
a, SmallList [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))
  String
"foldr1 (<>) as"
  (\(a
a, SmallList [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 Proxy a
_ = 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 (\(a
_,Int
n) -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
  (\(a
a :: a, Int
n :: Int) -> [String
"a = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
a, String
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n])
  String
"stimes n a"
  (\(a
a,Int
n) -> Int -> a -> a
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Int
n a
a)
  String
"foldr1 (<>) (replicate n a)"
  (\(a
a,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 Proxy a
_ = 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 (\(a
_,a
_,Int
n) -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
  (\(a
a :: a, a
b, Int
n :: Int) -> [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
"n = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n])
  String
"stimes n (a <> b)"
  (\(a
a,a
b,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))
  String
"stimes n a <> stimes n b"
  (\(a
a,a
b,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 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
"a <> a"
  (\a
a -> a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a)
  String
"a"
  (\a
a -> a
a)

semigroupRectangularBand :: forall a. (Semigroup a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
semigroupRectangularBand :: Proxy a -> Property
semigroupRectangularBand 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
False (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
"a <> b <> a"
  (\(a
a,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)
  String
"a"
  (\(a
a,a
_) -> a
a)