    {-# LANGUAGE ScopedTypeVariables #-}

    module Hedgehog.Classes.Monoid (monoidLaws, commutativeMonoidLaws) where

    import Hedgehog
    import Hedgehog.Classes.Common

    -- | Tests the following 'Monoid' laws:
    --
    -- [__Left Identity__]: @'mappend' 'mempty'@ ≡ @'id'@
    -- [__Right Identity__]: @'flip' 'mappend' 'mempty'@ ≡ @'id'@
    -- [__Associativity__]: @'mappend' a ('mappend' b c)@ ≡ @'mappend' ('mappend' a b) c@
    -- [__Concatenation__]: @'mconcat'@ ≡ @'foldr' 'mappend' 'mempty'@
    monoidLaws :: (Eq a, Monoid a, Show a) => Gen a -> Laws
    monoidLaws :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Laws
    monoidLaws Gen a
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Monoid"
      [ (String
    "Left Identity", Gen a -> Property
    forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidLeftIdentity Gen a
    gen)
      , (String
    "Right Identity", Gen a -> Property
    forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidRightIdentity Gen a
    gen)
      , (String
    "Associativity", Gen a -> Property
    forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidAssociative Gen a
    gen)
      , (String
    "Concatenation", Gen a -> Property
    forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidConcatenation Gen a
    gen)
      ]

    -- | Tests the following 'Monoid' laws:
    --
    -- [__Commutativity__]: @'mappend' a b@ ≡ @'mappend' b a@
    commutativeMonoidLaws :: (Eq a, Monoid a, Show a) => Gen a -> Laws
    commutativeMonoidLaws :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Laws
    commutativeMonoidLaws Gen a
    gen = String -> [(String, Property)] -> Laws
    Laws String
    "Commutative Monoid"
      [ (String
    "Commutativity", Gen a -> Property
    forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidCommutative Gen a
    gen)
      ]

    monoidConcatenation :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidConcatenation :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidConcatenation 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]
    as <- Gen [a] -> PropertyT IO [a]
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll (Gen [a] -> PropertyT IO [a]) -> Gen [a] -> PropertyT IO [a]
    forall a b. (a -> b) -> a -> b
    $ Gen a -> Gen [a]
    forall a. Gen a -> Gen [a]
    genSmallList Gen a
    gen
      let lhs :: a
    lhs = [a] -> a
    forall a. Monoid a => [a] -> a
    mconcat [a]
    as
      let rhs :: a
    rhs = (a -> a -> a) -> a -> [a] -> a
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    forall a. Monoid a => a
    mempty [a]
    as
      let ctx :: Context
    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
    "Monoid"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "mconcat" String -> String -> String
    `congruency` String
    "foldr mappend mempty"
            , lawContextReduced :: String
    lawContextReduced = a -> a -> String
    forall a. Show a => a -> a -> String
    reduced a
    lhs a
    rhs
            , lawContextTcProp :: String
    lawContextTcProp =
                let showAS :: String
    showAS = [a] -> String
    forall a. Show a => a -> String
    show [a]
    as; showMempty :: String
    showMempty = a -> String
    forall a. Show a => a -> String
    show (a
    forall a. Monoid a => a
    mempty :: a);
                in [String] -> String
    lawWhere
                  [ String
    "mconcat as" String -> String -> String
    `congruency` String
    "foldr mappend mempty as, where"
                  , String
    "as = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showAS
                  , String
    "mempty = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showMempty
                  ]
            }
      a -> a -> Context -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack, Eq a, Show a) =>
    a -> a -> Context -> m ()
    heqCtx a
    lhs a
    rhs Context
    ctx

    monoidAssociative :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidAssociative :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidAssociative 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
    a <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      a
    b <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      a
    c <- 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
    lhs = a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    a (a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    b a
    c)
      let rhs :: a
    rhs = a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend (a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    a a
    b) a
    c
      let ctx :: Context
    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
    "Monoid"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "mappend a (mappend b c)" String -> String -> String
    `congruency` String
    "mappend (mappend 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
    "mappend a (mappend b c)" String -> String -> String
    `congruency` String
    "mappend (mappend 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
                  ]
            }
      a -> a -> Context -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack, Eq a, Show a) =>
    a -> a -> Context -> m ()
    heqCtx a
    lhs a
    rhs Context
    ctx

    monoidLeftIdentity :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidLeftIdentity :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidLeftIdentity 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
    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
    lhs = a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    forall a. Monoid a => a
    mempty a
    a
      let rhs :: a
    rhs = a
    a
      let ctx :: Context
    ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Left Identity", lawContextTcName :: String
    lawContextTcName = String
    "Monoid"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "mappend mempty" String -> String -> String
    `congruency` String
    "id"
            , 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; showMempty :: String
    showMempty = a -> String
    forall a. Show a => a -> String
    show (a
    forall a. Monoid a => a
    mempty :: a);
                in [String] -> String
    lawWhere
                  [ String
    "mappend mempty a" String -> String -> String
    `congruency` String
    "a, where"
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  , String
    "mempty = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showMempty
                  ]
            }
      a -> a -> Context -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack, Eq a, Show a) =>
    a -> a -> Context -> m ()
    heqCtx a
    lhs a
    rhs Context
    ctx

    monoidRightIdentity :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidRightIdentity :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidRightIdentity 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
    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
    lhs = a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    a a
    forall a. Monoid a => a
    mempty
      let rhs :: a
    rhs = a
    a
      let ctx :: Context
    ctx = LawContext -> Context
    contextualise (LawContext -> Context) -> LawContext -> Context
    forall a b. (a -> b) -> a -> b
    $ LawContext
            { lawContextLawName :: String
    lawContextLawName = String
    "Right Identity", lawContextTcName :: String
    lawContextTcName = String
    "Monoid"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "flip mappend mempty" String -> String -> String
    `congruency` String
    "id"
            , 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; showMempty :: String
    showMempty = a -> String
    forall a. Show a => a -> String
    show (a
    forall a. Monoid a => a
    mempty :: a);
                in [String] -> String
    lawWhere
                  [ String
    "mappend a mempty" String -> String -> String
    `congruency` String
    "a, where"
                  , String
    "a = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showA
                  , String
    "mempty = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    showMempty
                  ]
            }
      a -> a -> Context -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack, Eq a, Show a) =>
    a -> a -> Context -> m ()
    heqCtx a
    lhs a
    rhs Context
    ctx

    monoidCommutative :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidCommutative :: forall a. (Eq a, Monoid a, Show a) => Gen a -> Property
    monoidCommutative 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
    a <- Gen a -> PropertyT IO a
    forall (m :: * -> *) a.
    (Monad m, Show a, HasCallStack) =>
    Gen a -> PropertyT m a
    forAll Gen a
    gen
      a
    b <- 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
    lhs = a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    a a
    b
      let rhs :: a
    rhs = a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    b a
    a
      let ctx :: Context
    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
    "Monoid (Commutative)"
            , lawContextLawBody :: String
    lawContextLawBody = String
    "mappend" String -> String -> String
    `congruency` String
    "flip mappend"
            , 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
    "mappend a b" String -> String -> String
    `congruency` String
    "mappend 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
                  ]
            }
      a -> a -> Context -> PropertyT IO ()
    forall (m :: * -> *) a.
    (MonadTest m, HasCallStack, Eq a, Show a) =>
    a -> a -> Context -> m ()
    heqCtx a
    lhs a
    rhs Context
    ctx