    {-# LANGUAGE ScopedTypeVariables #-}

    module Hedgehog.Classes.Semigroup
      ( semigroupLaws
      , commutativeSemigroupLaws
      , exponentialSemigroupLaws
      , idempotentSemigroupLaws
      , rectangularBandSemigroupLaws
      ) where

    import Data.Semigroup (Semigroup(..))
    import Hedgehog
    import Hedgehog.Classes.Common
    import Data.List.NonEmpty
    import qualified Hedgehog.Gen as Gen
    import qualified Hedgehog.Range as Range
    import qualified Data.Foldable as Foldable

    -- | Tests the following 'Semigroup' laws:
    --
    -- [__Associativity__]: @a '<>' (b '<>' c)@ ≡ @(a '<>' b) '<>' c@
    -- [__Concatenation__]: @'sconcat'@ ≡ @'Foldable.foldr1' ('<>')@
    -- [__Times__]: @'stimes' n a@ ≡ @'foldr1' ('<>') ('replicate' n a)@
    semigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws
    semigroupLaws :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Laws
    semigroupLaws Gen a
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Semigroup"
      [ (String
    "Associativity", Gen a -> Property
    forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupAssociative Gen a
    gen)
      , (String
    "Concatenation", Gen a -> Property
    forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupConcatenation Gen a
    gen)
      , (String
    "Times", Gen a -> Property
    forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupTimes Gen a
    gen)
      ]

    -- | Tests the following 'Semigroup' laws:
    --
    -- [__Commutativity__]: @a '<>' b@ ≡ @b '<>' a@
    commutativeSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws
    commutativeSemigroupLaws :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Laws
    commutativeSemigroupLaws Gen a
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Commutative Semigroup"
      [ (String
    "Commutative", Gen a -> Property
    forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupCommutative Gen a
    gen)
      ]

    -- | Tests the following 'Semigroup' laws:
    --
    -- [__Exponentiality__]: @'stimes' n (a '<>' b)@ ≡ @'stimes' n a '<>' 'stimes' n b@
    exponentialSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws
    exponentialSemigroupLaws :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Laws
    exponentialSemigroupLaws Gen a
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Exponential Semigroup"
      [ (String
    "Exponential", Gen a -> Property
    forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupExponential Gen a
    gen)
      ]

    -- | Tests the following 'Semigroup' laws:
    --
    -- [__Idempotency__]: @a '<>' a@ ≡ @a@
    idempotentSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws
    idempotentSemigroupLaws :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Laws
    idempotentSemigroupLaws Gen a
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Idempotent Semigroup"
      [ (String
    "Idempotent", Gen a -> Property
    forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupIdempotent Gen a
    gen)
      ]

    -- | Tests the following 'Semigroup' laws:
    --
    -- [__Rectangular Bandedness__]: @a '<>' b '<>' a@ ≡ @a@
    rectangularBandSemigroupLaws :: (Eq a, Semigroup a, Show a) => Gen a -> Laws
    rectangularBandSemigroupLaws :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Laws
    rectangularBandSemigroupLaws Gen a
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Rectangular Band Semigroup"
      [ (String
    "Rectangular Band", Gen a -> Property
    forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupRectangularBand Gen a
    gen)
      ]

    semigroupAssociative :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupAssociative :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupAssociative Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      b <- forAll gen
      c <- forAll gen
      let lhs = 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)
      let rhs = (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
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Associativity", lawContextTcName :: String
    lawContextTcName = String
    "Semigroup"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "a <> (b <> c)" String -> String -> String
    `congruency` String
    "(a <> b) <> c"
            , lawContextReduced :: String
    lawContextReduced = a -> a -> String
    forall a. Show a => a -> a -> String
    reduced a
    lhs a
    rhs
            , lawContextTcProp :: String
    lawContextTcProp =
                let showA :: String
    showA = a -> String
    forall a. Show a => a -> String
    show a
    a; showB :: String
    showB = a -> String
    forall a. Show a => a -> String
    show a
    b; showC :: String
    showC = a -> String
    forall a. Show a => a -> String
    show a
    c;
                in [String] -> String
    lawWhere
                  [ String
    "a <> (b <> c)" String -> String -> String
    `congruency` String
    "(a <> b) <> c, where"
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  , String
    "b = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showB
                  , String
    "c = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showC
                  ]
            }
      heqCtx lhs rhs ctx

    semigroupCommutative :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupCommutative :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupCommutative Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      b <- forAll gen
      let lhs = a
    a a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    b
      let rhs = a
    b a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    a
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Commutativity", lawContextTcName :: String
    lawContextTcName = String
    "Semigroup"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "a <> b" String -> String -> String
    `congruency` String
    "b <> a"
            , lawContextReduced :: String
    lawContextReduced = a -> a -> String
    forall a. Show a => a -> a -> String
    reduced a
    lhs a
    rhs
            , lawContextTcProp :: String
    lawContextTcProp =
                let showA :: String
    showA = a -> String
    forall a. Show a => a -> String
    show a
    a; showB :: String
    showB = a -> String
    forall a. Show a => a -> String
    show a
    b;
                in [String] -> String
    lawWhere
                  [ String
    "a <> b" String -> String -> String
    `congruency` String
    "b <> a, where"
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  , String
    "b = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showB
                  ]
            }
      heqCtx lhs rhs ctx

    semigroupConcatenation :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupConcatenation :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupConcatenation Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      as <- forAll $ genSmallList gen
      let ne = a
    a a -> [a] -> NonEmpty a
    forall a. a -> [a] -> NonEmpty a
    :| [a]
    as
      let lhs = NonEmpty a -> a
    forall a. Semigroup a => NonEmpty a -> a
    sconcat NonEmpty a
    ne
      let rhs = (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
    Foldable.foldr1 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    (<>) NonEmpty a
    ne
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Concatenation", lawContextTcName :: String
    lawContextTcName = String
    "Semigroup"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "sconcat" String -> String -> String
    `congruency` String
    "foldr1 (<>)"
            , lawContextReduced :: String
    lawContextReduced = a -> a -> String
    forall a. Show a => a -> a -> String
    reduced a
    lhs a
    rhs
            , lawContextTcProp :: String
    lawContextTcProp =
                let showNE :: String
    showNE = NonEmpty a -> String
    forall a. Show a => a -> String
    show NonEmpty a
    ne;
                in [String] -> String
    lawWhere
                  [ String
    "sconcat ne" String -> String -> String
    `congruency` String
    "foldr1 (<>) ne, where"
                  , String
    "ne = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showNE
                  ]
            }
      heqCtx lhs rhs ctx

    semigroupTimes :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupTimes :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupTimes Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      n <- forAll (Gen.int (Range.linear 2 5))
      let lhs = 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
      let rhs = (a -> a -> a) -> [a] -> a
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    Foldable.foldr1 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    (<>) (Int -> a -> [a]
    forall a. Int -> a -> [a]
    replicate Int
    n a
    a)
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Times", lawContextTcName :: String
    lawContextTcName = String
    "Semigroup"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "stimes n a" String -> String -> String
    `congruency` String
    "foldr1 (<>) (replicate n a)"
            , lawContextReduced :: String
    lawContextReduced = a -> a -> String
    forall a. Show a => a -> a -> String
    reduced a
    lhs a
    rhs
            , lawContextTcProp :: String
    lawContextTcProp =
                let showN :: String
    showN = Int -> String
    forall a. Show a => a -> String
    show Int
    n; showA :: String
    showA = a -> String
    forall a. Show a => a -> String
    show a
    a;
                in [String] -> String
    lawWhere
                  [ String
    "stimes n a" String -> String -> String
    `congruency` String
    "foldr1 (<>) (replicate n a), where"
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  , String
    "n = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showN
                  ]
            }
      heqCtx lhs rhs ctx

    semigroupExponential :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupExponential :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupExponential Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      b <- forAll gen
      n <- forAll (Gen.int (Range.linear 2 5))
      let lhs = 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)
      let rhs = 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
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Exponential", lawContextTcName :: String
    lawContextTcName = String
    "Semigroup"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "stimes n (a <> b)" String -> String -> String
    `congruency` String
    "stimes n a <> stimes n b"
            , lawContextReduced :: String
    lawContextReduced = a -> a -> String
    forall a. Show a => a -> a -> String
    reduced a
    lhs a
    rhs
            , lawContextTcProp :: String
    lawContextTcProp =
                let showN :: String
    showN = Int -> String
    forall a. Show a => a -> String
    show Int
    n; showA :: String
    showA = a -> String
    forall a. Show a => a -> String
    show a
    a; showB :: String
    showB = a -> String
    forall a. Show a => a -> String
    show a
    b;
                in [String] -> String
    lawWhere
                  [ String
    "stimes n (a <> b)" String -> String -> String
    `congruency` String
    "stimes n a <> stimes n b, where"
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  , String
    "b = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showB
                  , String
    "n = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showN
                  ]
            }
      heqCtx lhs rhs ctx

    semigroupIdempotent :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupIdempotent :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupIdempotent Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      let lhs = a
    a a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    a
      let rhs = a
    a
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Idempotency", lawContextTcName :: String
    lawContextTcName = String
    "Semigroup"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "a <> a" String -> String -> String
    `congruency` String
    "a"
            , lawContextReduced :: String
    lawContextReduced = a -> a -> String
    forall a. Show a => a -> a -> String
    reduced a
    lhs a
    rhs
            , lawContextTcProp :: String
    lawContextTcProp =
                let showA :: String
    showA = a -> String
    forall a. Show a => a -> String
    show a
    a;
                in [String] -> String
    lawWhere
                  [ String
    "a <> a" String -> String -> String
    `congruency` String
    "a, where"
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  ]
            }
      heqCtx lhs rhs ctx

    semigroupRectangularBand :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupRectangularBand :: forall a. (Eq a, Semigroup a, Show a) => Gen a -> Property
    semigroupRectangularBand Gen a
    gen = HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
    forall a b. (a -> b) -> a -> b
    $ do
      a <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      b <- forAll gen
      let lhs = 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
      let rhs = a
    a
      let ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Rectangular Band", lawContextTcName :: String
    lawContextTcName = String
    "Semigroup"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "a <> b <> a" String -> String -> String
    `congruency` String
    "a"
            , lawContextReduced :: String
    lawContextReduced = a -> a -> String
    forall a. Show a => a -> a -> String
    reduced a
    lhs a
    rhs
            , lawContextTcProp :: String
    lawContextTcProp =
                let showA :: String
    showA = a -> String
    forall a. Show a => a -> String
    show a
    a; showB :: String
    showB = a -> String
    forall a. Show a => a -> String
    show a
    b;
                in [String] -> String
    lawWhere
                  [ String
    "a <> b <> a" String -> String -> String
    `congruency` String
    "a, where"
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  , String
    "b = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showB
                  ]
            }
      heqCtx lhs rhs ctx