@@ -1 +1,48 @@
1−module Control.Monad.Trans.Lift.Catch where
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE DefaultSignatures #-}
3+module Control.Monad.Trans.Lift.Catch
4+ ( LiftCatch(..)
5+ , Catch
6+ , module Control.Monad.Trans.Class
7+ ) where
8+
9+import Data.Monoid
10+
11+import Control.Monad.Signatures
12+import Control.Monad.Trans.Class
13+import Control.Monad.Trans.Control
14+
15+import Control.Monad.Trans.Except
16+import Control.Monad.Trans.Identity
17+import Control.Monad.Trans.List
18+import Control.Monad.Trans.Maybe
19+import Control.Monad.Trans.Reader
20+import qualified Control.Monad.Trans.Cont as Cont
21+import qualified Control.Monad.Trans.RWS.Lazy as Lazy
22+import qualified Control.Monad.Trans.RWS.Strict as Strict
23+import qualified Control.Monad.Trans.State.Lazy as Lazy
24+import qualified Control.Monad.Trans.State.Strict as Strict
25+import qualified Control.Monad.Trans.Writer.Lazy as Lazy
26+import qualified Control.Monad.Trans.Writer.Strict as Strict
27+
28+class MonadTrans t => LiftCatch t where
29+ type CatchStT t a
30+ type CatchStT t a = StT t a
31+ liftCatch :: Monad m => Catch e m (CatchStT t a) -> Catch e (t m) a
32+ default liftCatch
33+ :: (MonadTransControl t, CatchStT t a ~ StT t a, Monad m, Monad (t m))
34+ => Catch e m (CatchStT t a) -> Catch e (t m) a
35+ liftCatch catchE m h = do
36+ liftWith (\run -> catchE (run m) (run . h)) >>= restoreT . return
37+
38+instance LiftCatch (ExceptT e)
39+instance LiftCatch IdentityT
40+instance LiftCatch ListT
41+instance LiftCatch MaybeT
42+instance LiftCatch (ReaderT r)
43+instance Monoid w => LiftCatch (Lazy.RWST r w s)
44+instance Monoid w => LiftCatch (Strict.RWST r w s)
45+instance LiftCatch (Lazy.StateT s)
46+instance LiftCatch (Strict.StateT s)
47+instance Monoid w => LiftCatch (Lazy.WriterT w)
48+instance Monoid w => LiftCatch (Strict.WriterT w)