{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Monad.Except.Checkers where
import Control.Monad.Except
import Control.Monad.State
import Test.QuickCheck (Gen, Property)
import Test.QuickCheck.HigherOrder (CoArbitrary, Constructible, TestEq, ok, ko)
import Test.Monad.Instances ()
import Test.Monad.Except
import Test.Monad.Except.Mutants
checkExcept
:: forall m a b e
. ( MonadError e m
, CoArbitrary Gen b, CoArbitrary Gen e
, TestEq (m a)
, Constructible a, Constructible e, Constructible (m a), Constructible (m b))
=> [(String, Property)]
checkExcept =
[ ok "throwZero" (throwZero @m @a @b)
, ok "throw-catch" (throw_catch @m @a)
, ok "catch-throw" (catch_throw @m @a)
, ok "catch-catch" (catch_catch @m @a)
, ok "catch-return" (catch_return @m @a)
]
{-# NOINLINE checkExcept #-}
checkExcept_ :: [(String, Property)]
checkExcept_ =
checkExcept @(Either Int) @Int @Int
++ checkExcept @(StateT Int (Either Int)) @Int @Int
++ checkExcept @(ExceptT Int (State Int)) @Int @Int
++ checkExcept @(StateT Int (ExceptT Int (State Int))) @Int @Int
checkExcept' :: [(String, Property)]
checkExcept' =
[ ok "catch-bind-e" (catch_bind @(Except Int) @Int @Int)
, ko "catch-bind-se" (catch_bind @(StateT Int (Either Int)) @Int @Int)
, ok "catch-bind-es" (catch_bind @(ExceptT Int (State Int)) @Int @Int)
, ko "catch-bind-ses" (catch_bind @(StateT Int (ExceptT Int (State Int))) @Int @Int)
, ko "bad-throwZero" (bad_throwZero @(Except Int) @Int @Int)
, ko "bad-throw-catch" (bad_throw_catch @(Except Int) @Int)
, ko "bad-catch-catch-1" (bad_catch_catch_1 @(Except Int) @Int)
, ko "bad-catch-catch-2" (bad_catch_catch_2 @(Except Int) @Int)
, ko "bad-catch-bind" (bad_catch_bind @(Except Int) @Int @Int)
, ko "mut-1-throw-catch" (throw_catch @(MutantExcept1 Int) @Int)
, ok "mut-1-bad-throw-catch" (bad_throw_catch @(MutantExcept1 Int) @Int)
, ok "mut-1-bad-catch-catch-1" (bad_catch_catch_1 @(MutantExcept1 Int) @Int)
, ok "mut-1-bad-catch-catch-2" (bad_catch_catch_2 @(MutantExcept1 Int) @Int)
, ok "mut-1-bad-catch-bind" (bad_catch_bind @(MutantExcept1 Int) @Int @Int)
, ko "mut-2-throw-catch" (throw_catch @(MutantExcept2 Int) @Int)
, ko "mut-2-catch-catch" (catch_catch @(MutantExcept2 Int) @Int)
, ko "mut-2-catch-bind" (catch_bind @(MutantExcept2 Int) @Int @Int)
]
{-# NOINLINE checkExcept' #-}