    {-# LANGUAGE ScopedTypeVariables #-}

    {-# OPTIONS_GHC -Wall #-}

    module Test.QuickCheck.Classes.Monoid
      ( monoidLaws
      , commutativeMonoidLaws
      , semigroupMonoidLaws
      ) where

    import Data.Semigroup
    import Data.Monoid
    import Data.Proxy (Proxy)
    import Test.QuickCheck hiding ((.&.))
    import Test.QuickCheck.Property (Property)

    import Test.QuickCheck.Classes.Internal (Laws(..), SmallList(..), myForAllShrink)

    -- | Tests the following properties:
    --
    -- [/Associative/]
    --   @mappend a (mappend b c) ≡ mappend (mappend a b) c@
    -- [/Left Identity/]
    --   @mappend mempty a ≡ a@
    -- [/Right Identity/]
    --   @mappend a mempty ≡ a@
    -- [/Concatenation/]
    --   @mconcat as ≡ foldr mappend mempty as@
    monoidLaws :: (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
    monoidLaws :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
    monoidLaws Proxy a
    p = String -> [(String, Property)] -> Laws
    Laws String
    "Monoid"
      [ (String
    "Associative", Proxy a -> Property
    forall a.
    (Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    monoidAssociative Proxy a
    p)
      , (String
    "Left Identity", Proxy a -> Property
    forall a.
    (Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    monoidLeftIdentity Proxy a
    p)
      , (String
    "Right Identity", Proxy a -> Property
    forall a.
    (Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    monoidRightIdentity Proxy a
    p)
      , (String
    "Concatenation", Proxy a -> Property
    forall a.
    (Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    monoidConcatenation Proxy a
    p)
      ]

    -- | Tests the following properties:
    --
    -- [/Commutative/]
    --   @mappend a b ≡ mappend b a@
    --
    -- Note that this does not test associativity or identity. Make sure to use
    -- 'monoidLaws' in addition to this set of laws.
    commutativeMonoidLaws :: (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
    commutativeMonoidLaws :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
    commutativeMonoidLaws Proxy a
    p = String -> [(String, Property)] -> Laws
    Laws String
    "Commutative Monoid"
      [ (String
    "Commutative", Proxy a -> Property
    forall a.
    (Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    monoidCommutative Proxy a
    p)
      ]

    semigroupMonoidLaws :: forall a. (Semigroup a, Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Laws
    semigroupMonoidLaws :: forall a.
    (Semigroup a, Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Laws
    semigroupMonoidLaws Proxy a
    p = String -> [(String, Property)] -> Laws
    Laws String
    "Semigroup/Monoid"
      [ (String
    "mappend == <>", Proxy a -> Property
    forall a.
    (Semigroup a, Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    semigroupMonoid Proxy a
    p)
      ]

    semigroupMonoid :: forall a. (Semigroup a, Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
    semigroupMonoid :: forall a.
    (Semigroup a, Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    semigroupMonoid 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
    "mappend a b"
      (\(a
    a,a
    b) -> a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    a a
    b)
      String
    "a <> b"
      (\(a
    a,a
    b) -> a
    a a -> a -> a
    forall a. Semigroup a => a -> a -> a
    Data.Semigroup.<> a
    b)

    monoidConcatenation :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
    monoidConcatenation :: forall a.
    (Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    monoidConcatenation Proxy a
    _ = Bool
    -> (SmallList a -> Bool)
    -> (SmallList a -> [String])
    -> String
    -> (SmallList a -> a)
    -> String
    -> (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 -> SmallList a -> Bool
    forall a b. a -> b -> a
    const Bool
    True)
      (\(SmallList ([a]
    as :: [a])) -> [String
    "as = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [a] -> String
    forall a. Show a => a -> String
    show [a]
    as])
      String
    "mconcat as"
      (\(SmallList [a]
    as) -> [a] -> a
    forall a. Monoid a => [a] -> a
    mconcat [a]
    as)
      String
    "foldr mappend mempty as"
      (\(SmallList [a]
    as) -> (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)

    monoidAssociative :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
    monoidAssociative :: forall a.
    (Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    monoidAssociative 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
    "mappend a (mappend b c)"
      (\(a
    a,a
    b,a
    c) -> 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))
      String
    "mappend (mappend a b) c"
      (\(a
    a,a
    b,a
    c) -> 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)

    monoidLeftIdentity :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
    monoidLeftIdentity :: forall a.
    (Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    monoidLeftIdentity 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
    "mappend mempty a"
      (\a
    a -> a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    forall a. Monoid a => a
    mempty a
    a)
      String
    "a"
      (\a
    a -> a
    a)

    monoidRightIdentity :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
    monoidRightIdentity :: forall a.
    (Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    monoidRightIdentity 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
    "mappend a mempty"
      (\a
    a -> a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    a a
    forall a. Monoid a => a
    mempty)
      String
    "a"
      (\a
    a -> a
    a)

    monoidCommutative :: forall a. (Monoid a, Eq a, Arbitrary a, Show a) => Proxy a -> Property
    monoidCommutative :: forall a.
    (Monoid a, Eq a, Arbitrary a, Show a) =>
    Proxy a -> Property
    monoidCommutative 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
    "mappend a b"
      (\(a
    a,a
    b) -> a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    a a
    b)
      String
    "mappend b a"
      (\(a
    a,a
    b) -> a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    b a
    a)