control-monad-exception (empty) → 0.1
raw patch · 4 files changed
+235/−0 lines, 4 filesdep +basedep +monads-fddep +transformerssetup-changed
Dependencies added: base, monads-fd, transformers
Files
- Control/Monad/Exception.hs +116/−0
- Control/Monad/Exception/Class.hs +63/−0
- Setup.lhs +3/−0
- control-monad-exception.cabal +53/−0
+ Control/Monad/Exception.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE UndecidableInstances #-}+module Control.Monad.Exception (+ module Control.Monad.Exception,+ module Control.Monad.Exception.Class ) where++import Control.Monad.Exception.Class+import Control.Monad.Fix+import Control.Monad.Trans+import Control.Monad.Cont.Class+import Control.Monad.Reader.Class+import Control.Monad.State.Class+import Control.Monad.Writer.Class+import Control.Monad.RWS.Class+import Data.Monoid+import Data.Typeable+import Prelude hiding (catch)++newtype EM l a = EM {runEM::Either SomeException a}++instance Functor (EM l) where+ fmap f (EM (Left e)) = EM (Left e)+ fmap f (EM (Right x)) = EM (Right (f x))++instance Monad (EM l) where+ return = EM . Right+ EM (Right x) >>= f = f x+ EM (Left e) >>= _ = EM (Left e)++instance (Exception e, Throws e l) => MonadThrow e (EM l) where+ throw = EM . Left . toException+instance Exception e => MonadCatch e (EM (Caught e l)) (EM l) where+ catch (EM(Right x)) h = EM (Right x)+ catch (EM(Left e)) h = case fromException e of+ Nothing -> EM (Left e)+ Just e' -> h e'++data MonadZero = MonadZero deriving (Show, Typeable)+instance Exception MonadZero+++-- Requires undecidable instances+instance Throws MonadZero l => MonadPlus (EM l) where+ mzero = throw MonadZero+ mplus (EM (Left _)) p2 = p2+ mplus p1@(EM Right{}) p2 = p1++newtype EMT l m a = EMT {runEMT :: m (Either SomeException a)}++instance Monad m => Functor (EMT l m) where+ fmap f emt = EMT $ do+ v <- runEMT emt+ case v of+ Left e -> return (Left e)+ Right x -> return (Right (f x))++instance Monad m => Monad (EMT l m) where+ return = EMT . return . Right+ emt >>= f = EMT $ do+ v <- runEMT emt+ case v of+ Left e -> return (Left e)+ Right x -> runEMT (f x)++instance (Exception e, Throws e l, Monad m) => MonadThrow e (EMT l m) where+ throw = EMT . return . Left . toException+instance (Exception e, Monad m) => MonadCatch e (EMT (Caught e l) m) (EMT l m) where+ catch emt h = EMT $ do+ v <- runEMT emt+ case v of+ Right x -> return (Right x)+ Left e -> case fromException e of+ Nothing -> return (Left e)+ Just e' -> runEMT (h e')+++instance (Monad m, Throws MonadZero l) => MonadPlus (EMT l m) where+ mzero = throw MonadZero+ mplus emt1 emt2 = EMT$ do+ v1 <- runEMT emt1+ case v1 of+ Left _ -> runEMT emt2+ Right _ -> return v1++instance MonadTrans (EMT l) where lift = EMT . liftM Right++instance MonadFix m => MonadFix (EMT l m) where+ mfix f = EMT $ mfix $ \a -> runEMT $ f $ case a of+ Right r -> r+ _ -> error "empty fix argument"++instance MonadIO m => MonadIO (EMT l m) where+ liftIO = lift . liftIO++instance MonadCont m => MonadCont (EMT l m) where+ callCC f = EMT $ callCC $ \c -> runEMT (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 (runEMT 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 (runEMT m)+ return (fmap (\x -> (x,w)) res)+ pass m = EMT $ pass $ do+ a <- runEMT 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)
+ Control/Monad/Exception/Class.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE UndecidableInstances #-}+module Control.Monad.Exception.Class (+ module Control.Monad,+ module Control.Monad.Exception.Class,+ Exception(..), SomeException) where++import Control.Monad+import Control.Monad.Trans+import Control.Monad.Trans.Error+import Control.Monad.Trans.List+import Control.Monad.Trans.Reader+import Control.Monad.Trans.State+import Control.Monad.Trans.Writer+import Control.Monad.Trans.RWS+import Control.Exception (Exception(..), SomeException)+import qualified Control.Exception+import Data.Monoid+import Prelude hiding (catch)++class Exception e => Throws e s++class Monad m => MonadThrow e m where+ throw :: e -> m a++instance Exception e => MonadThrow e IO where+ throw = Control.Exception.throw++class (Monad m, Monad m') => MonadCatch e m m' | e m -> m', e m' -> m where+ catch :: m a -> (e -> m' a) -> m' a++instance Exception e => MonadCatch e IO IO where+ catch = Control.Exception.catch++data Caught e l++instance Exception e => Throws e (Caught e l)+instance Throws e l => Throws e (Caught e1 l)+instance Exception e => Throws e (Caught SomeException l)++-- Throw and Catch instances for the Either and ErrorT monads++instance (Error e) => MonadThrow e (Either e) where throw = Left+instance (Error e) => MonadCatch e (Either e) (Either e) where catch m h = either h Right m++instance (Error e, Monad m) => MonadThrow e (ErrorT e m) where throw = throwError+instance (Error e, Monad m) => MonadCatch e (ErrorT e m) (ErrorT e m) where catch = catchError++-- Instances for transformers (requires undecidable instances in some cases)++instance MonadThrow e m => MonadThrow e (ListT m) where throw = lift . throw+instance MonadCatch e m m' => MonadCatch e (ListT m) (ListT m') where catch (ListT m) h = ListT (catch m (runListT . h))++instance MonadThrow e m => MonadThrow e (ReaderT r m) where throw = lift . throw+instance MonadCatch e m m' => MonadCatch e (ReaderT r m) (ReaderT r m') where catch (ReaderT m) h = ReaderT (\s -> catch (m s) ((`runReaderT` s) . h))++instance (Monoid w, MonadThrow e m) => MonadThrow e (WriterT w m) where throw = lift . throw+instance (Monoid w, MonadCatch e m m') => MonadCatch e (WriterT w m) (WriterT w m') where catch (WriterT m) h = WriterT (catch m (runWriterT . h))++instance MonadThrow e m => MonadThrow e (StateT s m) where throw = lift . throw+instance MonadCatch e m m' => MonadCatch e (StateT s m) (StateT s m') where catch (StateT m) h = StateT (\s -> catch (m s) ((`runStateT` s) . h))++instance (Monoid w, MonadThrow e m) => MonadThrow e (RWST r w s m) where throw = lift . throw+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 (m r s) ((\m -> runRWST m r s) . h))
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ control-monad-exception.cabal view
@@ -0,0 +1,53 @@+name: control-monad-exception+version: 0.1+Cabal-Version: >= 1.2.3+build-type: Simple+license: PublicDomain+author: Pepe Iborra+maintainer: pepeiborra@gmail.com+homepage: http://github.com/pepeiborra/control-monad-exception+description: + This package provides explicitly typed exceptions as a library.+ .+ /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+synopsis: Explicitly typed exceptions+category: Control, Monads+stability: experimental+++Library+ buildable: True+ build-depends: base >= 4.0, transformers, monads-fd+ extensions: MultiParamTypeClasses, + FunctionalDependencies,+ OverlappingInstances, + FlexibleInstances,+ EmptyDataDecls,+ DeriveDataTypeable,+ UndecidableInstances+ exposed-modules:+ Control.Monad.Exception.Class+ Control.Monad.Exception