monad-abort-fd 0.5 → 0.6

raw patch · 7 files changed

+65/−463 lines, 7 filesdep +transformers-compatdep −monad-controldep −taggeddep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: transformers-compat

Dependencies removed: monad-control, tagged

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +7/−7
• monad-abort-fd.cabal +10/−14
• src/Control/Monad/Abort.hs +2/−3
• src/Control/Monad/Abort/Class.hs +36/−12
• src/Control/Monad/Exception.hs +0/−418
• src/Control/Monad/Finish.hs +2/−3
• src/Control/Monad/Finish/Class.hs +8/−6

@@ -1,16 +1,16 @@-Copyright (c) 2011, Mikhail Vorozhtsov+Copyright (c) 2011-2016, Mikhail Vorozhtsov All rights reserved. -Redistribution and use in source and binary forms, with or without +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -- Redistributions of source code must retain the above copyright notice, +- Redistributions of source code must retain the above copyright notice,   this list of conditions and the following disclaimer.-- Redistributions in binary form must reproduce the above copyright -  notice, this list of conditions and the following disclaimer in the +- Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions and the following disclaimer in the   documentation and/or other materials provided with the distribution.-- Neither the names of the copyright owners nor the names of the -  contributors may be used to endorse or promote products derived +- Neither the names of the copyright owners nor the names of the+  contributors may be used to endorse or promote products derived   from this software without specific prior written permission.  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

@@ -1,5 +1,5 @@ Name: monad-abort-fd-Version: 0.5+Version: 0.6 Category: Control Stability: experimental Synopsis: A better error monad transformer@@ -12,10 +12,12 @@  Author: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com> Maintainer: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>-Copyright: 2011 Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>+Copyright: 2011-2016 Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com> License: BSD3 License-File: LICENSE +Tested-With: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2+ Cabal-Version: >= 1.6.0 Build-Type: Simple @@ -24,17 +26,12 @@   Location: https://github.com/mvv/monad-abort-fd.git  Library-  if impl(ghc >= 7.7)-    Build-Depends: base >= 4.7 && < 5-  else-    Build-Depends: base >= 4.3 && < 5-                 , tagged >= 0.5-  Build-Depends:-    transformers       >= 0.2,-    transformers-base  >= 0.4,-    transformers-abort >= 0.4,-    mtl                >= 2.0,-    monad-control      >= 0.3+  Build-Depends: base >= 4.3 && < 5+  Build-Depends: transformers        >= 0.2+               , transformers-compat >= 0.5+               , transformers-base   >= 0.4+               , transformers-abort  >= 0.4+               , mtl                 >= 2.0   Hs-Source-Dirs: src   GHC-Options: -Wall   Exposed-Modules:@@ -42,4 +39,3 @@     Control.Monad.Abort     Control.Monad.Finish.Class     Control.Monad.Finish-    Control.Monad.Exception

@@ -1,6 +1,7 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE UnicodeSyntax #-} +-- | Error monad transformer and monad type classes for raising+-- errors and recovering from them. module Control.Monad.Abort   ( MonadAbort(..)   , MonadRecover(..)@@ -19,9 +20,7 @@  import Control.Monad import Control.Monad.Fix-#if !MIN_VERSION_base(4,6,0) import Control.Monad.Instances ()-#endif import Control.Monad.Trans import Control.Monad.Trans.Abort hiding (abort, recover) import Control.Monad.Abort.Class

@@ -8,12 +8,13 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +-- | Monad type classes for raising errors and recovering from them. module Control.Monad.Abort.Class   ( MonadAbort(..)   , MonadRecover(..)   , onError   , onError_-  , ignore+  , ignoreErrors   ) where  #if !MIN_VERSION_base(4,6,0)@@ -27,9 +28,7 @@ import Control.Monad.Cont import Control.Monad.List import Control.Monad.Error-#if MIN_VERSION_transformers(0,4,0)-import Control.Monad.Except-#endif+import Control.Monad.Trans.Except import Control.Monad.Reader import Control.Monad.State (MonadState(..)) import qualified Control.Monad.State.Lazy as L@@ -43,22 +42,49 @@ import Control.Monad.Trans.Abort (AbortT(..)) import qualified Control.Monad.Trans.Abort as A +-- | Class of monads that support raising of errors. class (Applicative μ, Monad μ) ⇒ MonadAbort e μ | μ → e where+  -- | Raise an error.+  --+  -- @+  --     'abort' e >>= rest = 'abort' e+  -- @   abort ∷ e → μ α +-- | Class of monads that support recovery from errors. class MonadAbort e μ ⇒ MonadRecover e μ | μ → e where+#if __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL recover | evaluate #-}+#endif+  -- | @'recover' m h@ recovers from errors raised in computation @m@ using+  -- the provided error handler @h@. The default implementation is+  --+  -- @+  --   'evaluate' m '>>=' 'either' h 'return'+  -- @   recover ∷ μ α → (e → μ α) → μ α+  recover m h = evaluate m >>= either h return+  -- | @'evaluate' m@ runs computation @m@, returning @'Left' e@ if it+  -- raised an error @e@. The default implementation is+  --+  -- @+  --    'recover' ('Right' '<$>' m) ('return' . 'Left')+  -- @   evaluate ∷ μ α → μ (Either e α)   evaluate m = recover (Right <$> m) (return . Left) +-- | Run an action on error, without recovering from it. onError ∷ MonadRecover e μ ⇒ μ α → (e → μ β) → μ α onError m h = recover m (\e → h e >> abort e) +-- | Run an action on error (ignoring the error value), without recovering+-- from it. onError_ ∷ MonadRecover e μ ⇒ μ α → μ β → μ α onError_ m = onError m . const -ignore ∷ MonadRecover e μ ⇒ μ α → μ ()-ignore m = recover (m >> return ()) (const $ return ())+-- | Silently recover from all errors.+ignoreErrors ∷ MonadRecover e μ ⇒ μ α → μ ()+ignoreErrors m = recover (m >> return ()) (const $ return ())  instance (Functor μ, Monad μ) ⇒ MonadAbort e (AbortT e μ) where   abort = A.abort@@ -165,16 +191,14 @@   recover m h = S.RWST $ \r s →     S.runRWST m r s `recover` (\e → S.runRWST (h e) r s) -instance (Monad μ, Error e) ⇒ MonadAbort e (ErrorT e μ) where+instance (Functor μ, Monad μ, Error e) ⇒ MonadAbort e (ErrorT e μ) where   abort = throwError -instance (Monad μ, Error e) ⇒ MonadRecover e (ErrorT e μ) where+instance (Functor μ, Monad μ, Error e) ⇒ MonadRecover e (ErrorT e μ) where   recover = catchError -#if MIN_VERSION_transformers(0,4,0)-instance Monad μ ⇒ MonadAbort e (ExceptT e μ) where+instance (Functor μ, Monad μ) ⇒ MonadAbort e (ExceptT e μ) where   abort = throwError -instance Monad μ ⇒ MonadRecover e (ExceptT e μ) where+instance (Functor μ, Monad μ) ⇒ MonadRecover e (ExceptT e μ) where   recover = catchError-#endif

@@ -1,418 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UnicodeSyntax #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ImpredicativeTypes #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Control.Monad.Exception-  ( exception-  , forceWHNF-  , throw-  , throwIO-  , catch-  , catchJust-  , handle-  , handleJust-  , Handler(..)-  , catches-  , try-  , tryJust-  , onException-  , onExceptions-  , MonadFinally(..)-  , onEscape-  , tryAll-  , MonadMask(..)-  , mask-  , mask_-  , uninterruptibleMask-  , uninterruptibleMask_-  , bracket-  , bracket_-  , bracketOnEscape-  , bracketOnError-  , module Control.Monad.Abort.Class-  , module Control.Exception-  ) where--#if !MIN_VERSION_base(4,6,0)-import Prelude hiding (catch)-#endif-import Data.Monoid (Monoid)-import Data.Proxy (Proxy(..))-import Data.Traversable-import Data.Functor.Identity-import Control.Applicative (Applicative)-import Control.Monad (join, liftM)-import Control.Monad.Base-import Control.Monad.Trans.Class-import Control.Monad.Trans.Control-import Control.Monad.Trans.Abort hiding (abort, recover)-import Control.Monad.Trans.Finish-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.List-import Control.Monad.Trans.Error-#if MIN_VERSION_transformers(0,4,0)-import Control.Monad.Trans.Except-#endif-import Control.Monad.Trans.Reader-import qualified Control.Monad.Trans.State.Lazy as L-import qualified Control.Monad.Trans.State.Strict as S-import qualified Control.Monad.Trans.Writer.Lazy as L-import qualified Control.Monad.Trans.Writer.Strict as S-import qualified Control.Monad.Trans.RWS.Lazy as L-import qualified Control.Monad.Trans.RWS.Strict as S-import Control.Monad.Abort.Class-import Control.Exception hiding (-  evaluate, throw, throwIO, catch, catchJust, handle, handleJust,-  Handler(..), catches, try, tryJust, finally, onException,-#if !MIN_VERSION_base(4,7,0)-  block, unblock, blocked,-#endif-  getMaskingState, mask, mask_, uninterruptibleMask,-  uninterruptibleMask_, bracket, bracket_, bracketOnError)-import qualified Control.Exception as E-import GHC.Base (maskAsyncExceptions#, maskUninterruptible#,-                 unmaskAsyncExceptions#)-import GHC.IO (IO(..))--exception ∷ Exception e ⇒ e → α-exception = E.throw--forceWHNF ∷ MonadBase IO μ ⇒ α → μ α-forceWHNF = liftBase . E.evaluate--throw ∷ (MonadAbort SomeException μ, Exception e) ⇒ e → μ α-throw = abort . toException--throwIO ∷ (MonadBase IO μ, Exception e) ⇒ e → μ α-throwIO = liftBase . E.throwIO--catch ∷ (MonadRecover SomeException μ, Exception e) ⇒ μ α → (e → μ α) → μ α-catch m h = recover m $ \e → maybe (throw e) h (fromException e)--catchJust ∷ (MonadRecover SomeException μ, Exception e)-          ⇒ (e → Maybe β) → μ α → (β → μ α) → μ α-catchJust f m h = catch m $ \e → maybe (throw e) h $ f e--handle ∷ (MonadRecover SomeException μ, Exception e) ⇒ (e → μ α) → μ α → μ α-handle = flip catch--handleJust ∷ (MonadRecover SomeException μ, Exception e)-           ⇒ (e → Maybe β) → (β → μ α) → μ α → μ α-handleJust = flip . catchJust--data Handler μ α = ∀ e . Exception e ⇒ Handler (e → μ α)--catches ∷ MonadRecover SomeException μ ⇒ μ α → [Handler μ α] → μ α-catches m = recover m . hl-  where hl [] e = abort e-        hl (Handler h : hs) e = maybe (hl hs e) h $ fromException e--try ∷ (MonadRecover SomeException μ, Exception e) ⇒ μ α → μ (Either e α)-try m = do-  r ← evaluate m-  case r of-    Right a → return $ Right a-    Left e | Just e' ← fromException e → return $ Left e'-    Left e → throw e--tryJust ∷ (MonadRecover SomeException μ, Exception e)-        ⇒ (e → Maybe β) → μ α → μ (Either β α)-tryJust f m = do-  r ← evaluate m-  case r of-    Right a → return $ Right a-    Left e | Just b ← fromException e >>= f → return $ Left b-    Left e → throw e--onException ∷ (MonadRecover SomeException μ, Exception e)-            ⇒ μ α → (e → μ β) → μ α-onException m h = catch m (\e → h e >> throw e)--onExceptions ∷ MonadRecover SomeException μ-             ⇒ μ α → [Handler μ β] → μ α-onExceptions m = recover m . hl-  where hl [] e = abort e-        hl (Handler h : hs) e =-          maybe (hl hs e) (\e' → h e' >> abort e) $ fromException e--class (Applicative μ, Monad μ) ⇒ MonadFinally μ where-  finally' ∷ μ α → (Maybe α → μ β) → μ (α, β)-  finally  ∷ μ α → μ β → μ α-  finally m = fmap fst . finally' m . const--instance MonadFinally Identity where-  finally' m f = do-    a ← m-    return (a, runIdentity $ f $ Just a)--instance MonadFinally IO where-  finally' m f = E.mask $ \restore → do-    a ← restore m `E.onException` f Nothing-    b ← f $ Just a-    return (a, b)--instance MonadFinally μ ⇒ MonadFinally (MaybeT μ) where-  finally' m f = MaybeT $ do-    ~(mr, fr) ← finally' (runMaybeT m) $ \mbr →-      runMaybeT $ f $ case mbr of-        Just (Just a) → Just a-        _             → Nothing-    return $ (,) <$> mr <*> fr--instance MonadFinally μ ⇒ MonadFinally (ListT μ) where-  finally' m f = ListT $ do-    ~(mrs, frss) ← finally' (runListT m) $ \mbr → case mbr of-      Just rs@(_ : _) → forM rs $ runListT . f . Just-      _ → fmap pure $ runListT $ f Nothing-    return $ zip mrs frss >>= \(mr, frs) → zip (repeat mr) frs--instance MonadFinally μ ⇒ MonadFinally (AbortT e μ) where-  finally' m f = AbortT $ do-    ~(mr, fr) ← finally' (runAbortT m) $ \mbr →-      runAbortT $ f $ case mbr of-        Just (Right a) → Just a-        _              → Nothing-    return $ (,) <$> mr <*> fr--instance MonadFinally μ ⇒ MonadFinally (FinishT β μ) where-  finally' m f = FinishT $ do-    ~(mr, fr) ← finally' (runFinishT m) $ \mbr →-      runFinishT $ f $ case mbr of-        Just (Right a) → Just a-        _              → Nothing-    return $ (,) <$> mr <*> fr--instance (MonadFinally μ, Error e) ⇒ MonadFinally (ErrorT e μ) where-  finally' m f = ErrorT $ do-    ~(mr, fr) ← finally' (runErrorT m) $ \mbr →-      runErrorT $ f $ case mbr of-        Just (Right a) → Just a-        _              → Nothing-    return $ (,) <$> mr <*> fr--#if MIN_VERSION_transformers(0,4,0)-instance MonadFinally μ ⇒ MonadFinally (ExceptT e μ) where-  finally' m f = ExceptT $ do-    ~(mr, fr) ← finally' (runExceptT m) $ \mbr →-      runExceptT $ f $ case mbr of-        Just (Right a) → Just a-        _              → Nothing-    return $ (,) <$> mr <*> fr-#endif--instance MonadFinally μ ⇒ MonadFinally (ReaderT r μ) where-  finally' m f = ReaderT $ \r →-    finally' (runReaderT m r) ((`runReaderT` r) . f)--instance MonadFinally μ ⇒ MonadFinally (L.StateT s μ) where-  finally' m f = L.StateT $ \s → do-    ~(~(mr, _), ~(fr, s'')) ← finally' (L.runStateT m s) $ \mbr → do-      let ~(a, s') = case mbr of-             Just ~(x, t) → (Just x, t)-             Nothing      → (Nothing, s)-      L.runStateT (f a) s'-    return ((mr, fr), s'')--instance MonadFinally μ ⇒ MonadFinally (S.StateT s μ) where-  finally' m f = S.StateT $ \s → do-    ((mr, _), (fr, s'')) ← finally' (S.runStateT m s) $ \mbr → case mbr of-      Just (a, s') → S.runStateT (f $ Just a) s'-      Nothing      → S.runStateT (f Nothing) s-    return ((mr, fr), s'')--instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (L.WriterT w μ) where-  finally' m f = L.WriterT $ do-    ~(~(mr, w), ~(fr, w')) ← finally' (L.runWriterT m) $-      L.runWriterT . f . fmap fst-    return ((mr, fr), w `mappend` w')--instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (S.WriterT w μ) where-  finally' m f = S.WriterT $ do-    ((mr, w), (fr, w')) ← finally' (S.runWriterT m) $ \mbr → case mbr of-      Just (a, _) → S.runWriterT $ f $ Just a-      Nothing     → S.runWriterT $ f Nothing-    return ((mr, fr), w `mappend` w')--instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (L.RWST r w s μ) where-  finally' m f = L.RWST $ \r s → do-    ~(~(mr, _, w), ~(fr, s'', w')) ← finally' (L.runRWST m r s) $ \mbr → do-      let ~(a, s') = case mbr of-             Just ~(x, t, _) → (Just x, t)-             Nothing         → (Nothing, s)-      L.runRWST (f a) r s'-    return ((mr, fr), s'', w `mappend` w')--instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (S.RWST r w s μ) where-  finally' m f = S.RWST $ \r s → do-    ((mr, _, w), (fr, s'', w')) ← finally' (S.runRWST m r s) $ \mbr →-      case mbr of-        Just (a, s', _) → S.runRWST (f $ Just a) r s'-        Nothing         → S.runRWST (f Nothing) r s-    return ((mr, fr), s'', w `mappend` w')--onEscape ∷ MonadFinally μ ⇒ μ α → μ β → μ α-onEscape m f = fmap fst $ finally' m $ maybe (() <$ f) (const $ return ())--tryAll ∷ MonadFinally μ ⇒ [μ α] → μ ()-tryAll []       = return ()-tryAll (m : ms) = finally (() <$ m) $ tryAll ms--deriving instance Ord MaskingState-deriving instance Enum MaskingState-deriving instance Bounded MaskingState--class (Applicative μ, Monad μ, Ord m, Bounded m)-      ⇒ MonadMask m μ | μ → m where-  defMaskingState ∷ Proxy μ → m-  getMaskingState ∷ μ m-  setMaskingState ∷ m → μ α → μ α--instance MonadMask () Identity where-  defMaskingState = const ()-  getMaskingState = return ()-  setMaskingState = const id--instance MonadMask MaskingState IO where-  defMaskingState = const MaskedInterruptible-  getMaskingState = E.getMaskingState-  setMaskingState Unmasked (IO io) = IO $ unmaskAsyncExceptions# io-  setMaskingState MaskedInterruptible (IO io) = IO $ maskAsyncExceptions# io-  setMaskingState MaskedUninterruptible (IO io) = IO $ maskUninterruptible# io--proxyDefMaskingState ∷ ∀ m μ t . MonadMask m μ ⇒ Proxy (t μ) → m-proxyDefMaskingState = const (defMaskingState (Proxy ∷ Proxy μ))--liftSetMaskingState ∷ (MonadTransControl t, MonadMask m μ, Monad (t μ))-                    ⇒ m → t μ α → t μ α-liftSetMaskingState ms m =-  join $ liftM (restoreT . return) $ liftWith $ \run →-    setMaskingState ms (run m)-{-# INLINE liftSetMaskingState #-}--instance MonadMask m μ ⇒ MonadMask m (MaybeT μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--instance MonadMask m μ ⇒ MonadMask m (ListT μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--instance MonadMask m μ ⇒ MonadMask m (AbortT e μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--instance MonadMask m μ ⇒ MonadMask m (FinishT β μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--instance (MonadMask m μ, Error e) ⇒ MonadMask m (ErrorT e μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--#if MIN_VERSION_transformers(0,4,0)-instance MonadMask m μ ⇒ MonadMask m (ExceptT e μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState-#endif--instance MonadMask m μ ⇒ MonadMask m (ReaderT r μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--instance MonadMask m μ ⇒ MonadMask m (L.StateT s μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--instance MonadMask m μ ⇒ MonadMask m (S.StateT s μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--instance (MonadMask m μ, Monoid w) ⇒ MonadMask m (L.WriterT w μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--instance (MonadMask m μ, Monoid w) ⇒ MonadMask m (S.WriterT w μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--instance (MonadMask m μ, Monoid w) ⇒ MonadMask m (L.RWST r w s μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--instance (MonadMask m μ, Monoid w) ⇒ MonadMask m (S.RWST r w s μ) where-  defMaskingState = proxyDefMaskingState-  getMaskingState = lift getMaskingState-  setMaskingState = liftSetMaskingState--withMaskingState ∷ MonadMask m μ-                 ⇒ m → ((∀ η β . MonadMask m η ⇒ η β → η β) → μ α) → μ α-withMaskingState ms' m = do-  ms ← getMaskingState-  if ms' > ms-    then setMaskingState ms' $ m $ setMaskingState ms-    else m id--withMaskingState_ ∷ MonadMask m μ ⇒ m → μ α → μ α-withMaskingState_ m = withMaskingState m . const--mask ∷ ∀ m μ α . MonadMask m μ-     ⇒ ((∀ η β . MonadMask m η ⇒ η β → η β) → μ α) → μ α-mask = withMaskingState $ defMaskingState (Proxy ∷ Proxy μ)- -mask_ ∷ ∀ m μ α . MonadMask m μ ⇒ μ α → μ α-mask_ = withMaskingState_ $ defMaskingState (Proxy ∷ Proxy μ)--uninterruptibleMask ∷ MonadMask MaskingState μ-                    ⇒ ((∀ η β . MonadMask MaskingState η ⇒ η β → η β) → μ α)-                    → μ α-uninterruptibleMask = withMaskingState MaskedUninterruptible--uninterruptibleMask_ ∷ MonadMask MaskingState μ ⇒ μ α → μ α-uninterruptibleMask_ = withMaskingState_ MaskedUninterruptible--bracket ∷ (MonadFinally μ, MonadMask m μ)-        ⇒ μ α → (α → μ β) → (α → μ γ) → μ γ-bracket acq release m = mask $ \restore → do-  a ← acq-  finally (restore $ m a) (release a)--bracket_ ∷ (MonadFinally μ, MonadMask m μ) ⇒ μ α → μ β → μ γ → μ γ-bracket_ acq release m = bracket acq (const release) (const m)--bracketOnEscape ∷ (MonadFinally μ, MonadMask m μ)-                ⇒ μ α → (α → μ β) → (α → μ γ) → μ γ-bracketOnEscape acq release m = mask $ \restore → do-  a ← acq-  restore (m a) `onEscape` release a--bracketOnError ∷ (MonadRecover e μ, MonadMask m μ)-               ⇒ μ α → (α → μ β) → (α → μ γ) → μ γ-bracketOnError acq release m = mask $ \restore → do-  a ← acq-  r ← restore (m a) `onError_` release a-  r <$ release a

@@ -1,6 +1,7 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE UnicodeSyntax #-} +-- | Short-circuiting monad transformer and the corresponding generalizing+-- monad type class. module Control.Monad.Finish   ( MonadFinish(..) @@ -18,9 +19,7 @@  import Control.Monad import Control.Monad.Fix-#if !MIN_VERSION_base(4,6,0) import Control.Monad.Instances ()-#endif import Control.Monad.Trans import Control.Monad.Trans.Finish hiding (finish) import Control.Monad.Finish.Class

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE UnicodeSyntax #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -7,6 +6,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +-- | Monad type class for short-cicuiting computation. module Control.Monad.Finish.Class   ( MonadFinish(..)   ) where@@ -16,9 +16,7 @@ import Control.Monad.Trans.Maybe import Control.Monad.Cont import Control.Monad.Error-#if MIN_VERSION_transformers(0,4,0)-import Control.Monad.Except-#endif+import Control.Monad.Trans.Except import Control.Monad.List import Control.Monad.Reader import Control.Monad.State (MonadState(..))@@ -34,7 +32,13 @@ import Control.Monad.Trans.Finish (FinishT(..)) import qualified Control.Monad.Trans.Finish as F +-- | Class of monads that support short-circuiting. class Monad μ ⇒ MonadFinish f μ | μ → f where+  -- | Short-circuit the computation with the provided value.+  --+  -- @+  --     finish f >>= rest = finish f+  -- @   finish ∷ f → μ α  instance Monad μ ⇒ MonadFinish f (FinishT f μ) where@@ -84,10 +88,8 @@ instance (MonadFinish f μ, Error e) ⇒ MonadFinish f (ErrorT e μ) where   finish = lift . finish -#if MIN_VERSION_transformers(0,4,0) instance MonadFinish f μ ⇒ MonadFinish f (ExceptT e μ) where   finish = lift . finish-#endif  instance MonadFinish f μ ⇒ MonadFinish f (AbortT e μ) where   finish = lift . finish