packages feed

monad-exception (empty) → 0.1

raw patch · 7 files changed

+577/−0 lines, 7 filesdep +basedep +monad-controldep +mtl-evil-instancessetup-changed

Dependencies added: base, monad-control, mtl-evil-instances, transformers, transformers-base

Files

+ CONTRIBUTORS view
@@ -0,0 +1,1 @@+Shane O'Brien <shane@duairc.com>
+ LICENSE view
@@ -0,0 +1,2 @@+may the last IP lawyer be hung+with the guts of the last cop
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ monad-exception.cabal view
@@ -0,0 +1,80 @@+name:           monad-exception+version:        0.1+synopsis:       Exstensible monadic exceptions+license:        PublicDomain+license-file:   LICENSE+author:         Shane O'Brien+maintainer:     shane@duairc.com+stability:      Experimental+category:       Control+cabal-version:  >= 1.6+build-type:     Simple+description:+  Extensible exceptions are a good solution to the exception problem in+  Haskell. However, there is one problem: they are not extensible enough!+  The problem is that the functions defined in @Control.Exception@ for dealing+  with exceptions can only be used with the @IO@ monad. A lot of Haskell code+  uses a stack of monads, at the bottom of which is @IO@, but the @IO@ monad+  is not used directly.+  .+  There have been many attempts to solve this problem, but the stumbling block+  has been the presence of short-circuiting monad transformers: sometimes,+  these prevented the cleanup actions from being run, making it effectively+  impossible to catch exceptions in such monads. The @monad-control@ package+  has been developed as a solution to this problem: it defines a way to turn+  a monad transformer stack \"inside-out\", which ensures that cleanup actions+  are run even when the original action short-circuits. The @lifted-base@+  package, built on top of @monad-control@, exports the+  @Control.Exception.Lifted@ module, which contains versions of the+  "Control.Exception" functions that work on any monad stack with @IO@ at its+  base.+  .+  This has pretty much solved the above problems. However, one thing that the+  solutions that came before @monad-control@ did was provide a type class+  encapsulating exception functionality that could be implemented by pure+  monads, allowing you to use the same interface to throw and catch exceptions+  in both pure and @IO@-based code. This also makes it possible to express+  which can throw an exception, but which don't necessarily do any IO and+  which are polymorphic in their exception throwing (i.e., you could run the+  function in @IO@ and it would use @throwIO@, or you could run it as an+  @Either@ and it would use @Left@).+  .+  That's what this package does. It provides a @MonadException@ type class (in+  the "Control.Monad.Exception.Class" module), which has instances for @IO@+  and @IO@-like monads (for which @monad-control@ is used to provide the+  correct instances as described above), as well as for some pure monads.+  Several overlapping instances (in the spirit of @mtl-evil-instances@) are+  provided, so it is not necessary to provide a pass-through instance for+  @MonadException@ for every monad transformer you write.+  .+  This package also defines an @ExceptionT@ monad transformer (in+  "Control.Monad.Trans.Exception") that can be used to add @MonadException@+  functionality to otherwise pure monad stacks. @mtl-evil-instances@ is used+  to automatically provide pass-through instances for the @mtl@ type classes+  for this transformer.+  .+  Finally, this package includes the module "Control.Exception.Monadic", which+  is a full replacement for "Control.Exception", whose functions work on+  any instance of @MonadException@ and not just @IO@. The functions for+  dealing with asynchronous exceptions require @IO@ however, so these are only+  polymorphic for any @IO@-like monadic (as determined by @monad-control@).+++extra-source-files:+  CONTRIBUTORS++Library+  hs-source-dirs:+    src++  exposed-modules:+    Control.Exception.Monadic,+    Control.Monad.Exception.Class,+    Control.Monad.Trans.Exception++  build-depends:+    base > 4 && < 5,+    monad-control > 0.3 && < 0.4,+    mtl-evil-instances < 0.2,+    transformers-base < 0.5,+    transformers > 0.2 && < 0.3
+ src/Control/Exception/Monadic.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}++{-|++This module is intended as a drop-in replacement for "Control.Exception".++-}++module Control.Exception.Monadic+    (+      MonadException (..)++    -- * Catching exceptions+    -- ** The @catch@ functions+    , catches+    , Handler (..)+    , catchJust++    -- ** The @handle@ functions+    , handle+    , handleJust++    -- ** The @try@ functions+    , try+    , tryJust++    -- * Utilities+    , bracket_+    , bracketOnError+    , finally+    , onException++    -- * The @evaluate@ functions+    , evaluate+    , unsafeEvaluate++    -- * The @mapException@ function+    , E.mapException++    -- * Asynchronous exceptions+    , throwTo+    , mask+    , mask_+    , uninterruptibleMask+    , uninterruptibleMask_+    , E.MaskingState (..)+    , getMaskingState+    , allowInterrupt++    -- * Exceptions (re-exported from Control.Exception)+    , E.SomeException (..)+    , E.Exception (..)+    , E.IOException+    , E.ArithException (..)+    , E.ArrayException (..)+    , E.AssertionFailed (..)+    , E.AsyncException (..)+    , E.NonTermination (..)+    , E.NestedAtomically (..)+    , E.BlockedIndefinitelyOnMVar (..)+    , E.BlockedIndefinitelyOnSTM (..)+    , E.Deadlock (..)+    , E.NoMethodError (..)+    , E.PatternMatchFail (..)+    , E.RecConError (..)+    , E.RecSelError (..)+    , E.RecUpdError (..)+    , E.ErrorCall (..)+    )+where++import           Control.Concurrent (ThreadId)+import           Control.Exception (Exception (..), SomeException)+import qualified Control.Exception as E+import           Control.Monad (liftM)+import           Control.Monad.Base (MonadBase (..))+import           Control.Monad.Exception.Class+import           Control.Monad.Trans.Control+                     ( MonadBaseControl+                     , liftBaseOp+                     , liftBaseOp_+                     )+import           Control.Monad.Trans.Exception+import           Prelude hiding (catch)+import           System.IO.Unsafe (unsafePerformIO)+++------------------------------------------------------------------------------+-- | Generalized version of 'E.catches'.+catches :: MonadException m => m a -> [Handler m a] -> m a+catches m handlers = m `catch` go handlers+  where+    go [] e = throw e+    go (Handler handler:xs) e = maybe (go xs e) handler (fromException e)+++------------------------------------------------------------------------------+-- | Generalized version of 'E.Handler'. You need this when using 'catches'.+data Handler m a = forall e. Exception e => Handler (e -> m a)+++------------------------------------------------------------------------------+-- | Generalized version of 'E.catchJust'.+catchJust+    :: (MonadException m, Exception e)+    => (e -> Maybe b)+    -> m a+    -> (b -> m a)+    -> m a+catchJust p a handler = catch a (\e -> maybe (throw e) handler (p e))+++------------------------------------------------------------------------------+-- | A version of 'catch' with the arguments swapped around. See 'E.handle'.+handle :: (MonadException m, Exception e) => (e -> m a) -> m a -> m a+handle = flip catch+++------------------------------------------------------------------------------+-- | A version of 'catchJust' with the arguments swapped around. See+-- 'E.handleJust'.+handleJust+    :: (MonadException m, Exception e)+    => (e -> Maybe b)+    -> (b -> m a)+    -> m a+    -> m a+handleJust p = flip (catchJust p)+++------------------------------------------------------------------------------+-- | A generalized version of 'E.try'.+try :: (MonadException m, Exception e) => m a -> m (Either e a)+try = handle (return . Left) . liftM Right+++------------------------------------------------------------------------------+-- | A generalized version of 'E.tryJust'.+tryJust+    :: (MonadException m, Exception e)+    => (e -> Maybe b)+    -> m a+    -> m (Either b a)+tryJust p = handleJust p (return . Left) . liftM Right+++------------------------------------------------------------------------------+-- | Generalized version of 'E.bracketOnError'.+bracketOnError :: MonadException m => m a -> (a -> m b) -> (a -> m c) -> m c+bracketOnError a b c = bracket+    (bracket+        a+        (const (return ()))+        (\a' -> liftM Right (c a') `catch` \e -> return (Left (e, a'))))+    (const (return ()))+    (\e -> case e of+        Right c' -> return c'+        Left (e@(E.SomeException _), a') -> bracket+            (b a')+            (const (return ()))+            (const (throw e)))+++------------------------------------------------------------------------------+-- | Generalized version of 'E.bracket_'.+bracket_ :: MonadException m => m a -> m b -> m c -> m c+bracket_ a b c = bracket a (const b) (const c)+++------------------------------------------------------------------------------+-- | Generalized version of 'E.finally'.+finally :: MonadException m => m a -> m b -> m a+finally a b = bracket_ (return ()) b a+++------------------------------------------------------------------------------+-- | Generalized version of 'E.onException'.+onException :: MonadException m => m a -> m b -> m a+onException a b = a `catch` \e -> b >> throw (e :: SomeException)+++------------------------------------------------------------------------------+-- | Generalized version of 'E.evaluate'. This only works on 'IO'-like monads.+-- See 'unsafeEvaluate' for a version that works on every 'MonadException'.+evaluate :: MonadBase IO m => a -> m a+evaluate = liftBase . E.evaluate+++------------------------------------------------------------------------------+-- | Generalized version of 'E.evaluate'. This uses 'unsafePerformIO' behind+-- the scenes to do something kind of similar to what the @spoon@ package+-- does.+unsafeEvaluate :: MonadException m => a -> m a+unsafeEvaluate = either throw return . unsafePerformIO . try' . evaluate+  where+    try' :: IO a -> IO (Either SomeException a)+    try' = E.try+++------------------------------------------------------------------------------+-- | Generalized version of 'throwTo'.+throwTo :: (MonadBase IO m, Exception e) => ThreadId -> e -> m ()+throwTo tid e = liftBase $ E.throwTo tid e+++------------------------------------------------------------------------------+-- | Generalized version of 'E.mask'.+mask+    :: MonadBaseControl IO m+    => ((forall n b. MonadBaseControl IO n => n b -> n b) -> m a)+    -> m a+mask = liftBaseOp E.mask . liftUnmask+  where+    liftUnmask+        :: ((forall m a. MonadBaseControl IO m => m a -> m a) -> b)+        -> (forall a. IO a -> IO a)+        -> b+    liftUnmask f unmask = f $ liftBaseOp_ unmask+++------------------------------------------------------------------------------+-- | Generalized version of 'E.mask'.+mask_ :: MonadBaseControl IO m => m a -> m a+mask_ = mask . const+++------------------------------------------------------------------------------+-- | Generalized version of 'E.mask'.+uninterruptibleMask+    :: MonadBaseControl IO m+    => ((forall n b. MonadBaseControl IO n => n b -> n b) -> m a)+    -> m a+uninterruptibleMask = liftBaseOp E.uninterruptibleMask . liftUnmask+  where+    liftUnmask+        :: ((forall m a. MonadBaseControl IO m => m a -> m a) -> b)+        -> (forall a. IO a -> IO a)+        -> b+    liftUnmask f unmask = f $ liftBaseOp_ unmask+++------------------------------------------------------------------------------+-- | Generalized version of 'E.mask'.+uninterruptibleMask_ :: MonadBaseControl IO m => m a -> m a+uninterruptibleMask_ = uninterruptibleMask . const+++------------------------------------------------------------------------------+-- | Generalized version of 'E.getMaskingState'.+getMaskingState :: MonadBase IO m => m E.MaskingState+getMaskingState = liftBase E.getMaskingState+++------------------------------------------------------------------------------+-- | Generalized version of 'E.allowInterrupt'.+allowInterrupt :: MonadBase IO m => m ()+allowInterrupt = liftBase E.allowInterrupt
+ src/Control/Monad/Exception/Class.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++{-|++This module exports the 'MonadException' type class.++-}++module Control.Monad.Exception.Class+    ( -- * The @MonadException@ class+      MonadException (..)+    )+where++import           Control.Exception (Exception, SomeException (..))+import qualified Control.Exception as E+import           Control.Monad.Base (liftBase)+import           Control.Monad.IO.Class (MonadIO (..))+import           Control.Monad.Trans.Class (MonadTrans (..))+import           Control.Monad.Trans.Control+                     ( MonadBaseControl (..)+                     , MonadTransControl (..)+                     , Run+                     , control+                     )+import           Prelude hiding (catch)+++------------------------------------------------------------------------------+-- | The 'MonadException' type class. Minimal complete definition: 'throw',+-- 'catch'.+class Monad m => MonadException m where+    -- | Generalized version of 'E.throwIO'.+    throw :: Exception e => e -> m a++    -- | Generalized version of 'E.catch'.+    catch :: Exception e => m a -> (e -> m a) -> m a++    -- | Generalized version of 'E.bracket'.+    bracket :: m a -> (a -> m b) -> (a -> m c) -> m c+    bracket open close thing = do+        a <- open+        b <- thing a `catch` \e@(SomeException _) -> close a >> throw e+        close a+        return b+++------------------------------------------------------------------------------+instance MonadException (Either SomeException) where+    throw = Left . E.toException+    catch m h = either (\e -> maybe (Left e) h (E.fromException e)) Right m+++------------------------------------------------------------------------------+instance MonadException IO where+    throw = E.throwIO+    catch = E.catch+    bracket = E.bracket+++------------------------------------------------------------------------------+instance (MonadException b, MonadBaseControl b m) => MonadException m where+    throw = liftBase . throw+    catch m h = control $ \run -> catch (run m) (run . h)+    bracket a b c = control $ \run -> bracket (run a)+        (\a' -> run $ restoreM a' >>= b)+        (\a' -> run $ restoreM a' >>= c)+++------------------------------------------------------------------------------+instance (MonadTransControl t, Monad (t m), MonadException m) => MonadException (t m) where+    throw = lift . throw+    catch m h = controlT $ \run -> catch (run m) (run . h)+    bracket a b c = controlT $ \run -> bracket (run a)+        (\a' -> run $ restoreT (return a') >>= b)+        (\a' -> run $ restoreT (return a') >>= c)+++------------------------------------------------------------------------------+controlT+    :: (Monad m, Monad (t m), MonadTransControl t)+    => (Run t -> m (StT t a))+    -> t m a+controlT f = liftWith f >>= restoreT . return
+ src/Control/Monad/Trans/Exception.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++{-|++This module exports the 'ExceptionT' monad transformer.++-}++module Control.Monad.Trans.Exception+    ( -- * The @ExceptionT@ transformer+      ExceptionT+    , runExceptionT+    )+where++import           Control.Applicative (Applicative (..), Alternative (..))+import           Control.Exception+                     ( SomeException (..)+                     , Exception (..)+                     , PatternMatchFail (..)+                     )+import           Control.Monad (MonadPlus (..), ap, liftM)+import           Control.Monad.Exception.Class (MonadException (..))+import           Control.Monad.Fix (fix)+import           Control.Monad.Instances.Evil ()+import           Control.Monad.Trans.Class (MonadTrans (..))+import           Control.Monad.Trans.Control+                     ( MonadBaseControl (..)+                     , MonadTransControl (..)+                     , ComposeSt+                     , defaultLiftBaseWith+                     , defaultRestoreM+                     )+import           Prelude hiding (catch)+++------------------------------------------------------------------------------+-- | This is a variant of the 'Either' data type with an additional @Zero@+-- constructor, to allow the implementation of 'Alternative' and 'MonadPlus'+-- instances for 'ExceptionT'.+data Either' a b = Zero | Left' a | Right' b+++------------------------------------------------------------------------------+-- | Case analysis for the 'Either'' type. If the value is 'Left'' @a@, apply+-- the first function to @a@; if it is 'Right'' @b@, apply the second function+-- to @b@. If the value is 'Zero', then apply the first function to+-- @fix@ 'SomeException'.+either' :: (SomeException -> c) -> (b -> c) -> Either' SomeException b -> c+either' f _ Zero = f (fix SomeException)+either' f _ (Left' e) = f e+either' _ f (Right' a) = f a+++------------------------------------------------------------------------------+-- | The 'ExceptionT' monad transformer. This is can be used to add+-- 'MonadException' functionality otherwise pure monad stacks. If your monad+-- stack is built on top of 'IO' however, it already has 'MonadException'+-- functionality and you should use that instead, unless you have a good+-- reason not to. Pass-through instances for the @mtl@ type classes are+-- provided automatically by the @mtl-evil-instances@ package.+newtype ExceptionT m a = ExceptionT (m (Either' SomeException a))+++------------------------------------------------------------------------------+instance MonadTrans ExceptionT where+    lift = ExceptionT . liftM Right'+++------------------------------------------------------------------------------+instance MonadTransControl ExceptionT where+    data StT ExceptionT a = StExceptionT (Either' SomeException a)+    liftWith f = lift $ f (\(ExceptionT m) -> liftM StExceptionT m)+    restoreT = ExceptionT . liftM (\(StExceptionT e) -> e)+++------------------------------------------------------------------------------+instance Monad m => Functor (ExceptionT m) where+    fmap = liftM+++------------------------------------------------------------------------------+instance Monad m => Applicative (ExceptionT m) where+    pure = return+    (<*>) = ap+++------------------------------------------------------------------------------+instance Monad m => Alternative (ExceptionT m) where+    empty = mzero+    (<|>) = mplus+++------------------------------------------------------------------------------+instance Monad m => Monad (ExceptionT m) where+    return = ExceptionT . return . Right'+    (ExceptionT m) >>= f = ExceptionT $ m >>= either' (return . Left') (\a ->+        let ExceptionT m' = f a in m')+    fail = ExceptionT . return . Left' . toException . PatternMatchFail+++------------------------------------------------------------------------------+instance Monad m => MonadPlus (ExceptionT m) where+    mzero = ExceptionT $ return Zero+    mplus (ExceptionT m) (ExceptionT m') = ExceptionT $ m >>= \x -> case x of+        Zero -> m'+        Left' e -> m' >>= \x' -> case x' of+            Right' a -> return (Right' a)+            _ -> return (Left' e)+        Right' a -> return (Right' a)+++------------------------------------------------------------------------------+instance MonadBaseControl b m => MonadBaseControl b (ExceptionT m) where+     newtype StM (ExceptionT m) a = StMT {unStMT :: ComposeSt ExceptionT m a}+     liftBaseWith = defaultLiftBaseWith StMT+     restoreM = defaultRestoreM unStMT+++------------------------------------------------------------------------------+instance Monad m => MonadException (ExceptionT m) where+    throw = ExceptionT . return . Left' . toException+    catch (ExceptionT m) h = ExceptionT $ m >>= \a -> case a of+        Zero -> case fromException (fix SomeException) of+            Nothing -> return a+            Just e' -> let ExceptionT m' = h e' in m'+        Left' e -> case fromException e of+            Nothing -> return a+            Just e' -> let ExceptionT m' = h e' in m'+        _ -> return a+++------------------------------------------------------------------------------+-- | Run the 'ExceptionT' monad transformer. This returns 'Right' if+-- everything goes okay, and 'Left' in the case of an error, with the+-- exception wrapped up in a 'SomeException'.+runExceptionT :: Monad m => ExceptionT m a -> m (Either SomeException a)+runExceptionT (ExceptionT m) = m >>= either' (return . Left) (return . Right)