packages feed

monad-peel (empty) → 0.1

raw patch · 7 files changed

+706/−0 lines, 7 filesdep +basedep +extensible-exceptionsdep +transformerssetup-changed

Dependencies added: base, extensible-exceptions, transformers

Files

+ Control/Exception/Peel.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE ExistentialQuantification #-}++{- |+Module      :  Control.Exception.Peel+Copyright   :  © Anders Kaseorg, 2010+License     :  BSD-style++Maintainer  :  Anders Kaseorg <andersk@mit.edu>+Stability   :  experimental+Portability :  non-portable (extended exceptions)++This is a wrapped version of Control.Exception with types generalized+from 'IO' to all monads in 'MonadPeelIO'.+-}++module Control.Exception.Peel (+  module Control.Exception.Extensible,+  throwIO, ioError,+  catch, catches, Handler(..), catchJust,+  handle, handleJust,+  try, tryJust,+  evaluate,+  block, unblock,+  bracket, bracket_, bracketOnError,+  finally, onException,+  ) where++import Prelude hiding (catch, ioError)+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.IO.Peel+import Control.Exception.Extensible hiding (+  throwIO, ioError,+  catch, catches, Handler(..), catchJust,+  handle, handleJust,+  try, tryJust,+  evaluate,+  block, unblock,+  bracket, bracket_, bracketOnError,+  finally, onException,+  )+import qualified Control.Exception.Extensible as E++-- |Generalized version of 'E.throwIO'.+throwIO :: (MonadIO m, Exception e) => e -> m a+throwIO = liftIO . E.throwIO++-- |Generalized version of 'E.ioError'.+ioError :: MonadIO m => IOError -> m a+ioError = liftIO . E.ioError++-- |Generalized version of 'E.catch'.+catch :: (MonadPeelIO m, Exception e) =>+         m a -- ^ The computation to run+         -> (e -> m a) -- ^ Handler to invoke if an exception is raised+         -> m a+catch a handler = do+  k <- peelIO+  join $ liftIO $ E.catch (k a) (\e -> k $ handler e)++-- |Generalized version of 'E.catchJust'.+catchJust :: (MonadPeelIO m, Exception e) =>+             (e -> Maybe b) -- ^ Predicate to select exceptions+             -> m a -- ^ Computation to run+             -> (b -> m a) -- ^ Handler+             -> m a+catchJust p a handler = do+  k <- peelIO+  join $ liftIO $ E.catchJust p (k a) (\e -> k (handler e))++-- |Generalized version of 'E.catches'.+catches :: MonadPeelIO m => m a -> [Handler m a] -> m a+catches a handlers = do+  k <- peelIO+  join $ liftIO $ E.catches (k a) [E.Handler $ \e -> k $ handler e |+                                   Handler handler <- handlers]++-- |Generalized version of 'E.Handler'.+data Handler m a = forall e. Exception e => Handler (e -> m a)++-- |Generalized version of 'E.handle'.+handle :: (MonadPeelIO m, Exception e) => (e -> m a) -> m a -> m a+handle handler a = do+  k <- peelIO+  join $ liftIO $ E.handle (\e -> k (handler e)) (k a)++-- |Generalized version of 'E.handleJust'.+handleJust :: (MonadPeelIO m, Exception e) =>+             (e -> Maybe b) -> (b -> m a) -> m a -> m a+handleJust p handler a = do+  k <- peelIO+  join $ liftIO $ E.handleJust p (\e -> k (handler e)) (k a)++sequenceEither :: Monad m => Either e (m a) -> m (Either e a)+sequenceEither (Left e) = return $ Left e+sequenceEither (Right m) = liftM Right m++-- |Generalized version of 'E.try'.+try :: (MonadPeelIO m, Exception e) => m a -> m (Either e a)+try = liftIOOp_ (liftM sequenceEither . E.try)++-- |Generalized version of 'E.tryJust'.+tryJust :: (MonadPeelIO m, Exception e) =>+           (e -> Maybe b) -> m a -> m (Either b a)+tryJust p = liftIOOp_ (liftM sequenceEither . E.tryJust p)++-- |Generalized version of 'E.evaluate'.+evaluate :: MonadIO m => a -> m a+evaluate = liftIO . E.evaluate++-- |Generalized version of 'E.block'.+block :: MonadPeelIO m => m a -> m a+block = liftIOOp_ E.block++-- |Generalized version of 'E.unblock'.+unblock :: MonadPeelIO m => m a -> m a+unblock = liftIOOp_ E.unblock++-- |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@.+bracket :: MonadPeelIO 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+bracket before after thing = do+  k <- peelIO+  k' <- peelIO+  k'' <- peelIO+  join $ liftIO $+    E.bracket (k before) (\x -> k' $ x >>= after) (\x -> k'' $ x >>= thing)++-- |Generalized version of 'E.bracket_'.  Note, any monadic side+-- effects in @m@ of /both/ the \"acquire\" and \"release\"+-- computations will be discarded.  To keep the monadic side effects+-- of the \"acquire\" computation, use 'bracket' with constant+-- functions instead.+bracket_ :: MonadPeelIO m => m a -> m b -> m c -> m c+bracket_ before after thing = do+  k <- peelIO+  k' <- peelIO+  k'' <- peelIO+  join $ liftIO $ E.bracket_ (k before) (k' after) (k'' thing)++-- |Generalized version of 'E.bracketOnError'.  Note, any monadic side+-- effects in @m@ of the \"release\" computation will be discarded.+bracketOnError :: MonadPeelIO 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+bracketOnError before after thing = do+  k <- peelIO+  k' <- peelIO+  k'' <- peelIO+  join $ liftIO $+    E.bracket (k before) (\x -> k' $ x >>= after) (\x -> k'' $ x >>= thing)++-- |Generalized version of 'E.finally'.  Note, any monadic side+-- effects in @m@ of the \"afterward\" computation will be discarded.+finally :: MonadPeelIO m =>+           m a -- ^ computation to run first+           -> m b -- ^ computation to run afterward (even if an exception was raised)+           -> m a+finally a sequel = do+  k <- peelIO+  k' <- peelIO+  join $ liftIO $ E.finally (k a) (k' sequel)++-- |Generalized version of 'E.onException'.  Note, any monadic side+-- effects in @m@ of the \"afterward\" computation will be discarded.+onException :: MonadPeelIO m => m a -> m b -> m a+onException m what = do+  k <- peelIO+  k' <- peelIO+  join $ liftIO $ E.onException (k m) (k' what)
+ Control/Monad/IO/Peel.hs view
@@ -0,0 +1,119 @@+{- |+Module      :  Control.Monad.IO.Peel+Copyright   :  © Anders Kaseorg, 2010+License     :  BSD-style++Maintainer  :  Anders Kaseorg <andersk@mit.edu>+Stability   :  experimental+Portability :  portable++This module defines the class 'MonadPeelIO' of 'IO'-based monads into+which control operations on 'IO' (such as exception catching; see+"Control.Exception.Peel") can be lifted.++'liftIOOp' and 'liftIOOp_' enable convenient lifting of two common+special cases of control operation types.+-}++module Control.Monad.IO.Peel (+  MonadPeelIO(..),+  liftIOOp,+  liftIOOp_,+  ) where++import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Peel+import Control.Monad.Trans.Identity+import Control.Monad.Trans.List+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Error+import Control.Monad.Trans.Reader+import Control.Monad.Trans.State+import qualified Control.Monad.Trans.State.Strict as Strict+import Control.Monad.Trans.Writer+import qualified Control.Monad.Trans.Writer.Strict as Strict+import qualified Control.Monad.Trans.RWS as RWS+import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict+import Data.Monoid++-- |@MonadPeelIO@ is the class of 'IO'-based monads supporting an+-- extra operation 'peelIO', enabling control operations on 'IO' to be+-- lifted into the monad.+class MonadIO m => MonadPeelIO m where+  -- |@peelIO@ is a version of 'peel' that operates through an+  -- arbitrary stack of monad transformers directly to an inner 'IO'+  -- (analagously to how 'liftIO' is a version of @lift@).  So it can+  -- be used with 'liftIO' to lift control operations on 'IO' into any+  -- monad in 'MonadPeelIO'.  For example:+  --+  -- @+  --    foo :: 'IO' a -> 'IO' a+  --    foo' :: 'MonadPeelIO' m => m a -> m a+  --    foo' a = do+  --      k \<- 'peelIO'  -- k :: m a -> IO (m a)+  --      'join' $ 'liftIO' $ foo (k a)  -- uses foo :: 'IO' (m a) -> 'IO' (m a)+  -- @+  --+  -- Note that the \"obvious\" term of this type (@peelIO = 'return'+  -- 'return'@) /does not/ work correctly.  Instances of 'MonadPeelIO'+  -- should be constructed via 'MonadTransPeel', using @peelIO =+  -- 'liftPeel' peelIO@.+  peelIO :: m (m a -> IO (m a))++instance MonadPeelIO IO where+  peelIO = idPeel++instance MonadPeelIO m => MonadPeelIO (IdentityT m) where+  peelIO = liftPeel peelIO+instance MonadPeelIO m => MonadPeelIO (ListT m) where+  peelIO = liftPeel peelIO+instance MonadPeelIO m => MonadPeelIO (MaybeT m) where+  peelIO = liftPeel peelIO+instance (Error e, MonadPeelIO m) => MonadPeelIO (ErrorT e m) where+  peelIO = liftPeel peelIO+instance MonadPeelIO m => MonadPeelIO (ReaderT r m) where+  peelIO = liftPeel peelIO+instance MonadPeelIO m => MonadPeelIO (StateT s m) where+  peelIO = liftPeel peelIO+instance MonadPeelIO m => MonadPeelIO (Strict.StateT s m) where+  peelIO = liftPeel peelIO+instance (Monoid w, MonadPeelIO m) => MonadPeelIO (WriterT w m) where+  peelIO = liftPeel peelIO+instance (Monoid w, MonadPeelIO m) => MonadPeelIO (Strict.WriterT w m) where+  peelIO = liftPeel peelIO+instance (Monoid w, MonadPeelIO m) => MonadPeelIO (RWS.RWST r w s m) where+  peelIO = liftPeel peelIO+instance (Monoid w, MonadPeelIO m) =>+         MonadPeelIO (RWS.Strict.RWST r w s m) where+  peelIO = liftPeel peelIO+++-- |@liftIOOp@ is a particular application of 'peelIO' that allows+-- lifting control operations of type @(a -> 'IO' b) -> 'IO' b@+-- (e.g. @alloca@, @withMVar v@) to @'MonadPeelIO' m => (a -> m b) ->+-- m b@.+--+-- @+--    'liftIOOp' f g = do+--      k \<- 'peelIO'+--      'join' $ 'liftIO' $ f (k . g)+-- @+liftIOOp :: MonadPeelIO m => ((a -> IO (m b)) -> IO (m c)) -> (a -> m b) -> m c+liftIOOp f g = do+  k <- peelIO+  join $ liftIO $ f (k . g)++-- |@liftIOOp_@ is a particular application of 'peelIO' that allows+-- lifting control operations of type @'IO' a -> 'IO' a@+-- (e.g. @block@) to @'MonadPeelIO' m => m a -> m a@.+--+-- @+--    'liftIOOp_' f m = do+--      k \<- 'peelIO'+--      'join' $ 'liftIO' $ f (k m)+-- @+liftIOOp_ :: MonadPeelIO m => (IO (m a) -> IO (m b)) -> m a -> m b+liftIOOp_ f m = do+  k <- peelIO+  join $ liftIO $ f (k m)
+ Control/Monad/Trans/Peel.hs view
@@ -0,0 +1,198 @@+{- |+Module      :  Control.Monad.Trans.Peel+Copyright   :  © Anders Kaseorg, 2010+License     :  BSD-style++Maintainer  :  Anders Kaseorg <andersk@mit.edu>+Stability   :  experimental+Portability :  portable++This module defines the class 'MonadTransPeel' of monad transformers+through which control operations can be lifted.  Instances are+included for all the standard monad transformers from the+@transformers@ library except @ContT@.++'idPeel' and 'liftPeel' are provided to assist creation of+@MonadPeelIO@-like classes (see "Control.Monad.IO.Peel") based on core+monads other than 'IO'.+-}++module Control.Monad.Trans.Peel (+  MonadTransPeel(..),+  idPeel,+  liftPeel,+  ) where++import Prelude hiding (catch)+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.Identity+import Control.Monad.Trans.List+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Error+import Control.Monad.Trans.Reader+import Control.Monad.Trans.State+import qualified Control.Monad.Trans.State.Strict as Strict+import Control.Monad.Trans.Writer+import qualified Control.Monad.Trans.Writer.Strict as Strict+import qualified Control.Monad.Trans.RWS as RWS+import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict+import Data.Monoid+++-- |@MonadTransPeel@ is the class of monad transformers supporting an+-- extra operation 'peel', enabling control operations (functions that+-- use monadic actions as input instead of just output) to be lifted+-- through the transformer.+class MonadTrans t => MonadTransPeel t where+  -- |@peel@ is used to peel off the outer layer of a transformed+  -- monadic action, allowing an transformed action @t m a@ to be+  -- treated as a base action @m b@.+  --+  -- More precisely, @peel@ captures the monadic state of @t@ at the+  -- point where it is bound (in @t n@), yielding a function @t m a ->+  -- m (t o a)@; this function runs a transformed monadic action @t m+  -- a@ in the base monad @m@ using the captured state, and leaves the+  -- result @t o a@ in the monad @m@ after all side effects in @m@+  -- have occurred.+  --+  -- This can be used together with 'lift' to lift control operations+  -- with types such as @M a -> M a@ into the transformed monad @t M@:+  --+  -- @+  --    instance Monad M+  --    foo :: M a -> M a+  --    foo' :: ('MonadTransPeel' t, 'Monad' (t M)) => t M a -> t M a+  --    foo' a = do+  --      k \<- 'peel'  -- k :: t M a -> M (t M a)+  --      'join' $ 'lift' $ foo (k a)  -- uses foo :: M (t M a) -> M (t M a)+  -- @+  --+  -- @peel@ is typically used with @m == n == o@, but is required to+  -- be polymorphic for greater type safety: for example, this type+  -- ensures that the result of running the action in @m@ has no+  -- remaining side effects in @m@.+  peel :: (Monad m, Monad n, Monad o) => t n (t m a -> m (t o a))++instance MonadTransPeel IdentityT where+  peel = return $ \m -> do+    x <- runIdentityT m+    return $ return x++liftList :: Monad m => [a] -> ListT m a+liftList = ListT . return++instance MonadTransPeel ListT where+  peel = return $ \m -> do+    xs <- runListT m+    return $ liftList xs++instance MonadTransPeel MaybeT where+  peel = return $ \m -> do+    xm <- runMaybeT m+    return $ maybe mzero return xm++instance Error e => MonadTransPeel (ErrorT e) where+  peel = return $ \m -> do+    xe <- runErrorT m+    return $ either throwError return xe++instance MonadTransPeel (ReaderT r) where+  peel = asks $ \r m -> do+    x <- runReaderT m r+    return $ return x++instance MonadTransPeel (StateT s) where+  peel = gets $ \s m -> do+    (x, s') <- runStateT m s+    return $ do+      put s'+      return x+instance MonadTransPeel (Strict.StateT s) where+  peel = Strict.gets $ \s m -> do+    (x, s') <- Strict.runStateT m s+    return $ do+      Strict.put s'+      return x++instance Monoid w => MonadTransPeel (WriterT w) where+  peel = return $ \m -> do+    (x, w) <- runWriterT m+    return $ do+      tell w+      return x+instance Monoid w => MonadTransPeel (Strict.WriterT w) where+  peel = return $ \m -> do+    (x, w) <- Strict.runWriterT m+    return $ do+      Strict.tell w+      return x++instance Monoid w => MonadTransPeel (RWS.RWST r w s) where+  peel = do+    r <- RWS.ask+    s <- RWS.get+    return $ \m -> do+      (x, s', w) <- RWS.runRWST m r s+      return $ do+        RWS.put s'+        RWS.tell w+        return x+instance Monoid w => MonadTransPeel (RWS.Strict.RWST r w s) where+  peel = do+    r <- RWS.Strict.ask+    s <- RWS.Strict.get+    return $ \m -> do+      (x, s', w) <- RWS.Strict.runRWST m r s+      return $ do+        RWS.Strict.put s'+        RWS.Strict.tell w+        return x+++-- |@idPeel@ acts as the \"identity\" 'peel' operation from a monad+-- @m@ to itself.+--+-- @+--    'idPeel' = 'return' $ 'liftM' 'return'+-- @+--+-- It serves as the base case for a class like @MonadPeelIO@, which+-- allows control operations in some base monad (here @IO@) to be+-- lifted through arbitrary stacks of zero or more monad transformers+-- in one call.  For example, "Control.Monad.IO.Peel" defines+--+-- @+--    class 'MonadIO' m => MonadPeelIO m where+--      peelIO :: m (m a -> 'IO' (m a))+--    instance MonadPeelIO 'IO' where+--      peelIO = 'idPeel'+-- @+idPeel :: (Monad m, Monad n, Monad o) => n (m a -> m (o a))+idPeel = return $ liftM return++-- |@liftPeel@ is used to compose two 'peel' operations: the outer+-- provided by a 'MonadTransPeel' instance, and the inner provided as+-- the argument.+--+-- It satisfies @'liftPeel' 'idPeel' == 'peel'@.+--+-- It serves as the induction step of a @MonadPeelIO@-like class.  For+-- example, "Control.Monad.IO.Peel" defines+--+-- @+--    instance MonadPeelIO m => MonadPeelIO ('StateT' s m) where+--      peelIO = 'liftPeel' peelIO+-- @+--+-- using the 'MonadTransPeel' instance of @'StateT' s@.+liftPeel :: (MonadTransPeel t, Monad m, Monad m', Monad n', Monad (t n'),+             Monad o', Monad (t o')) =>+            n' (m' (t o' a) -> m (o' (t o' a))) -> t n' (t m' a -> m (t o' a))+liftPeel p = do+  k <- peel+  lift $ do+    k' <- p+    return $ \m -> do+      m' <- k' $ k m+      return $ join $ lift m'
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright © 2010, Anders Kaseorg+All rights reserved.++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, 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+  documentation and/or other materials provided with the distribution.++• Neither the name of the author nor the names of other 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+“AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ monad-peel.cabal view
@@ -0,0 +1,33 @@+Name:                monad-peel+Version:             0.1+Synopsis:            Lift control operations like exception catching through monad transformers+Description:+  This package defines @MonadPeelIO@, a subset of @MonadIO@ into which+  generic control operations such as @catch@ can be lifted from @IO@.+  Instances are based on monad transformers in @MonadTransPeel@, which+  includes all standard monad transformers in the @transformers@+  library except @ContT@.  For convenience, it provides a wrapped+  version of Control.Exception with types generalized from @IO@ to all+  monads in @MonadPeelIO@.+Homepage:            http://andersk.mit.edu/haskell/monad-peel/+License:             BSD3+License-file:        LICENSE+Author:              Anders Kaseorg+Maintainer:          Anders Kaseorg <andersk@mit.edu>+Copyright:           (c) 2010 Anders Kaseorg+Category:            Control+Build-type:          Simple+Cabal-version:       >= 1.2+Extra-source-files:+  test.hs++Library+  Exposed-modules:+    Control.Monad.Trans.Peel+    Control.Monad.IO.Peel+    Control.Exception.Peel++  Build-depends:+    base >= 3 && < 5,+    extensible-exceptions,+    transformers >= 0.2 && < 0.3
+ test.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE DeriveDataTypeable #-}+import Prelude hiding (catch)++import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)++import Control.Exception.Peel+import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Peel (MonadPeelIO)+import Data.IORef+import Data.Maybe+import Data.Typeable (Typeable)++import Control.Monad.Trans.Identity+import Control.Monad.Trans.List+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Writer+import Control.Monad.Trans.Error+import Control.Monad.Trans.State+import qualified Control.Monad.Trans.RWS as RWS++main :: IO ()+main = defaultMain+    [ testSuite "IdentityT" runIdentityT+    , testSuite "ListT" $ fmap head . runListT+    , testSuite "MaybeT" $ fmap fromJust . runMaybeT+    , testSuite "ReaderT" $ flip runReaderT "reader state"+    , testSuite "WriterT" runWriterT'+    , testSuite "ErrorT" runErrorT'+    , testSuite "StateT" $ flip evalStateT "state state"+    , testSuite "RWST" $ \m -> runRWST' m "RWS in" "RWS state"+    , testCase "ErrorT throwError" case_throwError+    , testCase "WriterT tell" case_tell+    ]+  where+    runWriterT' :: Functor m => WriterT [Int] m a -> m a+    runWriterT' = fmap fst . runWriterT+    runErrorT' :: Functor m => ErrorT String m () -> m ()+    runErrorT' = fmap (either (const ()) id) . runErrorT+    runRWST' :: (Monad m, Functor m) => RWS.RWST r [Int] s m a -> r -> s -> m a+    runRWST' m r s = fmap fst $ RWS.evalRWST m r s++testSuite :: MonadPeelIO m => String -> (m () -> IO ()) -> Test+testSuite s run = testGroup s+    [ testCase "finally" $ case_finally run+    , testCase "catch" $ case_catch run+    , testCase "bracket" $ case_bracket run+    , testCase "bracket_" $ case_bracket_ run+    , testCase "onException" $ case_onException run+    ]++ignore :: IO () -> IO ()+ignore x =+    catch x go+  where+    go :: SomeException -> IO ()+    go _ = return ()++data Exc = Exc+    deriving (Show, Typeable)+instance Exception Exc++one :: Int+one = 1++case_finally :: MonadPeelIO m => (m () -> IO ()) -> Assertion+case_finally run = do+    i <- newIORef one+    ignore+        (run $ (do+            liftIO $ writeIORef i 2+            error "error") `finally` (liftIO $ writeIORef i 3))+    j <- readIORef i+    j @?= 3++case_catch :: MonadPeelIO m => (m () -> IO ()) -> Assertion+case_catch run = do+    i <- newIORef one+    run $ (do+        liftIO $ writeIORef i 2+        throw Exc) `catch` (\Exc -> liftIO $ writeIORef i 3)+    j <- readIORef i+    j @?= 3++case_bracket :: MonadPeelIO m => (m () -> IO ()) -> Assertion+case_bracket run = do+    i <- newIORef one+    ignore $ run $ bracket+        (liftIO $ writeIORef i 2)+        (\() -> liftIO $ writeIORef i 4)+        (\() -> liftIO $ writeIORef i 3)+    j <- readIORef i+    j @?= 4++case_bracket_ :: MonadPeelIO m => (m () -> IO ()) -> Assertion+case_bracket_ run = do+    i <- newIORef one+    ignore $ run $ bracket_+        (liftIO $ writeIORef i 2)+        (liftIO $ writeIORef i 4)+        (liftIO $ writeIORef i 3)+    j <- readIORef i+    j @?= 4++case_onException :: MonadPeelIO m => (m () -> IO ()) -> Assertion+case_onException run = do+    i <- newIORef one+    ignore $ run $ onException+        (liftIO (writeIORef i 2) >> error "ignored")+        (liftIO $ writeIORef i 3)+    j <- readIORef i+    j @?= 3+    ignore $ run $ onException+        (liftIO $ writeIORef i 4)+        (liftIO $ writeIORef i 5)+    k <- readIORef i+    k @?= 4++case_throwError :: Assertion+case_throwError = do+    i <- newIORef one+    Left "throwError" <- runErrorT $+        (liftIO (writeIORef i 2) >> throwError "throwError")+        `finally`+        (liftIO $ writeIORef i 3)+    j <- readIORef i+    j @?= 3++case_tell :: Assertion+case_tell = do+    i <- newIORef one+    ((), w) <- runWriterT $ bracket_+        (liftIO (writeIORef i 2) >> tell [1])+        (liftIO (writeIORef i 4) >> tell [3])+        (liftIO (writeIORef i 3) >> tell [2])+    j <- readIORef i+    j @?= 4+    w @?= [2]++    ((), w') <- runWriterT $ bracket+        (liftIO (writeIORef i 5) >> tell [5])+        (const $ liftIO (writeIORef i 7) >> tell [7])+        (const $ liftIO (writeIORef i 6) >> tell [6])+    j' <- readIORef i+    j' @?= 7+    w' @?= [5, 6]