monad-control 0.2 → 0.2.0.1

raw patch · 4 files changed

+147/−70 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/Exception/Control.hs +98/−48
• Control/Monad/IO/Control.hs +19/−6
• Control/Monad/Trans/Control.hs +29/−15
• monad-control.cabal +1/−1

@@ -49,8 +49,10 @@ #endif     , blocked -      -- * Utilities+      -- * Brackets     , bracket, bracket_, bracketOnError++      -- * Utilities     , finally, onException     ) where @@ -61,12 +63,16 @@  -- from base: import Data.Function   ( ($) )-import Data.Either     ( Either(Left, Right) )+import Data.Either     ( Either(Left, Right), either ) import Data.Maybe      ( Maybe ) import Data.Bool       ( Bool ) import Control.Monad   ( Monad, (>>=), return, liftM ) import System.IO.Error ( IOError ) +#if MIN_VERSION_base(4,3,0) || defined (__HADDOCK__)+import System.IO       ( IO )+#endif+ #if __GLASGOW_HASKELL__ < 700 import Control.Monad   ( fail ) #endif@@ -101,18 +107,20 @@                                 , controlIO                                 , liftIOOp_                                 )-+#if MIN_VERSION_base(4,3,0) || defined (__HADDOCK__)+import Control.Monad.IO.Control ( liftIOOp )+#endif  -------------------------------------------------------------------------------- -- * Throwing exceptions --------------------------------------------------------------------------------  -- |Generalized version of 'E.throwIO'.-throwIO ∷ (MonadIO m, Exception e) ⇒ e → m a+throwIO ∷ (MonadIO m, Exception e) ⇒ e → m α throwIO = liftIO ∘ E.throwIO  -- |Generalized version of 'E.ioError'.-ioError ∷ MonadIO m ⇒ IOError → m a+ioError ∷ MonadIO m ⇒ IOError → m α ioError = liftIO ∘ E.ioError  @@ -121,16 +129,18 @@ --------------------------------------------------------------------------------  -- |Generalized version of 'E.catch'.+{-# INLINABLE catch #-} catch ∷ (MonadControlIO m, Exception e)-      ⇒ m a       -- ^ The computation to run-      → (e → m a) -- ^ Handler to invoke if an exception is raised-      → m a+      ⇒ m α       -- ^ The computation to run+      → (e → m α) -- ^ Handler to invoke if an exception is raised+      → m α catch a handler = controlIO $ \runInIO →                     E.catch (runInIO a)                             (\e → runInIO $ handler e)  -- |Generalized version of 'E.catches'.-catches ∷ MonadControlIO m ⇒ m a → [Handler m a] → m a+{-# INLINABLE catches #-}+catches ∷ MonadControlIO m ⇒ m α → [Handler m α] → m α catches a handlers = controlIO $ \runInIO →                        E.catches (runInIO a)                                  [ E.Handler $ \e → runInIO $ handler e@@ -138,14 +148,15 @@                                  ]  -- |Generalized version of 'E.Handler'.-data Handler m a = ∀ e. Exception e ⇒ Handler (e → m a)+data Handler m α = ∀ e. Exception e ⇒ Handler (e → m α)  -- |Generalized version of 'E.catchJust'.+{-# INLINABLE catchJust #-} catchJust ∷ (MonadControlIO m, Exception e)-          ⇒ (e → Maybe b) -- ^ Predicate to select exceptions-          → m a           -- ^ Computation to run-          → (b → m a)     -- ^ Handler-          → m a+          ⇒ (e → Maybe β) -- ^ Predicate to select exceptions+          → m α           -- ^ Computation to run+          → (β → m α)     -- ^ Handler+          → m α catchJust p a handler = controlIO $ \runInIO →                           E.catchJust p                                       (runInIO a)@@ -157,14 +168,16 @@ --------------------------------------------------------------------------------  -- |Generalized version of 'E.handle'.-handle ∷ (MonadControlIO m, Exception e) ⇒ (e → m a) → m a → m a+{-# INLINABLE handle #-}+handle ∷ (MonadControlIO m, Exception e) ⇒ (e → m α) → m α → m α handle handler a = controlIO  $ \runInIO →                      E.handle (\e → runInIO (handler e))                               (runInIO a)  -- |Generalized version of 'E.handleJust'.+{-# INLINABLE handleJust #-} handleJust ∷ (MonadControlIO m, Exception e)-           ⇒ (e → Maybe b) → (b → m a) → m a → m a+           ⇒ (e → Maybe β) → (β → m α) → m α → m α handleJust p handler a = controlIO $ \runInIO →                            E.handleJust p (\e → runInIO (handler e))                                           (runInIO a)@@ -174,17 +187,18 @@ -- ** The @try@ functions -------------------------------------------------------------------------------- -sequenceEither ∷ Monad m ⇒ Either e (m a) → m (Either e a)-sequenceEither (Left e)  = return $ Left e-sequenceEither (Right m) = liftM Right m+sequenceEither ∷ Monad m ⇒ Either e (m α) → m (Either e α)+sequenceEither = either (return ∘ Left) (liftM Right)  -- |Generalized version of 'E.try'.-try ∷ (MonadControlIO m, Exception e) ⇒ m a → m (Either e a)+{-# INLINABLE try #-}+try ∷ (MonadControlIO m, Exception e) ⇒ m α → m (Either e α) try = liftIOOp_ (liftM sequenceEither ∘ E.try)  -- |Generalized version of 'E.tryJust'.+{-# INLINABLE tryJust #-} tryJust ∷ (MonadControlIO m, Exception e) ⇒-           (e → Maybe b) → m a → m (Either b a)+           (e → Maybe β) → m α → m (Either β α) tryJust p = liftIOOp_ (liftM sequenceEither ∘ E.tryJust p)  @@ -193,7 +207,7 @@ --------------------------------------------------------------------------------  -- |Generalized version of 'E.evaluate'.-evaluate ∷ MonadIO m ⇒ a → m a+evaluate ∷ MonadIO m ⇒ α → m α evaluate = liftIO ∘ E.evaluate  @@ -203,23 +217,28 @@  #if MIN_VERSION_base(4,3,0) -- |Generalized version of 'E.mask'.-mask ∷ MonadControlIO m ⇒ ((∀ a. m a → m a) → m b) → m b-mask f = controlIO $ \runInIO →-           E.mask $ \restore →-             runInIO $ f $ liftIOOp_ restore+{-# INLINABLE mask #-}+mask ∷ MonadControlIO m ⇒ ((∀ α. m α → m α) → m β) → m β+mask = liftIOOp E.mask ∘ liftRestore +liftRestore ∷ MonadControlIO m+            ⇒ ((∀ α.  m α →  m α) → β)+            → ((∀ α. IO α → IO α) → β)+liftRestore f restore = f $ liftIOOp_ restore+ -- |Generalized version of 'E.mask_'.-mask_ ∷ MonadControlIO m ⇒ m a → m a+{-# INLINABLE mask_ #-}+mask_ ∷ MonadControlIO m ⇒ m α → m α mask_ = liftIOOp_ E.mask_  -- |Generalized version of 'E.uninterruptibleMask'.-uninterruptibleMask ∷ MonadControlIO m ⇒ ((∀ a. m a → m a) → m b) → m b-uninterruptibleMask f = controlIO $ \runInIO →-                          E.uninterruptibleMask $ \restore →-                            runInIO $ f $ liftIOOp_ restore+{-# INLINABLE uninterruptibleMask #-}+uninterruptibleMask ∷ MonadControlIO m ⇒ ((∀ α. m α → m α) → m β) → m β+uninterruptibleMask = liftIOOp E.uninterruptibleMask ∘ liftRestore  -- |Generalized version of 'E.uninterruptibleMask_'.-uninterruptibleMask_ ∷ MonadControlIO m ⇒ m a → m a+{-# INLINABLE uninterruptibleMask_ #-}+uninterruptibleMask_ ∷ MonadControlIO m ⇒ m α → m α uninterruptibleMask_ = liftIOOp_ E.uninterruptibleMask_  -- |Generalized version of 'E.getMaskingState'.@@ -227,11 +246,13 @@ getMaskingState = liftIO E.getMaskingState #else -- |Generalized version of 'E.block'.-block ∷ MonadControlIO m ⇒ m a → m a+{-# INLINABLE block #-}+block ∷ MonadControlIO m ⇒ m α → m α block = liftIOOp_ E.block  -- |Generalized version of 'E.unblock'.-unblock ∷ MonadControlIO m ⇒ m a → m a+{-# INLINABLE unblock #-}+unblock ∷ MonadControlIO m ⇒ m α → m α unblock = liftIOOp_ E.unblock #endif @@ -243,17 +264,23 @@   ----------------------------------------------------------------------------------- * Utilities+-- * Brackets --------------------------------------------------------------------------------  -- |Generalized version of 'E.bracket'.  Note, any monadic side -- effects in @m@ of the \"release\" computation will be discarded; it -- is run only for its side effects in @IO@.+--+-- Note that when your @acquire@ and @release@ computations are of type 'IO'+-- it will be more efficient to write:+--+-- @'liftIOOp' ('E.bracket' acquire release)@+{-# INLINABLE bracket #-} bracket ∷ MonadControlIO m-        ⇒ m a       -- ^ computation to run first (\"acquire resource\")-        → (a → m b) -- ^ computation to run last (\"release resource\")-        → (a → m c) -- ^ computation to run in-between-        → m c+        ⇒ m α       -- ^ computation to run first (\"acquire resource\")+        → (α → m β) -- ^ computation to run last (\"release resource\")+        → (α → m γ) -- ^ computation to run in-between+        → m γ bracket before after thing = controlIO $ \runInIO →                                E.bracket (runInIO before)                                          (\m → runInIO $ m >>= after)@@ -264,7 +291,17 @@ -- computations will be discarded.  To keep the monadic side effects -- of the \"acquire\" computation, use 'bracket' with constant -- functions instead.-bracket_ ∷ MonadControlIO m ⇒ m a → m b → m c → m c+--+-- Note that when your @acquire@ and @release@ computations are of type 'IO'+-- it will be more efficient to write:+--+-- @'liftIOOp_' ('E.bracket_' acquire release)@+{-# INLINABLE bracket_ #-}+bracket_ ∷ MonadControlIO m+         ⇒ m α -- ^ computation to run first (\"acquire resource\")+         → m β -- ^ computation to run last (\"release resource\")+         → m γ -- ^ computation to run in-between+         → m γ bracket_ before after thing = controlIO $ \runInIO →                                 E.bracket_ (runInIO before)                                            (runInIO after)@@ -272,29 +309,42 @@  -- |Generalized version of 'E.bracketOnError'.  Note, any monadic side -- effects in @m@ of the \"release\" computation will be discarded.+--+-- Note that when your @acquire@ and @release@ computations are of type 'IO'+-- it will be more efficient to write:+--+-- @'liftIOOp' ('E.bracketOnError' acquire release)@+{-# INLINABLE bracketOnError #-} bracketOnError ∷ MonadControlIO m-               ⇒ m a       -- ^ computation to run first (\"acquire resource\")-               → (a → m b) -- ^ computation to run last (\"release resource\")-               → (a → m c) -- ^ computation to run in-between-               → m c+               ⇒ m α       -- ^ computation to run first (\"acquire resource\")+               → (α → m β) -- ^ computation to run last (\"release resource\")+               → (α → m γ) -- ^ computation to run in-between+               → m γ bracketOnError before after thing = controlIO $ \runInIO →                                       E.bracketOnError (runInIO before)                                                        (\m → runInIO $ m >>= after)                                                        (\m → runInIO $ m >>= thing) ++--------------------------------------------------------------------------------+-- * Utilities+--------------------------------------------------------------------------------+ -- |Generalized version of 'E.finally'.  Note, any monadic side -- effects in @m@ of the \"afterward\" computation will be discarded.+{-# INLINABLE finally #-} finally ∷ MonadControlIO m-        ⇒ m a -- ^ computation to run first-        → m b -- ^ computation to run afterward (even if an exception was raised)-        → m a+        ⇒ m α -- ^ computation to run first+        → m β -- ^ computation to run afterward (even if an exception was raised)+        → m α finally a sequel = controlIO $ \runInIO →                      E.finally (runInIO a)                                (runInIO sequel)  -- |Generalized version of 'E.onException'.  Note, any monadic side -- effects in @m@ of the \"afterward\" computation will be discarded.-onException ∷ MonadControlIO m ⇒ m a → m b → m a+{-# INLINABLE onException #-}+onException ∷ MonadControlIO m ⇒ m α → m β → m α onException m what = controlIO $ \runInIO →                        E.onException (runInIO m)                                      (runInIO what)

@@ -85,11 +85,22 @@   foo' a = 'controlIO' $ \runInIO ->    -- runInIO :: m a -> 'IO' (m a)              foo $ runInIO a         -- uses foo :: 'IO' (m a) -> 'IO' (m a)   @++  Instances should satisfy similar laws as the 'MonadIO' laws:++  @liftControlIO . const . return = return@++  @liftControlIO (const (m >>= f)) = liftControlIO (const m) >>= liftControlIO . const . f@++  Additionally instances should satisfy:++  @'controlIO' $ \\runInIO -> runInIO m = m@   -}-  liftControlIO ∷ (RunInBase m IO → IO a) → m a+  liftControlIO ∷ (RunInBase m IO → IO α) → m α  -- | An often used composition: @controlIO = 'join' . 'liftControlIO'@-controlIO ∷ MonadControlIO m ⇒ (RunInBase m IO → IO (m a)) → m a+{-# INLINABLE controlIO #-}+controlIO ∷ MonadControlIO m ⇒ (RunInBase m IO → IO (m α)) → m α controlIO = join ∘ liftControlIO  @@ -146,9 +157,10 @@  @liftIOOp f = \\g -> 'controlIO' $ \runInIO -> f $ runInIO . g@ -}+{-# INLINABLE liftIOOp #-} liftIOOp ∷ MonadControlIO m-         ⇒ ((a → IO (m b)) → IO (m c))-         → (a → m b) → m c+         ⇒ ((α → IO (m β)) → IO (m γ))+         → ((α →     m β)  →     m γ) liftIOOp f = \g → controlIO $ \runInIO → f $ runInIO ∘ g  {-|@@ -158,9 +170,10 @@  @liftIOOp_ f = \\m -> 'controlIO' $ \runInIO -> f $ runInIO m@ -}+{-# INLINABLE liftIOOp_ #-} liftIOOp_ ∷ MonadControlIO m-          ⇒ (IO (m a) → IO (m b))-          → m a → m b+          ⇒ (IO (m α) → IO (m β))+          → (    m α →      m β) liftIOOp_ f = \m → controlIO $ \runInIO → f $ runInIO m  

@@ -97,14 +97,26 @@   foo' a = 'control' $ \run ->    -- run :: t M a -> M (t M a)              foo $ run a       -- uses foo :: M (t M a) -> M (t M a)   @++  Instances should satisfy similar laws as the 'MonadTrans' laws:++  @liftControl . const . return = return@++  @liftControl (const (m >>= f)) = liftControl (const m) >>= liftControl . const . f@++  Additionally instances should satisfy:++  @'control' $ \\run -> run t = t@   -}-  liftControl ∷ Monad m ⇒ (Run t → m a) → t m a+  liftControl ∷ Monad m ⇒ (Run t → m α) → t m α -type Run t = ∀ n o b. (Monad n, Monad o, Monad (t o)) ⇒ t n b → n (t o b)+type Run t = ∀ n o β+           . (Monad n, Monad o, Monad (t o))+           ⇒ t n β → n (t o β)  -- | An often used composition: @control = 'join' . 'liftControl'@ control ∷ (Monad m, Monad (t m), MonadTransControl t)-        ⇒ (Run t → m (t m a)) → t m a+        ⇒ (Run t → m (t m α)) → t m α control = join ∘ liftControl  @@ -123,9 +135,9 @@ instance MonadTransControl MaybeT     where liftControl = liftControlNoState MaybeT runMaybeT  liftControlNoState ∷ (Monad m, Monad f)-                   ⇒ (∀ p b. p (f b) → t p b)-                   → (∀ n b. t n b → n (f b))-                   → (Run t → m a) → t m a+                   ⇒ (∀ p β. p (f β) → t p β)+                   → (∀ n β. t n β → n (f β))+                   → ((Run t → m α) → t m α) liftControlNoState mkT runT = \f → mkT $ liftM return $ f $                                      liftM (mkT ∘ return) ∘ runT @@ -138,7 +150,7 @@ instance MonadTransControl (StateT s) where     liftControl f =         StateT $ \s →-          let run t = liftM (\(x, s') → StateT $ \_ → return (x, s'))+          let run t = liftM (\ ~(x, s') → StateT $ \_ → return (x, s'))                             (runStateT t s)           in liftM (\x → (x, s)) (f run) @@ -152,17 +164,19 @@ instance Monoid w ⇒ MonadTransControl (WriterT w) where     liftControl f = WriterT $ liftM (\x → (x, mempty)) (f run)         where-          run t = liftM (WriterT ∘ return) (runWriterT t)+          run t = liftM (\ ~(x, w) → WriterT $ return (x, w))+                        (runWriterT t)  instance Monoid w ⇒ MonadTransControl (Strict.WriterT w) where     liftControl f = Strict.WriterT $ liftM (\x → (x, mempty)) (f run)         where-          run t = liftM (Strict.WriterT ∘ return) (Strict.runWriterT t)+          run t = liftM (\(x, w) → Strict.WriterT $ return (x, w))+                        (Strict.runWriterT t)  instance Monoid w ⇒ MonadTransControl (RWST r w s) where     liftControl f =         RWST $ \r s →-          let run t = liftM (\(x, s', w) → RWST $ \_ _ → return (x, s', w))+          let run t = liftM (\ ~(x, s', w) → RWST $ \_ _ → return (x, s', w))                             (runRWST t r s)           in liftM (\x → (x, s, mempty)) (f run) @@ -199,17 +213,17 @@     liftControlIO = idLiftControl @ -}-idLiftControl ∷ Monad m ⇒ (RunInBase m m → m a) → m a+idLiftControl ∷ Monad m ⇒ (RunInBase m m → m α) → m α idLiftControl f = f $ liftM return -type RunInBase m base = ∀ b. m b → base (m b)+type RunInBase m base = ∀ β. m β → base (m β)  {-| @liftLiftControlBase@ is used to compose two 'liftControl' operations: the outer provided by a 'MonadTransControl' instance, and the inner provided as the argument. -It satisfies @'liftLiftControlBase' 'idLiftControl' == 'liftControl'@.+It satisfies @'liftLiftControlBase' 'idLiftControl' = 'liftControl'@.  It serves as the induction step of a @MonadControlIO@-like class.  For example, "Control.Monad.IO.Control" defines:@@ -250,8 +264,8 @@ @ -} liftLiftControlBase ∷ (MonadTransControl t, Monad (t m), Monad m, Monad base)-                    ⇒ ((RunInBase m     base → base a) →   m a) -- ^ @liftControlBase@ operation-                    → ((RunInBase (t m) base → base a) → t m a)+                    ⇒ ((RunInBase m     base → base α) →   m α) -- ^ @liftControlBase@ operation+                    → ((RunInBase (t m) base → base α) → t m α) liftLiftControlBase lftCtrlBase = \f → liftControl $ \run1 →                                          lftCtrlBase $ \runInBase →                                            let run = liftM (join ∘ lift) ∘ runInBase ∘ run1

@@ -1,5 +1,5 @@ Name:                monad-control-Version:             0.2+Version:             0.2.0.1 Synopsis:            Lift control operations, like exception catching, through monad transformers Description:   This package defines the type class @MonadControlIO@, a subset of