{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Trustworthy #-}
module Grisette.Core.Data.Class.Error
(
TransformError (..),
symAssertWith,
symAssertTransformableError,
symThrowTransformableError,
)
where
import Control.Monad.Except
import Grisette.Core.Control.Monad.Union
import Grisette.Core.Data.Class.Bool
import Grisette.Core.Data.Class.Mergeable
import Grisette.Core.Data.Class.SimpleMergeable
import {-# SOURCE #-} Grisette.IR.SymPrim.Data.SymPrim
class TransformError from to where
transformError :: from -> to
instance {-# OVERLAPPABLE #-} TransformError a a where
transformError :: a -> a
transformError = forall a. a -> a
id
{-# INLINE transformError #-}
instance {-# OVERLAPS #-} TransformError a () where
transformError :: a -> ()
transformError a
_ = ()
{-# INLINE transformError #-}
instance {-# OVERLAPPING #-} TransformError () () where
transformError :: () -> ()
transformError ()
_ = ()
{-# INLINE transformError #-}
symThrowTransformableError ::
( Mergeable to,
Mergeable a,
TransformError from to,
MonadError to erm,
MonadUnion erm
) =>
from ->
erm a
symThrowTransformableError :: forall to a from (erm :: * -> *).
(Mergeable to, Mergeable a, TransformError from to,
MonadError to erm, MonadUnion erm) =>
from -> erm a
symThrowTransformableError = forall (u :: * -> *) a. (UnionLike u, Mergeable a) => u a -> u a
merge forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. TransformError from to => from -> to
transformError
{-# INLINE symThrowTransformableError #-}
symAssertTransformableError ::
( Mergeable to,
TransformError from to,
MonadError to erm,
MonadUnion erm
) =>
from ->
SymBool ->
erm ()
symAssertTransformableError :: forall to from (erm :: * -> *).
(Mergeable to, TransformError from to, MonadError to erm,
MonadUnion erm) =>
from -> SymBool -> erm ()
symAssertTransformableError from
err SymBool
cond = forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf SymBool
cond (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall to a from (erm :: * -> *).
(Mergeable to, Mergeable a, TransformError from to,
MonadError to erm, MonadUnion erm) =>
from -> erm a
symThrowTransformableError from
err)
{-# INLINE symAssertTransformableError #-}
symAssertWith ::
( Mergeable e,
MonadError e erm,
MonadUnion erm
) =>
e ->
SymBool ->
erm ()
symAssertWith :: forall e (erm :: * -> *).
(Mergeable e, MonadError e erm, MonadUnion erm) =>
e -> SymBool -> erm ()
symAssertWith e
err SymBool
cond = forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf SymBool
cond (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
err)
{-# INLINE symAssertWith #-}