control-monad-exception 0.3.2 → 0.4
raw patch · 3 files changed
+83/−16 lines, 3 filesdep +mtldep +prettydep +template-haskell
Dependencies added: mtl, pretty, template-haskell
Files
- Control/Monad/Exception.hs +47/−9
- Control/Monad/Exception/Class.hs +16/−1
- control-monad-exception.cabal +20/−6
Control/Monad/Exception.hs view
@@ -3,10 +3,13 @@ {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NamedFieldPuns #-} module Control.Monad.Exception ( EM, evalEM, runEM, runEMParanoid, EMT, evalEMT, runEMT, runEMTParanoid,+ WithSrcLoc, withLocTH, showExceptionWithTrace, MonadZeroException(..), module Control.Monad.Exception.Class ) where @@ -19,7 +22,10 @@ import Control.Monad.RWS.Class import Data.Monoid import Data.Typeable+import qualified Language.Haskell.TH.Syntax+import Language.Haskell.TH.Syntax hiding (lift) import Prelude hiding (catch)+import Text.PrettyPrint type EM l = EMT l Identity @@ -52,19 +58,24 @@ data MonadZeroException = MonadZeroException deriving (Show, Typeable) instance Exception MonadZeroException -newtype EMT l m a = EMT {unEMT :: m (Either (WrapException l) a)}+newtype EMT l m a = EMT {unEMT :: m (Either ([String], WrapException l) a)} type AnyException = Caught SomeException -- | Run explicitly handling exceptions evalEMT :: Monad m => EMT (AnyException l) m a -> m (Either SomeException a)-evalEMT (EMT m) = mapLeft wrapException `liftM` m+evalEMT (EMT m) = mapLeft (wrapException.snd) `liftM` m runEMT_gen :: Monad m => EMT l m a -> m a runEMT_gen (EMT m) = liftM f m where f (Right x) = x- f (Left (WrapException (SomeException e))) = error (show e)+ f (Left e) = error (uncurry showExceptionWithTrace e) +showExceptionWithTrace :: Show e => [String] -> e -> String+showExceptionWithTrace trace e = render$+ text (show e) $$+ text " in" <+> (vcat (map text $ reverse trace))+ -- | Run a safe computation runEMT :: Monad m => EMT NoExceptions m a -> m a runEMT = runEMT_gen@@ -93,19 +104,46 @@ (<*>) = ap instance (Exception e, Throws e l, Monad m) => MonadThrow e (EMT l m) where- throw = EMT . return . Left . WrapException . toException+ throw = EMT . return . (\e -> Left ([],e)) . WrapException . toException instance (Exception e, Monad m) => MonadCatch e (EMT (Caught e l) m) (EMT l m) where- catch = catchEMT+ catchWithSrcLoc = catchEMT+ catch emt h = catchEMT emt (\_ -> h) -catchEMT :: (Exception e, Monad m) => EMT (Caught e l) m a -> (e -> EMT l m a) -> EMT l m a+catchEMT :: (Exception e, Monad m) => EMT (Caught e l) m a -> ([String] -> e -> EMT l m a) -> EMT l m a catchEMT emt h = EMT $ do v <- unEMT emt case v of Right x -> return (Right x)- Left (WrapException e) -> case fromException e of- Nothing -> return (Left (WrapException e))- Just e' -> unEMT (h e')+ Left (trace, WrapException e) -> case fromException e of+ Nothing -> return (Left (trace,WrapException e))+ Just e' -> unEMT (h trace e')+withLocTH :: Q Exp+withLocTH = do+ loc <- qLocation+ let loc_msg = showLoc loc+ [| withLoc loc_msg |]+ where+ showLoc Loc{loc_module, loc_filename, loc_start} = render $+ {- text loc_package <> dot <> -}+ text loc_module <> dot <> text loc_filename <> colon <+> text (show loc_start)+ dot = char '.' +-- | Generating stack traces for exceptions+class WithSrcLoc a where+-- | 'withLoc' records the given source location in the exception stack trace+-- when used to wrap a EMT computation.+--+-- On any other monad or value, 'withLoc' is defined as the identity+ withLoc :: String -> a -> a++instance WithSrcLoc a where withLoc _ = id++instance Monad m => WithSrcLoc (EMT l m a) where+ withLoc loc (EMT emt) = EMT $ do+ current <- emt+ case current of+ (Left (tr, a)) -> return (Left (loc:tr, a))+ _ -> return current instance (Throws MonadZeroException l) => MonadPlus (EM l) where mzero = throw MonadZeroException
Control/Monad/Exception/Class.hs view
@@ -17,12 +17,22 @@ import Control.Monad import Control.Monad.Trans+#if TRANSFORMERS 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+#else+import Control.Monad.Error+import Control.Monad.List+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Writer+import Control.Monad.RWS+#endif+ #if __GLASGOW_HASKELL__ < 610 import Control.Exception.Extensible (Exception(..), SomeException) import qualified Control.Exception.Extensible as Control.Exception@@ -56,12 +66,16 @@ class Monad m => MonadThrow e m where throw :: e -> m a+ throwWithSrcLoc :: String -> e -> m a+ throwWithSrcLoc _ = throw 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+ catchWithSrcLoc :: m a -> ([String] -> e -> m' a) -> m' a+ catchWithSrcLoc m h = catch m (h []) instance Exception e => MonadCatch e IO IO where catch = Control.Exception.catch@@ -94,7 +108,8 @@ -- Labelled SomeException -- ------------------------ -- | @WrapException@ adds a phantom type parameter @l@ to @SomeException@-newtype WrapException l = WrapException {wrapException::SomeException} deriving (Show,Typeable)+newtype WrapException l = WrapException {wrapException::SomeException} deriving (Typeable)+instance Show (WrapException l) where show (WrapException e) = show e -- Throw and Catch instances for the Either and ErrorT monads -- -----------------------------------------------------------
control-monad-exception.cabal view
@@ -1,11 +1,11 @@ name: control-monad-exception-version: 0.3.2+version: 0.4 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+homepage: http://safe-tools.dsic.upv.es/mediawiki/index.php/Jose_Iborra/Papers/Exceptions description: This package provides explicitly typed, checked exceptions as a library. @@ -35,13 +35,21 @@ > eval `catch` \ (e::DivideByZero) -> return (-1) :: Throws SumOverflow l => Expr -> EM l Double > runEM(eval `catch` \ (e::SomeException) -> return (-1)) :: Expr -> Double -synopsis: Explicitly typed exceptions+ New in version 0.4:+ * (optionally) Unchecked exceptions (with 'UncaughtException')+ * Exception stack traces (with 'WithSrcLoc')++synopsis: Explicitly typed, checked exceptions with stack traces category: Control, Monads stability: experimental tested-with: GHC ==6.8.2 tested-with: GHC ==6.10.2 tested-with: GHC ==6.10.3 +Flag transformers+ description: Use transformers and monads-fd instead of mtl+ default: True + Flag extensibleExceptions description: Use extensible-exception package default: False@@ -56,15 +64,21 @@ build-depends: base >= 4 && < 5 - build-depends:- transformers >= 0.0.1 && <0.2,- monads-fd >= 0.0 && <0.1+ if flag(transformers)+ cpp-options: -DTRANSFORMERS+ build-depends:+ transformers >= 0.0.1 && <0.2,+ monads-fd >= 0.0 && <0.1+ else+ build-depends: mtl+ extensions: MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, EmptyDataDecls, DeriveDataTypeable, UndecidableInstances+ build-depends: pretty, template-haskell exposed-modules: Control.Monad.Exception.Class Control.Monad.Exception