@@ -0,0 +1,109 @@
1+{-# LANGUAGE MultiParamTypeClasses #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE UndecidableInstances #-}
6+{-# LANGUAGE DataKinds #-}
7+{-# LANGUAGE ConstraintKinds #-}
8+{-# LANGUAGE TypeOperators #-}
9+{-# LANGUAGE FunctionalDependencies #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE RankNTypes #-}
12+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
13+module Control.Monad.Ether.Except
14+ (
15+ -- * MonadExcept class
16+ MonadExcept(..)
17+ -- * The Except monad
18+ , Except
19+ , runExcept
20+ -- * The ExceptT monad transformer
21+ , ExceptT
22+ , exceptT
23+ , runExceptT
24+ , mapExceptT
25+ ) where
26+
27+import Data.Proxy (Proxy(Proxy))
28+import Control.Monad.Trans (lift)
29+
30+import qualified Control.Monad.Trans.Ether.Reader as Reader
31+import qualified Control.Monad.Trans.Ether.State as State
32+import Control.Monad.Trans.Ether.Except
33+
34+-- for mtl instances
35+import qualified Control.Monad.Trans.Except as Trans (ExceptT(..), runExceptT)
36+import qualified Control.Monad.Trans.Identity as Trans.I
37+import qualified Control.Monad.Trans.List as Trans.L
38+import qualified Control.Monad.Trans.Maybe as Trans.M
39+import qualified Control.Monad.Trans.Reader as Trans.R
40+import qualified Control.Monad.Trans.State.Lazy as Trans.S.Lazy
41+import qualified Control.Monad.Trans.State.Strict as Trans.S.Strict
42+import qualified Control.Monad.Trans.Writer.Lazy as Trans.W.Lazy
43+import qualified Control.Monad.Trans.Writer.Strict as Trans.W.Strict
44+
45+class Monad m => MonadExcept tag e m | m tag -> e where
46+
47+ throw :: proxy tag -> e -> m a
48+
49+ catch :: proxy tag -> m a -> (e -> m a) -> m a
50+
51+instance {-# OVERLAPPING #-} Monad m => MonadExcept tag e (ExceptT tag e m) where
52+ throw proxy = exceptT proxy . return . Left
53+ catch proxy m h
54+ = exceptT proxy
55+ $ runExceptT proxy m
56+ >>= either (runExceptT proxy . h) (return . Right)
57+
58+instance MonadExcept tag e m => MonadExcept tag e (ExceptT tag' e' m) where
59+ throw proxy = lift . throw proxy
60+ catch proxy = liftCatch Proxy (catch proxy)
61+
62+-- Instances for other tagged transformers
63+
64+instance MonadExcept tag e m => MonadExcept tag e (Reader.ReaderT tag' r m) where
65+ throw proxy = lift . throw proxy
66+ catch proxy = Reader.liftCatch Proxy (catch proxy)
67+
68+instance MonadExcept tag e m => MonadExcept tag e (State.StateT tag' s m) where
69+ throw proxy = lift . throw proxy
70+ catch proxy = State.liftCatch Proxy (catch proxy)
71+
72+
73+-- Instances for mtl transformers
74+
75+instance MonadExcept tag e m => MonadExcept tag e (Trans.ExceptT e' m) where
76+ throw proxy = lift . throw proxy
77+ catch proxy m h = Trans.ExceptT $ catch proxy (Trans.runExceptT m) (Trans.runExceptT . h)
78+
79+instance MonadExcept tag e m => MonadExcept tag e (Trans.I.IdentityT m) where
80+ throw proxy = lift . throw proxy
81+ catch proxy = Trans.I.liftCatch (catch proxy)
82+
83+instance MonadExcept tag e m => MonadExcept tag e (Trans.L.ListT m) where
84+ throw proxy = lift . throw proxy
85+ catch proxy = Trans.L.liftCatch (catch proxy)
86+
87+instance MonadExcept tag e m => MonadExcept tag e (Trans.M.MaybeT m) where
88+ throw proxy = lift . throw proxy
89+ catch proxy = Trans.M.liftCatch (catch proxy)
90+
91+instance MonadExcept tag e m => MonadExcept tag e (Trans.R.ReaderT r m) where
92+ throw proxy = lift . throw proxy
93+ catch proxy = Trans.R.liftCatch (catch proxy)
94+
95+instance MonadExcept tag e m => MonadExcept tag e (Trans.S.Lazy.StateT s m) where
96+ throw proxy = lift . throw proxy
97+ catch proxy = Trans.S.Lazy.liftCatch (catch proxy)
98+
99+instance MonadExcept tag e m => MonadExcept tag e (Trans.S.Strict.StateT s m) where
100+ throw proxy = lift . throw proxy
101+ catch proxy = Trans.S.Strict.liftCatch (catch proxy)
102+
103+instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (Trans.W.Lazy.WriterT w m) where
104+ throw proxy = lift . throw proxy
105+ catch proxy = Trans.W.Lazy.liftCatch (catch proxy)
106+
107+instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (Trans.W.Strict.WriterT w m) where
108+ throw proxy = lift . throw proxy
109+ catch proxy = Trans.W.Strict.liftCatch (catch proxy)