{- HLINT ignore "Use camelCase" -}
{- HLINT ignore "Redundant bracket" -}

-- |
-- Copyright: © 2022–2024 Jonathan Knowles
-- License: Apache-2.0
--
-- This module provides 'Laws' definitions for classes exported by
-- "Data.Monoid.Null".
--
module Test.QuickCheck.Classes.Monoid.Null
    (
    -- * Null
      monoidNullLaws

    -- * Positive
    , positiveMonoidLaws
    )
    where

import Prelude hiding
    ( null )

import Data.Function
    ( (&) )
import Data.Monoid.Null
    ( MonoidNull (..), PositiveMonoid )
import Data.Proxy
    ( Proxy (..) )
import Internal
    ( cover, makeLaw1, makeLaw2, makeProperty, report )
import Test.QuickCheck
    ( Arbitrary (..), Property )
import Test.QuickCheck.Classes
    ( Laws (..) )

--------------------------------------------------------------------------------
-- MonoidNull
--------------------------------------------------------------------------------

-- | 'Laws' for instances of 'MonoidNull'.
--
-- Includes the following law:
--
-- @
-- 'null' a '==' (a '==' 'mempty')
-- @
--
-- Note that the following superclass laws are __not__ included:
--
-- * 'Test.QuickCheck.Classes.monoidLaws'
--
monoidNullLaws
    :: forall a. (Arbitrary a, Show a, Eq a, MonoidNull a)
    => Proxy a
    -> Laws
monoidNullLaws :: forall a.
(Arbitrary a, Show a, Eq a, MonoidNull a) =>
Proxy a -> Laws
monoidNullLaws Proxy a
_ = String -> [(String, Property)] -> Laws
Laws String
"MonoidNull"
    [ forall a t.
(Arbitrary a, Show a, Eq a, Semigroup a, Testable t) =>
String -> (a -> t) -> (String, Property)
makeLaw1 @a
        String
"monoidNullLaw_basic"
        (a -> Property
forall a. (Eq a, MonoidNull a) => a -> Property
monoidNullLaw_basic)
    ]

monoidNullLaw_basic
    :: (Eq a, MonoidNull a) => a -> Property
monoidNullLaw_basic :: forall a. (Eq a, MonoidNull a) => a -> Property
monoidNullLaw_basic a
a =
    String -> Bool -> Property
forall t. Testable t => String -> t -> Property
makeProperty
        String
"null a == (a == mempty)"
        (a -> Bool
forall m. MonoidNull m => m -> Bool
null a
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty))
    Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property -> Property
forall t. Testable t => String -> Bool -> t -> Property
cover
        String
"a == mempty"
        (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty)
    Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property -> Property
forall t. Testable t => String -> Bool -> t -> Property
cover
        String
"a /= mempty"
        (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall a. Monoid a => a
mempty)
    Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property -> Property
forall a prop.
(Show a, Testable prop) =>
String -> a -> prop -> Property
report
        String
"null a"
        (a -> Bool
forall m. MonoidNull m => m -> Bool
null a
a)
    Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property -> Property
forall a prop.
(Show a, Testable prop) =>
String -> a -> prop -> Property
report
        String
"a == mempty"
        (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty)

--------------------------------------------------------------------------------
-- PositiveMonoid
--------------------------------------------------------------------------------

-- | 'Laws' for instances of 'PositiveMonoid'.
--
-- Includes the following law:
--
-- @
-- 'null' (a '<>' b) '==' ('null' a '&&' 'null' b)
-- @
--
-- Note that the following superclass laws are __not__ included:
--
-- * 'Test.QuickCheck.Classes.Monoid.Null.monoidNullLaws'
--
positiveMonoidLaws
    :: forall a. (Arbitrary a, Show a, Eq a, PositiveMonoid a)
    => Proxy a
    -> Laws
positiveMonoidLaws :: forall a.
(Arbitrary a, Show a, Eq a, PositiveMonoid a) =>
Proxy a -> Laws
positiveMonoidLaws Proxy a
_ = String -> [(String, Property)] -> Laws
Laws String
"PositiveMonoid"
    [ forall a t.
(Arbitrary a, Show a, Eq a, Semigroup a, Testable t) =>
String -> (a -> a -> t) -> (String, Property)
makeLaw2 @a
        String
"positiveMonoidLaw_fundamental"
        (a -> a -> Property
forall a. (Eq a, PositiveMonoid a, Show a) => a -> a -> Property
positiveMonoidLaw_fundamental)
    ]

positiveMonoidLaw_fundamental
    :: (Eq a, PositiveMonoid a, Show a) => a -> a -> Property
positiveMonoidLaw_fundamental :: forall a. (Eq a, PositiveMonoid a, Show a) => a -> a -> Property
positiveMonoidLaw_fundamental a
a a
b =
    String -> Bool -> Property
forall t. Testable t => String -> t -> Property
makeProperty
        String
"null (a <> b) == (null a && null b)"
        (a -> Bool
forall m. MonoidNull m => m -> Bool
null (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (a -> Bool
forall m. MonoidNull m => m -> Bool
null a
a Bool -> Bool -> Bool
&& a -> Bool
forall m. MonoidNull m => m -> Bool
null a
b))
    Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property -> Property
forall t. Testable t => String -> Bool -> t -> Property
cover
        String
"null (a <> b)"
        (a -> Bool
forall m. MonoidNull m => m -> Bool
null (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b))
    Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property -> Property
forall t. Testable t => String -> Bool -> t -> Property
cover
        String
"not (null (a <> b))"
        (Bool -> Bool
not (a -> Bool
forall m. MonoidNull m => m -> Bool
null (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)))
    Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> a -> Property -> Property
forall a prop.
(Show a, Testable prop) =>
String -> a -> prop -> Property
report
        String
"a <> b"
        (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
    Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property -> Property
forall a prop.
(Show a, Testable prop) =>
String -> a -> prop -> Property
report
        String
"null (a <> b)"
        (a -> Bool
forall m. MonoidNull m => m -> Bool
null (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b))
    Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property -> Property
forall a prop.
(Show a, Testable prop) =>
String -> a -> prop -> Property
report
        String
"null a"
        (a -> Bool
forall m. MonoidNull m => m -> Bool
null a
a)
    Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property -> Property
forall a prop.
(Show a, Testable prop) =>
String -> a -> prop -> Property
report
        String
"null b"
        (a -> Bool
forall m. MonoidNull m => m -> Bool
null a
b)