control-monad-exception-mtl (empty) → 0.8.0

raw patch · 3 files changed

+169/−0 lines, 3 filesdep +basedep +control-monad-exceptiondep +mtlsetup-changed

Dependencies added: base, control-monad-exception, mtl

Files

Setup.lhs +3/−0
control-monad-exception-mtl.cabal +95/−0
src-mtl/Control/Monad/Exception/MTL.hs +71/−0

+ Setup.lhs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

+ control-monad-exception-mtl.cabal view

@@ -0,0 +1,95 @@+name: control-monad-exception-mtl+version: 0.8.0+Cabal-Version:  >= 1.6+build-type: Simple+license: PublicDomain+author: Pepe Iborra+maintainer: pepeiborra@gmail.com+homepage: http://pepeiborra.github.com/control-monad-exception+description: +  This package provides explicitly typed, checked exceptions as a library.+  .+  Computations throwing different types of exception can be combined seamlessly.+  .+  /Example/+  .+  > data Expr = Add Expr Expr | Div Expr Expr | Val Double+  > eval (Val x)     = return x+  > eval (Add a1 a2) = do+  >    v1 <- eval a1+  >    v2 <- eval a2+  >    let sum = v1 + v2+  >    if sum < v1 || sum < v2 then throw SumOverflow else return sum+  > eval (Div a1 a2) = do+  >    v1 <- eval a1+  >    v2 <- eval a2+  >    if v2 == 0 then throw DivideByZero else return (v1 / v2)+  .+  > data DivideByZero = DivideByZero deriving (Show, Typeable)+  > data SumOverflow  = SumOverflow  deriving (Show, Typeable)+  .+  > instance Exception DivideByZero+  > instance Exception SumOverflow+  .+  GHCi infers the following types+  .+  > eval :: (Throws DivideByZero l, Throws SumOverflow l) => Expr -> EM l Double+  > eval `catch` \ (e::DivideByZero) -> return (-1)  :: Throws SumOverflow l => Expr -> EM l Double+  > runEM(eval `catch` \ (e::SomeException) -> return (-1))  :: Expr -> Double+  .+  .+  In addition to explicitly typed exceptions his package provides:+  .+    * Support for explicitly documented, unchecked exceptions (via 'Control.Monad.Exception.tryEMT').+  .+    * Support for selective unchecked exceptions (via 'Control.Monad.Exception.UncaughtException').+  .+    * Support for exception call traces via 'Control.Monad.Loc.MonadLoc'. /Example:/+  .+  >+  > f () = do throw MyException+  > g a  = do f a+  >+  > main = runEMT $ do g () `catchWithSrcLoc`+  >                        \loc (e::MyException) -> lift(putStrLn$ showExceptionWithTrace loc e)+  >+  > -- Running main produces the output:+  >+  > *Main> main+  >  MyException+  >    in f, Main(example.hs): (1,6)+  >       g, Main(example.hs): (2,6)+  >       main, Main(example.hs): (5,9)+  >       main, Main(example.hs): (4,16)++synopsis: Explicitly typed, checked exceptions with stack traces+category: Control, Monads+stability: experimental+tested-with: GHC ==6.10.3++Library+  buildable: True +  build-depends: base > 4 && < 5+               , control-monad-exception == 0.8.0+               , mtl+++  extensions:  ScopedTypeVariables, +               PackageImports,+               MultiParamTypeClasses,+               FlexibleContexts,+               FlexibleInstances,+               UndecidableInstances++  exposed-modules:+     Control.Monad.Exception.MTL++  hs-source-dirs: src-mtl++  ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-orphans++++source-repository head+  type:     git+  location: git://github.com/pepeiborra/control-monad-exception.git

+ src-mtl/Control/Monad/Exception/MTL.hs view

@@ -0,0 +1,71 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE UndecidableInstances #-}++-- | 'EMT' liftings for the classes in the Monad Transformer Library+module Control.Monad.Exception.MTL (module Control.Monad.Exception, Control.Monad.Exception.catch) where++import qualified Control.Exception as CE++import qualified Control.Monad.Exception+import Control.Monad.Exception hiding (catch, Error)+import Control.Monad.Exception.Catch as Catch+import Control.Monad.Exception.Throws+import "mtl" Control.Monad.Cont.Class+import "mtl" Control.Monad.Error+import "mtl" Control.Monad.List+import "mtl" Control.Monad.Reader+import "mtl" Control.Monad.State+import "mtl" Control.Monad.Writer+import "mtl" Control.Monad.RWS+import Data.Monoid+import Prelude hiding (catch)++instance MonadTrans (EMT l) where lift = EMT . liftM Right++instance (Throws SomeException l, MonadIO m) => MonadIO (EMT l m) where+  liftIO m = EMT (liftIO m') where+      m' = liftM Right m+            `CE.catch`+           \(e::SomeException) -> return (Left ([], CheckedException e))++instance MonadCont m => MonadCont (EMT l m) where+  callCC f = EMT $ callCC $ \c -> unEMT (f (\a -> EMT $ c (Right a)))++instance MonadReader r m => MonadReader r (EMT l m) where+  ask = lift ask+  local f m = EMT (local f (unEMT m))++instance MonadState s m => MonadState s (EMT l m) where+  get = lift get+  put = lift . put++instance (Monoid w, MonadWriter w m) => MonadWriter w (EMT l m) where+  tell   = lift . tell+  listen m = EMT $ do+               (res, w) <- listen (unEMT m)+               return (fmap (\x -> (x,w)) res)+  pass m   = EMT $ pass $ do+               a <- unEMT m+               case a of+                 Left  l     -> return (Left l, id)+                 Right (r,f) -> return (Right r, f)++instance (Monoid w, MonadRWS r w s m) => MonadRWS r w s (EMT l m)++++-- MonadCatch Instances+-- -------------------------------------------------------------------------+instance (Error e) => MonadCatch e (Either e) (Either e) where catch m h = either h Right m+instance (Error e, Monad m) => MonadCatch e (ErrorT e m) (ErrorT e m) where catch = catchError++instance MonadCatch e m m' => MonadCatch e (ListT m) (ListT m') where catch (ListT m) h = ListT (Catch.catch m (runListT . h))+instance MonadCatch e m m' => MonadCatch e (ReaderT r m) (ReaderT r m') where catch (ReaderT m) h = ReaderT (\s -> Catch.catch (m s) ((`runReaderT` s) . h))++instance (Monoid w, MonadCatch e m m') => MonadCatch e (WriterT w m) (WriterT w m') where catch (WriterT m) h = WriterT (Catch.catch m (runWriterT . h))++instance MonadCatch e m m' => MonadCatch e (StateT s m) (StateT s m') where catch (StateT m) h = StateT (\s -> Catch.catch (m s) ((`runStateT` s) . h))++instance (Monoid w, MonadCatch e m m') => MonadCatch e (RWST r w s m) (RWST r w s m') where catch (RWST m) h = RWST (\r s -> Catch.catch (m r s) ((\m -> runRWST m r s) . h))