{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if HAVE_QUANTIFIED_CONSTRAINTS
{-# LANGUAGE QuantifiedConstraints #-}
#endif
{-# OPTIONS_GHC -Wall #-}
module Test.QuickCheck.Classes.MonadFail
(
#if HAVE_UNARY_LAWS
monadFailLaws
#endif
) where
#if HAVE_UNARY_LAWS
import Control.Applicative
import Test.QuickCheck hiding ((.&.))
import Control.Monad (ap)
import Test.QuickCheck.Arbitrary (Arbitrary1(..))
import Data.Functor.Classes (Eq1,Show1)
import Prelude hiding (fail)
import Control.Monad.Fail (MonadFail(..))
import Test.QuickCheck.Property (Property)
import Test.QuickCheck.Classes.Internal
monadFailLaws :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
(MonadFail f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
(MonadFail f, Applicative f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
=> proxy f -> Laws
monadFailLaws :: forall (proxy :: (* -> *) -> *) (f :: * -> *).
(MonadFail 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
monadFailLaws proxy f
p = String -> [(String, Property)] -> Laws
Laws String
"Monad"
[ (String
"Left Zero", proxy f -> Property
forall (proxy :: (* -> *) -> *) (f :: * -> *).
(MonadFail 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
monadFailLeftZero proxy f
p)
]
monadFailLeftZero :: forall proxy f.
#if HAVE_QUANTIFIED_CONSTRAINTS
(MonadFail f, forall a. Eq a => Eq (f a), forall a. Show a => Show (f a), forall a. Arbitrary a => Arbitrary (f a))
#else
(MonadFail f, Functor f, Eq1 f, Show1 f, Arbitrary1 f)
#endif
=> proxy f -> Property
monadFailLeftZero :: forall (proxy :: (* -> *) -> *) (f :: * -> *).
(MonadFail 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
monadFailLeftZero proxy f
_ = (LinearEquationM f -> String -> Bool) -> Property
forall prop. Testable prop => prop -> Property
property ((LinearEquationM f -> String -> Bool) -> Property)
-> (LinearEquationM f -> String -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \(LinearEquationM f
k' :: LinearEquationM f) (String
s :: String) ->
let k :: Integer -> f Integer
k = LinearEquationM f -> Integer -> f Integer
forall (m :: * -> *).
Monad m =>
LinearEquationM m -> Integer -> m Integer
runLinearEquationM LinearEquationM f
k'
in f Integer -> f Integer -> Bool
forall (f :: * -> *) a.
(forall x. Eq x => Eq (f x), Eq a) =>
f a -> f a -> Bool
eq1 (String -> f Integer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s f Integer -> (Integer -> f Integer) -> f Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> f Integer
k) (String -> f Integer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s)
#endif