{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

{-# OPTIONS_GHC -Wall #-}

module Test.QuickCheck.Classes.Contravariant
  (
#if HAVE_UNARY_LAWS
    contravariantLaws
#endif
  ) where

import Data.Functor.Contravariant
import Test.QuickCheck hiding ((.&.))
#if HAVE_UNARY_LAWS
import Test.QuickCheck.Arbitrary (Arbitrary1(..))
import Data.Functor.Classes (Eq1,Show1)
#endif
import Test.QuickCheck.Property (Property)

import Test.QuickCheck.Classes.Internal

#if HAVE_UNARY_LAWS

-- | Tests the following contravariant properties:
--
-- [/Identity/]
--   @'contramap' 'id' ≡ 'id'@
-- [/Composition/]
--   @'contramap' f '.' 'contramap' g ≡ 'contramap' (g '.' f)@
contravariantLaws ::
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Contravariant f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Contravariant f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f
  -> Laws
contravariantLaws :: proxy f -> Laws
contravariantLaws proxy f
p = String -> [(String, Property)] -> Laws
Laws String
"Contravariant"
  [ (String
"Identity", proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Contravariant 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
contravariantIdentity proxy f
p)
  , (String
"Composition", proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(Contravariant 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
contravariantComposition proxy f
p)
  ]

contravariantIdentity :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Contravariant f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Contravariant f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Property
contravariantIdentity :: proxy f -> Property
contravariantIdentity 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
a :: 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) -> f Integer -> f Integer
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Integer -> Integer
forall a. a -> a
id f Integer
a) f Integer
a

contravariantComposition :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
  (Contravariant f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
  (Contravariant f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
  => proxy f -> Property
contravariantComposition :: proxy f -> Property
contravariantComposition proxy f
_ = (Apply f Integer -> QuadraticEquation -> QuadraticEquation -> Bool)
-> Property
forall prop. Testable prop => prop -> Property
property ((Apply f Integer
  -> QuadraticEquation -> QuadraticEquation -> Bool)
 -> Property)
-> (Apply f Integer
    -> QuadraticEquation -> QuadraticEquation -> Bool)
-> Property
forall a b. (a -> b) -> a -> b
$ \(Apply (f Integer
a :: f Integer)) (QuadraticEquation
f' :: QuadraticEquation) (QuadraticEquation
g' :: QuadraticEquation) -> do
  let f :: Integer -> Integer
f = QuadraticEquation -> Integer -> Integer
runQuadraticEquation QuadraticEquation
f'
      g :: Integer -> Integer
g = QuadraticEquation -> Integer -> Integer
runQuadraticEquation QuadraticEquation
g'
  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) -> f Integer -> f Integer
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Integer -> Integer
f ((Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Integer -> Integer
g f Integer
a)) ((Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Integer -> Integer
g (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
f) f Integer
a)

#endif