git.iko.soy/typeable/ether
on 0.5 help sign in
typeable/ether/src/Ether/Except.hs
141 lines 3.7 kB history raw
1module Ether.Except
2 (
3 -- * MonadExcept class
4 MonadExcept
5 , throw
6 , catch
7 -- * The Except monad
8 , Except
9 , runExcept
10 -- * The ExceptT monad transformer
11 , ExceptT
12 , exceptT
13 , runExceptT
14 -- * MonadExcept class (implicit)
15 , MonadExcept'
16 , throw'
17 , catch'
18 -- * The Except monad (implicit)
19 , Except'
20 , runExcept'
21 -- * The ExceptT monad transformer (implicit)
22 , ExceptT'
23 , exceptT'
24 , runExceptT'
25 -- * Internal labels
26 , TAGGED
27 , EXCEPT
28 ) where
30import qualified Control.Monad.Except as T
31import Control.Monad.Signatures (Catch)
32import qualified Control.Monad.Trans.Lift.Catch as Lift
33import Data.Coerce
34import Data.Functor.Identity
36import Ether.TaggedTrans
37import Ether.Internal
39class Monad m => MonadExcept tag e m | m tag -> e where
41 -- | Is used within a monadic computation to begin exception processing.
42 throw :: e -> m a
44 -- | A TaggedTrans function to handle previous exceptions and return to
45 -- normal execution.
46 catch :: m a -> (e -> m a) -> m a
48instance {-# OVERLAPPABLE #-}
49 ( Lift.LiftCatch t
50 , Monad (t m)
51 , MonadExcept tag e m
52 ) => MonadExcept tag e (t m) where
54 throw = Lift.lift . throw @tag
55 {-# INLINE throw #-}
57 catch = Lift.liftCatch (catch @tag)
58 {-# INLINE catch #-}
60-- | Encode type-level information for 'ExceptT'.
61data EXCEPT
63-- | The parameterizable exception monad.
64--
65-- Computations are either exceptions or normal values.
66--
67-- The 'return' function returns a normal value, while '>>=' exits on
68-- the first exception.
69type Except tag e = ExceptT tag e Identity
71-- | The exception monad transformer.
72--
73-- The 'return' function returns a normal value, while '>>=' exits on
74-- the first exception.
75type ExceptT tag e = TaggedTrans (TAGGED EXCEPT tag) (T.ExceptT e)
77-- | Runs an 'Except' and returns either an exception or a normal value.
78runExcept :: forall tag e a . Except tag e a -> Either e a
79runExcept = coerce (T.runExcept @e @a)
80{-# INLINE runExcept #-}
82-- | Runs an 'ExceptT' and returns either an exception or a normal value.
83runExceptT :: forall tag e m a . ExceptT tag e m a -> m (Either e a)
84runExceptT = coerce (T.runExceptT @e @m @a)
85{-# INLINE runExceptT #-}
87-- | Constructor for computations in the exception monad transformer.
88exceptT :: forall tag e m a . m (Either e a) -> ExceptT tag e m a
89exceptT = coerce (T.ExceptT @e @m @a)
90{-# INLINE exceptT #-}
92type instance HandleSuper EXCEPT e trans = ()
93type instance HandleConstraint EXCEPT e trans m =
94 T.MonadError e (trans m)
96instance Handle EXCEPT e (T.ExceptT e) where
97 handling r = r
98 {-# INLINE handling #-}
100instance
101 ( Handle EXCEPT e trans
102 , Monad m, Monad (trans m)
103 ) => MonadExcept tag e (TaggedTrans (TAGGED EXCEPT tag) trans m)
104 where
105 throw =
106 handling @EXCEPT @e @trans @m $
107 coerce (T.throwError @e @(trans m) @a) ::
108 forall eff a . e -> TaggedTrans eff trans m a
109 {-# INLINE throw #-}
111 catch =
112 handling @EXCEPT @e @trans @m $
113 coerce (T.catchError @e @(trans m) @a) ::
114 forall eff a . Catch e (TaggedTrans eff trans m) a
115 {-# INLINE catch #-}
117type MonadExcept' e = MonadExcept e e
119throw' :: forall e m a . MonadExcept' e m => e -> m a
120throw' = throw @e
121{-# INLINE throw' #-}
123catch' :: forall e m a . MonadExcept' e m => m a -> (e -> m a) -> m a
124catch' = catch @e
125{-# INLINE catch' #-}
127type Except' e = Except e e
129runExcept' :: Except' e a -> Either e a
130runExcept' = runExcept
131{-# INLINE runExcept' #-}
133type ExceptT' e = ExceptT e e
135exceptT' :: m (Either e a) -> ExceptT' e m a
136exceptT' = exceptT
137{-# INLINE exceptT' #-}
139runExceptT' :: ExceptT' e m a -> m (Either e a)
140runExceptT' = runExceptT
141{-# INLINE runExceptT' #-}