{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}

#if HAVE_QUANTIFIED_CONSTRAINTS
{-# LANGUAGE QuantifiedConstraints #-}
#endif

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Plus
  (
#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS)
    plusLaws
  , extendedPlusLaws
#endif
  ) where

#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS)
import Data.Functor
import Data.Functor.Alt (Alt)
import Data.Functor.Plus (Plus)
import qualified Data.Functor.Alt as Alt
import qualified Data.Functor.Plus as Plus

import Test.QuickCheck hiding ((.&.))
import Test.QuickCheck.Arbitrary (Arbitrary1(..))
import Data.Functor.Classes (Eq1,Show1)
import qualified Control.Applicative as Alternative
import Test.QuickCheck.Property (Property)

import Test.QuickCheck.Classes.Internal

-- | Tests the following alt properties:
--
-- [/Left Identity/]
--   @'Plus.zero' 'Alt.<!>' m ≡ m@
-- [/Right Identity/]
--   @m 'Alt.<!>' 'Plus.zero' ≡ m@
plusLaws :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Plus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Plus f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Laws
plusLaws :: proxy f -> Laws
plusLaws proxy f
p = String -> [(String, Property)] -> Laws
Laws String
"Plus"
  [ (String
"Left Identity", proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Plus f, forall a. Eq a => Eq (f a),
 forall a. Show a => Show (f a),
 forall a. Arbitrary a => Arbitrary (f a)) =>
proxy f -> Property
plusLeftIdentity proxy f
p)
  , (String
"Right Identity", proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Plus f, forall a. Eq a => Eq (f a),
 forall a. Show a => Show (f a),
 forall a. Arbitrary a => Arbitrary (f a)) =>
proxy f -> Property
plusRightIdentity proxy f
p)
  ]

-- | Tests everything from 'altLaws', plus the following:
--
-- [/Congruency/]
--   @'Plus.zero' ≡ 'Alternative.empty'@
extendedPlusLaws :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Plus f, Alternative.Alternative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Plus f, Alternative.Alternative f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Laws
extendedPlusLaws :: proxy f -> Laws
extendedPlusLaws proxy f
p = String -> [(String, Property)] -> Laws
Laws String
"Plus extended to Alternative" ([(String, Property)] -> Laws) -> [(String, Property)] -> Laws
forall a b. (a -> b) -> a -> b
$ Laws -> [(String, Property)]
lawsProperties (proxy f -> Laws
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Plus f, forall a. Eq a => Eq (f a),
 forall a. Show a => Show (f a),
 forall a. Arbitrary a => Arbitrary (f a)) =>
proxy f -> Laws
plusLaws proxy f
p) [(String, Property)]
-> [(String, Property)] -> [(String, Property)]
forall a. [a] -> [a] -> [a]
++
  [ (String
"Congruency", proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Plus f, Alternative f, forall a. Eq a => Eq (f a),
 forall a. Show a => Show (f a),
 forall a. Arbitrary a => Arbitrary (f a)) =>
proxy f -> Property
extendedPlusLaw proxy f
p)
  ]

extendedPlusLaw :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Plus f, Alternative.Alternative f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Plus f, Alternative.Alternative f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Property
extendedPlusLaw :: proxy f -> Property
extendedPlusLaw proxy f
_ = Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ f Integer -> f Integer -> Bool
forall (f :: * -> *) a.
(forall x. Eq x => Eq (f x), Eq a) =>
f a -> f a -> Bool
eq1 (f Integer
forall (f :: * -> *) a. Plus f => f a
Plus.zero :: f Integer) (f Integer
forall (f :: * -> *) a. Alternative f => f a
Alternative.empty :: f Integer)

plusLeftIdentity :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Plus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Plus f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Property
plusLeftIdentity :: proxy f -> Property
plusLeftIdentity proxy f
_ = (Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
m :: f Integer)) -> f Integer -> f Integer -> Bool
forall (f :: * -> *) a.
(forall x. Eq x => Eq (f x), Eq a) =>
f a -> f a -> Bool
eq1 (f Integer
forall (f :: * -> *) a. Plus f => f a
Plus.zero f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
Alt.<!> f Integer
m) f Integer
m

plusRightIdentity :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Plus f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Plus f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Property
plusRightIdentity :: proxy f -> Property
plusRightIdentity proxy f
_ = (Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
m :: f Integer)) -> f Integer -> f Integer -> Bool
forall (f :: * -> *) a.
(forall x. Eq x => Eq (f x), Eq a) =>
f a -> f a -> Bool
eq1 (f Integer
m f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
Alt.<!> f Integer
forall (f :: * -> *) a. Plus f => f a
Plus.zero) f Integer
m

#endif