monad-abort-fd 0.4 → 0.5

raw patch · 6 files changed

+180/−90 lines, 6 filesdep +taggeddep −data-defaultdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: tagged

Dependencies removed: data-default

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• monad-abort-fd.cabal +7/−5
• src/Control/Monad/Abort.hs +14/−12
• src/Control/Monad/Abort/Class.hs +33/−11
• src/Control/Monad/Exception.hs +101/−47
• src/Control/Monad/Finish.hs +13/−11
• src/Control/Monad/Finish/Class.hs +12/−4

@@ -1,5 +1,5 @@ Name: monad-abort-fd-Version: 0.4+Version: 0.5 Category: Control Stability: experimental Synopsis: A better error monad transformer@@ -24,14 +24,17 @@   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:-    base               >= 4 && < 5,     transformers       >= 0.2,     transformers-base  >= 0.4,     transformers-abort >= 0.4,     mtl                >= 2.0,-    monad-control      >= 0.3,-    data-default       >= 0.2+    monad-control      >= 0.3   Hs-Source-Dirs: src   GHC-Options: -Wall   Exposed-Modules:@@ -40,4 +43,3 @@     Control.Monad.Finish.Class     Control.Monad.Finish     Control.Monad.Exception-

@@ -1,25 +1,27 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE UnicodeSyntax #-} -module Control.Monad.Abort (-    MonadAbort(..),-    MonadRecover(..),-    onError,-    onError_,+module Control.Monad.Abort+  ( MonadAbort(..)+  , MonadRecover(..)+  , onError+  , onError_ -    Abort,-    runAbort,+  , Abort+  , runAbort -    AbortT(..),+  , AbortT(..) -    module Control.Monad,-    module Control.Monad.Fix,-    module Control.Monad.Trans+  , module Control.Monad+  , module Control.Monad.Fix+  , module Control.Monad.Trans   ) where  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-

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE UnicodeSyntax #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -7,22 +8,28 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Control.Monad.Abort.Class (-    MonadAbort(..),-    MonadRecover(..),-    onError,-    onError_,-    ignore+module Control.Monad.Abort.Class+  ( MonadAbort(..)+  , MonadRecover(..)+  , onError+  , onError_+  , ignore   ) where +#if !MIN_VERSION_base(4,6,0) import Prelude hiding (catch)-import Data.Monoid+#endif+import Data.Monoid (Monoid) import Control.Exception (SomeException, throwIO, catch)+import Control.Applicative (Applicative, (<$>)) import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe import Control.Monad.Cont-import Control.Monad.Error import Control.Monad.List+import Control.Monad.Error+#if MIN_VERSION_transformers(0,4,0)+import Control.Monad.Except+#endif import Control.Monad.Reader import Control.Monad.State (MonadState(..)) import qualified Control.Monad.State.Lazy as L@@ -36,11 +43,13 @@ import Control.Monad.Trans.Abort (AbortT(..)) import qualified Control.Monad.Trans.Abort as A -class Monad μ ⇒ MonadAbort e μ | μ → e where+class (Applicative μ, Monad μ) ⇒ MonadAbort e μ | μ → e where   abort ∷ e → μ α  class MonadAbort e μ ⇒ MonadRecover e μ | μ → e where   recover ∷ μ α → (e → μ α) → μ α+  evaluate ∷ μ α → μ (Either e α)+  evaluate m = recover (Right <$> m) (return . Left)  onError ∷ MonadRecover e μ ⇒ μ α → (e → μ β) → μ α onError m h = recover m (\e → h e >> abort e)@@ -51,10 +60,10 @@ ignore ∷ MonadRecover e μ ⇒ μ α → μ () ignore m = recover (m >> return ()) (const $ return ()) -instance Monad μ ⇒ MonadAbort e (AbortT e μ) where+instance (Functor μ, Monad μ) ⇒ MonadAbort e (AbortT e μ) where   abort = A.abort -instance Monad μ ⇒ MonadRecover e (AbortT e μ) where+instance (Functor μ, Monad μ) ⇒ MonadRecover e (AbortT e μ) where   recover = A.recover  instance MonadAbort SomeException IO where@@ -156,3 +165,16 @@   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+  abort = throwError++instance (Monad μ, Error e) ⇒ MonadRecover e (ErrorT e μ) where+  recover = catchError++#if MIN_VERSION_transformers(0,4,0)+instance Monad μ ⇒ MonadAbort e (ExceptT e μ) where+  abort = throwError++instance Monad μ ⇒ MonadRecover e (ExceptT e μ) where+  recover = catchError+#endif

@@ -1,8 +1,13 @@+{-# 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 #-}@@ -10,43 +15,45 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Control.Monad.Exception (-    exception,-    evaluate,-    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+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)-import Data.Monoid-import Data.Default+#endif+import Data.Monoid (Monoid)+import Data.Proxy (Proxy(..)) import Data.Traversable import Data.Functor.Identity-import Control.Applicative+import Control.Applicative (Applicative) import Control.Monad (join, liftM) import Control.Monad.Base import Control.Monad.Trans.Class@@ -56,6 +63,9 @@ 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@@ -67,7 +77,10 @@ import Control.Exception hiding (   evaluate, throw, throwIO, catch, catchJust, handle, handleJust,   Handler(..), catches, try, tryJust, finally, onException,-  block, unblock, blocked, getMaskingState, mask, mask_, uninterruptibleMask,+#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#,@@ -77,8 +90,8 @@ exception ∷ Exception e ⇒ e → α exception = E.throw -evaluate ∷ MonadBase IO μ ⇒ α → μ α-evaluate = liftBase . E.evaluate+forceWHNF ∷ MonadBase IO μ ⇒ α → μ α+forceWHNF = liftBase . E.evaluate  throw ∷ (MonadAbort SomeException μ, Exception e) ⇒ e → μ α throw = abort . toException@@ -108,12 +121,21 @@         hl (Handler h : hs) e = maybe (hl hs e) h $ fromException e  try ∷ (MonadRecover SomeException μ, Exception e) ⇒ μ α → μ (Either e α)-try m = catch (m >>= return . Right) (return . Left)+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 = catch (m >>= return . Right) $ \e →-                maybe (throw e) (return . Left) $ f e+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 → μ β) → μ α@@ -181,6 +203,16 @@         _              → 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)@@ -242,24 +274,27 @@ deriving instance Enum MaskingState deriving instance Bounded MaskingState -instance Default MaskingState where-  def = MaskedInterruptible--class (Applicative μ, Monad μ, Ord m, Bounded m, Default m)+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 =@@ -268,50 +303,69 @@ {-# 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 @@ -326,11 +380,12 @@ withMaskingState_ ∷ MonadMask m μ ⇒ m → μ α → μ α withMaskingState_ m = withMaskingState m . const -mask ∷ MonadMask m μ ⇒ ((∀ η β . MonadMask m η ⇒ η β → η β) → μ α) → μ α-mask = withMaskingState def+mask ∷ ∀ m μ α . MonadMask m μ+     ⇒ ((∀ η β . MonadMask m η ⇒ η β → η β) → μ α) → μ α+mask = withMaskingState $ defMaskingState (Proxy ∷ Proxy μ)  -mask_ ∷ MonadMask m μ ⇒ μ α → μ α-mask_ = withMaskingState_ def+mask_ ∷ ∀ m μ α . MonadMask m μ ⇒ μ α → μ α+mask_ = withMaskingState_ $ defMaskingState (Proxy ∷ Proxy μ)  uninterruptibleMask ∷ MonadMask MaskingState μ                     ⇒ ((∀ η β . MonadMask MaskingState η ⇒ η β → η β) → μ α)@@ -361,4 +416,3 @@   a ← acq   r ← restore (m a) `onError_` release a   r <$ release a-

@@ -1,24 +1,26 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE UnicodeSyntax #-} -module Control.Monad.Finish (-    MonadFinish(..),+module Control.Monad.Finish+  ( MonadFinish(..) -    Finish,-    runFinish,-    runFinish',+  , Finish+  , runFinish+  , runFinish' -    FinishT(..),-    runFinishT',+  , FinishT(..)+  , runFinishT' -    module Control.Monad,-    module Control.Monad.Fix,-    module Control.Monad.Trans+  , module Control.Monad+  , module Control.Monad.Fix+  , module Control.Monad.Trans   ) where  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,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE UnicodeSyntax #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -6,15 +7,18 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Control.Monad.Finish.Class (-    MonadFinish(..)+module Control.Monad.Finish.Class+  ( MonadFinish(..)   ) where -import Data.Monoid+import Data.Monoid (Monoid) import Control.Monad.Trans.Identity 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.List import Control.Monad.Reader import Control.Monad.State (MonadState(..))@@ -80,6 +84,11 @@ 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 @@ -106,4 +115,3 @@  instance (MonadFinish f μ, Monoid w) ⇒ MonadFinish f (S.RWST r w s μ) where   finish = lift . finish-