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

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

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Alt
  (
#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS)
    altLaws
#endif
) where

#if defined(HAVE_SEMIGROUPOIDS) && defined(HAVE_UNARY_LAWS)
import Data.Functor
import Data.Functor.Alt (Alt)
import qualified Data.Functor.Alt as Alt
import Test.QuickCheck hiding ((.&.))
import Test.QuickCheck.Arbitrary (Arbitrary1(..))
import Data.Functor.Classes (Eq1,Show1)
import Test.QuickCheck.Property (Property)

import Test.QuickCheck.Classes.Internal

-- | Tests the following alt properties:
--
-- [/Associativity/]
--   @(a 'Alt.<!>' b) 'Alt.<!>' c ≡ a 'Alt.<!>' (b 'Alt.<!>' c)@
-- [/Left Distributivity/]
--   @f '<$>' (a 'Alt.<!>' b) ≡ (f '<$>' a) 'Alt.<!>' (f '<$>' b)@
altLaws :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Alt f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Alt f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Laws
altLaws :: proxy f -> Laws
altLaws proxy f
p = String -> [(String, Property)] -> Laws
Laws String
"Alt"
  [ (String
"Associativity", proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Alt 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
altAssociative proxy f
p)
  , (String
"Left Distributivity", proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Alt 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
altLeftDistributive proxy f
p)
  ]

altAssociative :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Alt f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Alt f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Property
altAssociative :: proxy f -> Property
altAssociative proxy f
_ = (Apply f Integer -> Apply f Integer -> Apply f Integer -> Bool)
-> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Apply f Integer -> Apply f Integer -> Bool)
 -> Property)
-> (Apply f Integer -> Apply f Integer -> Apply f Integer -> Bool)
-> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
a :: f Integer)) (Apply (f Integer
b :: f Integer)) (Apply (f Integer
c :: 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
a f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
Alt.<!> f Integer
b) f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
Alt.<!> f Integer
c) (f Integer
a f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
Alt.<!> (f Integer
b f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
Alt.<!> f Integer
c))

altLeftDistributive :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Alt f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Alt f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Property
altLeftDistributive :: proxy f -> Property
altLeftDistributive proxy f
_ = (Apply f Integer -> Apply f Integer -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer -> Apply f Integer -> Bool) -> Property)
-> (Apply f Integer -> Apply f Integer -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
a :: f Integer)) (Apply (f Integer
b :: 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 (Integer -> Integer
forall a. a -> a
id (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (f Integer
a f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
Alt.<!> f Integer
b)) ((Integer -> Integer
forall a. a -> a
id (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Integer
a) f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
Alt.<!> (Integer -> Integer
forall a. a -> a
id (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Integer
b))
#endif