    {-# 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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 a. (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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 b. Integral b => b -> 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 a. (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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 b. Integral b => b -> 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 b. Integral b => b -> 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 b. Integral b => b -> 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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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 :: forall a.
    (Semigroup a, Eq a, Arbitrary a, Show a) =>
    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)