module Control.Monad.Trans.Ether.Except
(
Except
, except
, runExcept
, ExceptT
, exceptT
, runExceptT
, mapExceptT
, throw
, catch
, liftCallCC
, liftListen
, liftPass
, liftCatch
) where
import Data.Proxy (Proxy(Proxy))
import Data.Functor.Identity (Identity(..))
import Data.Coerce (coerce)
import Control.Applicative
import Control.Monad (MonadPlus)
import Control.Monad.Fix (MonadFix)
import Control.Monad.Trans.Class (MonadTrans, lift)
import Control.Monad.IO.Class (MonadIO)
import Control.Ether.Tagged (Taggable(..), Tagged(..))
import qualified Control.Ether.Util as Util
import GHC.Generics (Generic)
import qualified Control.Newtype as NT
import qualified Control.Monad.Signatures as Sig
import qualified Control.Monad.Trans.Except as Trans
import qualified Control.Monad.Cont.Class as Class
import qualified Control.Monad.Reader.Class as Class
import qualified Control.Monad.State.Class as Class
import qualified Control.Monad.Writer.Class as Class
import qualified Control.Monad.Error.Class as Class
type Except tag e = ExceptT tag e Identity
runExcept :: proxy tag -> Except tag e a -> Either e a
runExcept t = Trans.runExcept . untagged t
newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)
deriving ( Generic
, Functor, Applicative, Alternative, Monad, MonadPlus
, MonadFix, MonadTrans, MonadIO )
instance NT.Newtype (ExceptT tag e m a)
instance Taggable (ExceptT tag e m) where
type Tag (ExceptT tag e m) = 'Just tag
type Inner (ExceptT tag e m) = 'Just m
instance Tagged (ExceptT tag e m) tag where
type Untagged (ExceptT tag e m) = Trans.ExceptT e m
exceptT :: proxy tag -> m (Either e a) -> ExceptT tag e m a
exceptT t = tagged t . Trans.ExceptT
except :: Monad m => proxy tag -> Either e a -> ExceptT tag e m a
except t = exceptT t . return
runExceptT :: proxy tag -> ExceptT tag e m a -> m (Either e a)
runExceptT t = Trans.runExceptT . untagged t
mapExceptT
:: proxy tag
-> (m (Either e a) -> n (Either e' b))
-> ExceptT tag e m a
-> ExceptT tag e' n b
mapExceptT t f m = tagged t $ Trans.mapExceptT f (coerce m)
throw :: Monad m => proxy tag -> e -> ExceptT tag e m a
throw t = tagged t . Trans.throwE
catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a
catch t m h = tagged t $ Trans.catchE (coerce m) (coerce . h)
liftCallCC :: proxy tag -> Sig.CallCC m (Either e a) (Either e b) -> Sig.CallCC (ExceptT tag e m) a b
liftCallCC t callCC f = tagged t $ Trans.liftCallCC callCC (coerce f)
liftListen :: Monad m => proxy tag -> Sig.Listen w m (Either e a) -> Sig.Listen w (ExceptT tag e m) a
liftListen t listen m = tagged t $ Trans.liftListen listen (coerce m)
liftPass :: Monad m => proxy tag -> Sig.Pass w m (Either e a) -> Sig.Pass w (ExceptT tag e m) a
liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)
liftCatch :: proxy tag -> Sig.Catch e m (Either e' a) -> Sig.Catch e (ExceptT tag e' m) a
liftCatch t catchE m h = tagged t $ Util.liftCatch_ExceptT catchE (coerce m) (coerce h)
instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where
callCC = liftCallCC Proxy Class.callCC
instance Class.MonadReader r m => Class.MonadReader r (ExceptT tag e m) where
ask = lift Class.ask
local = mapExceptT Proxy . Class.local
reader = lift . Class.reader
instance Class.MonadState s m => Class.MonadState s (ExceptT tag e m) where
get = lift Class.get
put = lift . Class.put
state = lift . Class.state
instance Class.MonadWriter w m => Class.MonadWriter w (ExceptT tag e m) where
writer = lift . Class.writer
tell = lift . Class.tell
listen = liftListen Proxy Class.listen
pass = liftPass Proxy Class.pass
instance Class.MonadError e' m => Class.MonadError e' (ExceptT tag e m) where
throwError = lift . Class.throwError
catchError = liftCatch Proxy Class.catchError