packages feed

pipes-safe 1.2.0 → 2.0.0

raw patch · 7 files changed

+463/−1136 lines, 7 filesdep +containersdep +exceptionsdep ~pipesPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, exceptions

Dependency ranges changed: pipes

API changes (from Hackage documentation)

- Control.Proxy.Safe.Core: bracket :: (Monad m, Proxy p) => (forall x. SafeIO x -> m x) -> IO h -> (h -> IO r') -> (h -> ExceptionP p a' a b' b m r) -> ExceptionP p a' a b' b m r
- Control.Proxy.Safe.Core: bracketOnAbort :: (Monad m, Proxy p) => (forall x. SafeIO x -> m x) -> IO h -> (h -> IO r') -> (h -> ExceptionP p a' a b' b m r) -> ExceptionP p a' a b' b m r
- Control.Proxy.Safe.Core: bracket_ :: (Monad m, Proxy p) => (forall x. SafeIO x -> m x) -> IO r1 -> IO r2 -> ExceptionP p a' a b' b m r -> ExceptionP p a' a b' b m r
- Control.Proxy.Safe.Core: catch :: (Exception e, Monad m, Proxy p) => ExceptionP p a' a b' b m r -> (e -> ExceptionP p a' a b' b m r) -> ExceptionP p a' a b' b m r
- Control.Proxy.Safe.Core: class Proxy p => CheckP p
- Control.Proxy.Safe.Core: data SafeIO r
- Control.Proxy.Safe.Core: finally :: (Monad m, Proxy p) => (forall x. SafeIO x -> m x) -> IO r' -> ExceptionP p a' a b' b m r -> ExceptionP p a' a b' b m r
- Control.Proxy.Safe.Core: handle :: (Exception e, Monad m, Proxy p) => (e -> ExceptionP p a' a b' b m r) -> ExceptionP p a' a b' b m r -> ExceptionP p a' a b' b m r
- Control.Proxy.Safe.Core: instance Applicative SafeIO
- Control.Proxy.Safe.Core: instance CheckP ProxyCorrect
- Control.Proxy.Safe.Core: instance CheckP ProxyFast
- Control.Proxy.Safe.Core: instance CheckP p => CheckP (IdentityP p)
- Control.Proxy.Safe.Core: instance CheckP p => CheckP (ReaderP i p)
- Control.Proxy.Safe.Core: instance Functor SafeIO
- Control.Proxy.Safe.Core: instance Monad SafeIO
- Control.Proxy.Safe.Core: onAbort :: (Monad m, Proxy p) => (forall x. SafeIO x -> m x) -> IO r' -> ExceptionP p a' a b' b m r -> ExceptionP p a' a b' b m r
- Control.Proxy.Safe.Core: runSafeIO :: SafeIO (Either SomeException r) -> IO r
- Control.Proxy.Safe.Core: runSaferIO :: SafeIO (Either SomeException r) -> IO r
- Control.Proxy.Safe.Core: throw :: (Monad m, Proxy p, Exception e) => e -> ExceptionP p a' a b' b m r
- Control.Proxy.Safe.Core: try :: CheckP p => p a' a b' b IO r -> ExceptionP p a' a b' b SafeIO r
- Control.Proxy.Safe.Core: tryIO :: Proxy p => IO r -> ExceptionP p a' a b' b SafeIO r
- Control.Proxy.Safe.Core: tryK :: CheckP p => (q -> p a' a b' b IO r) -> (q -> ExceptionP p a' a b' b SafeIO r)
- Control.Proxy.Safe.Core: trySafeIO :: SafeIO e -> IO e
- Control.Proxy.Safe.Core: trySaferIO :: SafeIO e -> IO e
- Control.Proxy.Safe.Core: type ExceptionP = EitherP SomeException
- Control.Proxy.Safe.Core: unsafeClose :: Proxy p => r -> ExceptionP p a' a b' b SafeIO r
- Control.Proxy.Safe.Core: unsafeCloseD :: Proxy p => r -> ExceptionP p a' a b' b SafeIO r
- Control.Proxy.Safe.Core: unsafeCloseU :: Proxy p => r -> ExceptionP p a' a b' b SafeIO r
- Control.Proxy.Safe.Prelude: readFileS :: Proxy p => FilePath -> () -> Producer (ExceptionP p) String SafeIO ()
- Control.Proxy.Safe.Prelude: withFile :: (Monad m, Proxy p) => (forall x. SafeIO x -> m x) -> FilePath -> IOMode -> (Handle -> ExceptionP p a' a b' b m r) -> ExceptionP p a' a b' b m r
- Control.Proxy.Safe.Prelude: writeFileD :: Proxy p => FilePath -> x -> ExceptionP p x String x String SafeIO r
+ Pipes.Safe: bracket :: MonadSafe m => Base m a -> (a -> Base m b) -> (a -> m c) -> m c
+ Pipes.Safe: bracketOnError :: MonadSafe m => Base m a -> (a -> Base m b) -> (a -> m c) -> m c
+ Pipes.Safe: bracket_ :: MonadSafe m => Base m a -> Base m b -> m c -> m c
+ Pipes.Safe: class (MonadCatch m, MonadIO m, Monad (Base m)) => MonadSafe m
+ Pipes.Safe: data ReleaseKey
+ Pipes.Safe: data SafeT m r
+ Pipes.Safe: finally :: MonadSafe m => m a -> Base m b -> m a
+ Pipes.Safe: instance (MonadCatch m, MonadIO m) => MonadCatch (Proxy a' a b' b m)
+ Pipes.Safe: instance (MonadIO m, MonadCatch m) => MonadSafe (SafeT m)
+ Pipes.Safe: instance (MonadSafe m, Monoid w) => MonadSafe (RWST i w s m)
+ Pipes.Safe: instance (MonadSafe m, Monoid w) => MonadSafe (WriterT w m)
+ Pipes.Safe: instance Monad m => Applicative (SafeT m)
+ Pipes.Safe: instance Monad m => Functor (SafeT m)
+ Pipes.Safe: instance Monad m => Monad (SafeT m)
+ Pipes.Safe: instance MonadCatch m => MonadCatch (SafeT m)
+ Pipes.Safe: instance MonadIO m => MonadIO (SafeT m)
+ Pipes.Safe: instance MonadSafe m => MonadSafe (CatchT m)
+ Pipes.Safe: instance MonadSafe m => MonadSafe (IdentityT m)
+ Pipes.Safe: instance MonadSafe m => MonadSafe (Proxy a' a b' b m)
+ Pipes.Safe: instance MonadSafe m => MonadSafe (ReaderT i m)
+ Pipes.Safe: instance MonadSafe m => MonadSafe (StateT s m)
+ Pipes.Safe: instance MonadTrans SafeT
+ Pipes.Safe: liftBase :: MonadSafe m => Base m r -> m r
+ Pipes.Safe: onException :: MonadSafe m => m a -> Base m b -> m a
+ Pipes.Safe: register :: MonadSafe m => Base m () -> m ReleaseKey
+ Pipes.Safe: release :: MonadSafe m => ReleaseKey -> m ()
+ Pipes.Safe: runSafeP :: (MonadCatch m, MonadIO m) => Effect (SafeT m) r -> Effect' m r
+ Pipes.Safe: runSafeT :: (MonadCatch m, MonadIO m) => SafeT m r -> m r
+ Pipes.Safe.Prelude: readFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Producer' String m ()
+ Pipes.Safe.Prelude: withFile :: (MonadSafe m, Base m ~ IO) => FilePath -> IOMode -> (Handle -> m r) -> m r
+ Pipes.Safe.Prelude: writeFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Consumer' String m r

Files

− Control/Proxy/Safe.hs
@@ -1,18 +0,0 @@-{-| I recommend you use this module as the default entry point.--    This module exports the entire library for convenience:--    * "Control.Proxy.Safe.Core": All exception safety and resource management-      primitives--    * "Control.Proxy.Safe.Prelude": Prelude of managed proxies--}--module Control.Proxy.Safe (-    -- * Modules-    module Control.Proxy.Safe.Core,-    module Control.Proxy.Safe.Prelude,-    ) where--import Control.Proxy.Safe.Core-import Control.Proxy.Safe.Prelude
− Control/Proxy/Safe/Core.hs
@@ -1,552 +0,0 @@--- | Exception handling and resource management integrated with proxies--{-# LANGUAGE Rank2Types, CPP #-}--module Control.Proxy.Safe.Core (-    -- * Exception Handling-    -- $exceptionp-    module Control.Proxy.Trans.Either,-    module Control.Exception,-    ExceptionP,-    throw,-    catch,-    handle,--    -- * Safe IO-    SafeIO,-    runSafeIO,-    runSaferIO,-    trySafeIO,-    trySaferIO,--    -- * Checked Exceptions-    -- $check-    CheckP(..),-    tryIO,--    -- * Finalization-    onAbort,-    finally,-    bracket,-    bracket_,-    bracketOnAbort,--    -- * Prompt Finalization-    -- $prompt-    unsafeCloseU,-    unsafeCloseD,-    unsafeClose,--    -- * Deprecated-    -- $deprecated-    tryK-    ) where--import qualified Control.Exception as Ex-import Control.Exception (SomeException, Exception)-import Control.Applicative (Applicative(pure, (<*>)))-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Reader (ReaderT(ReaderT, runReaderT), asks)-import qualified Control.Proxy as P-import qualified Control.Proxy.Core.Fast as PF-import qualified Control.Proxy.Core.Correct as PC-import Control.Proxy ((->>), (>>~))-import qualified Control.Proxy.Trans.Either as E-import Control.Proxy.Trans.Either hiding (throw, catch, handle)-import qualified Control.Proxy.Trans.Reader as R-import Data.IORef (IORef, newIORef, readIORef, writeIORef)-#if MIN_VERSION_base(4,6,0)-#else-import Prelude hiding (catch)-#endif-import System.IO.Error (userError)--{- $exceptionp-    This library checks and stores all exceptions using the 'EitherP' proxy-    transformer.  The 'ExceptionP' type synonym simplifies type signatures.--    Use 'runEitherP' / 'runEitherK' from the re-exported-    @Control.Proxy.Trans.Either@ to convert 'ExceptionP' back to the base monad.--    This module does not re-export 'E.throw', 'E.catch', and 'E.handle' from-    @Control.Proxy.Trans.Either@ and instead defines new versions similar to the-    API from @Control.Exception@.  If you want the old versions you will need to-    import them qualified.--    This module only re-exports 'SomeException' and 'Exception' from-    @Control.Exception@.--}---- | A proxy transformer that stores exceptions using 'EitherP'-type ExceptionP = EitherP SomeException---- | Analogous to 'Ex.throwIO' from @Control.Exception@-throw :: (Monad m, P.Proxy p, Ex.Exception e) => e -> ExceptionP p a' a b' b m r-throw = E.throw . Ex.toException---- | Analogous to 'Ex.catch' from @Control.Exception@-catch-    :: (Ex.Exception e, Monad m, P.Proxy p)-    => ExceptionP p a' a b' b m r         -- ^ Original computation-    -> (e -> ExceptionP p a' a b' b m r)  -- ^ Handler-    -> ExceptionP p a' a b' b m r-catch p f = p `E.catch` (\someExc ->-    case Ex.fromException someExc of-        Nothing -> E.throw someExc-        Just e  -> f e )---- | Analogous to 'Ex.handle' from @Control.Exception@-handle-    :: (Ex.Exception e, Monad m, P.Proxy p)-    => (e -> ExceptionP p a' a b' b m r)  -- ^ Handler-    -> ExceptionP p a' a b' b m r         -- ^ Original computation-    -> ExceptionP p a' a b' b m r-handle = flip catch--data Status = Status {-    restore    :: forall a . IO a -> IO a,-    upstream   :: IORef (IO ())          ,-    downstream :: IORef (IO ())          }--{-| 'SafeIO' masks asynchronous exceptions by default, and only unmasks them-    during 'try' or 'tryIO' blocks in order to check all asynchronous-    exceptions.--    'SafeIO' also saves all finalizers dropped as a result of premature-    termination and runs them when the 'P.Session' completes.--}-newtype SafeIO r = SafeIO { unSafeIO :: ReaderT Status IO r }--instance Functor SafeIO where-    fmap f m = SafeIO (fmap f (unSafeIO m))--instance Applicative SafeIO where-    pure r  = SafeIO (pure r)-    f <*> x = SafeIO (unSafeIO f <*> unSafeIO x)--instance Monad SafeIO where-    return r = SafeIO (return r)-    m >>= f  = SafeIO (unSafeIO m >>= \a -> unSafeIO (f a))--{-| Convert back to the 'IO' monad, running all dropped finalizers at the very-    end and rethrowing any checked exceptions--    This uses 'Ex.mask' to mask asynchronous exceptions and only unmasks them-    during 'try' or 'tryIO'.--}-runSafeIO :: SafeIO (Either SomeException r) -> IO r-runSafeIO m =-    Ex.mask $ \restore -> do-        huRef <- newIORef (return ())-        hdRef <- newIORef (return ())-        e <- runReaderT (unSafeIO m) (Status restore huRef hdRef)-            `Ex.finally` (do-                hu <- readIORef huRef-                hu-                hd <- readIORef hdRef-                hd )-        case e of-            Left exc -> Ex.throwIO exc-            Right r  -> return r--{-| Convert back to the 'IO' monad, running all dropped finalizers at the very-    end and rethrowing any checked exceptions--    This uses 'Ex.uninterruptibleMask' to mask asynchronous exceptions and only-    unmasks them during 'try' or 'tryIO'.--}-runSaferIO :: SafeIO (Either SomeException r) -> IO r-runSaferIO m =-    Ex.uninterruptibleMask $ \restore -> do-        huRef <- newIORef (return ())-        hdRef <- newIORef (return ())-        e <- runReaderT (unSafeIO m) (Status restore huRef hdRef)-            `Ex.finally` (do-                hu <- readIORef huRef-                hu-                hd <- readIORef hdRef-                hd )-        case e of-            Left exc -> Ex.throwIO exc-            Right r  -> return r--{-| Convert back to the 'IO' monad, running all dropped finalizers at the very-    end and preserving exceptions as 'Left's--    This uses 'Ex.mask' to mask asynchronous exceptions and only unmasks them-    during 'try' or 'tryIO'.--}-trySafeIO :: SafeIO e -> IO e-trySafeIO m =-    Ex.mask $ \restore -> do-        huRef <- newIORef (return ())-        hdRef <- newIORef (return ())-        runReaderT (unSafeIO m) (Status restore huRef hdRef) `Ex.finally` (do-            hu <- readIORef huRef-            hu-            hd <- readIORef hdRef-            hd )--{-| Convert back to the 'IO' monad, running all dropped finalizers at the very-    end and preserving exceptions as 'Left's--    This uses 'Ex.uninterruptibleMask' to mask asynchronous exceptions and only-    unmasks them during 'try' or 'tryIO'.--}-trySaferIO :: SafeIO e -> IO e-trySaferIO m =-    Ex.uninterruptibleMask $ \restore -> do-        huRef <- newIORef (return ())-        hdRef <- newIORef (return ())-        runReaderT (unSafeIO m) (Status restore huRef hdRef) `Ex.finally` (do-            hu <- readIORef huRef-            hu-            hd <- readIORef hdRef-            hd )--{- I don't export 'register' only because people rarely want to guard solely-   against premature termination.  Usually they also want to guard against-   exceptions, too.--    @registerK = (register .)@ should satisfy the following laws:--* 'registerK' defines a functor from finalizers to functions:--> registerK morph m1 . registerK morph m2 = registerK morph (m2 >> m1)-> -> registerK morph (return ()) = id--* 'registerK' is a functor between Kleisli categories:--> registerK morph m (p1 >=> p2) = registerK morph m p1 >=> registerK morph m p2->-> registerK morph m return = return--    These laws are not provable using the current set of proxy laws, mainly-    because the proxy laws do not yet specify how proxies interact with the-    'Arrow' instance for the Kleisli category.  However, I'm reasonably sure-    that when I do specify this interaction that the above laws will hold.--    For now, just consider the above laws the contract for 'register' and-    consider any violations of the above laws as bugs.--}-register-    :: (Monad m, P.Proxy p)-    => (forall x . SafeIO x -> m x)-    -> IO ()-    -> p a' a b' b m r-    -> p a' a b' b m r-register morph h k =-    P.runIdentityP . P.hoist morph . up-    ->> k-    >>~ P.runIdentityP . P.hoist morph . dn-  where-    dn b0 = do-        huRef <- lift $ SafeIO $ asks downstream-        let dn' b = do-                hu <- lift $ SafeIO $ lift $ do-                    hu <- readIORef huRef-                    writeIORef huRef (hu >> h)-                    return hu-                b' <- P.respond b-                lift $ SafeIO $ lift $ writeIORef huRef hu-                b2 <- P.request b'-                dn' b2-        dn' b0-    up a'0 = do-        hdRef <- lift $ SafeIO $ asks upstream-        let up' a' = do-                hd  <- lift $ SafeIO $ lift $ do-                    hd <- readIORef hdRef-                    writeIORef hdRef (hd >> h)-                    return hd-                a   <- P.request a'-                lift $ SafeIO $ lift $ writeIORef hdRef hd-                a'2 <- P.respond a-                up' a'2-        up' a'0--{- $check-    The following @try@ functions are the only way to convert 'IO' actions to-    'SafeIO'.  These functions check all exceptions, including asynchronous-    exceptions, and store them in the 'ExceptionP' proxy transformer.--}--{-| Use 'try' to retroactively check all exceptions for proxies that implement-    'CheckP'.--    'try' is /almost/ a proxy morphism (See @Control.Proxy.Morph@ from @pipes@-    for the full list of laws).  The only exception is the following law:--> try (return x) = return x--    The left-hand side unmasks asynchronous exceptions and checks them-    immediately, whereas the right-hand side delays asynchronous exceptions-    until the next 'try' or 'tryIO' block.--}-class (P.Proxy p) => CheckP p where-    try :: p a' a b' b IO r -> ExceptionP p a' a b' b SafeIO r--instance CheckP PF.ProxyFast where-    try p0 = EitherP (go p0) where-        go p = case p of-            PF.Request a' fa  -> PF.Request a' (\a  -> go (fa  a ))-            PF.Respond b  fb' -> PF.Respond b  (\b' -> go (fb' b'))-            PF.M m -> PF.M (SafeIO (ReaderT (\s -> do-                e <- Ex.try (restore s m)-                case e of-                    Left exc -> return (PF.Pure (Left exc))-                    Right p' -> return (go p') )))-            PF.Pure r -> PF.Pure (Right r)--instance CheckP PC.ProxyCorrect where-    try p0 = EitherP (go p0) where-        go p = PC.Proxy (SafeIO (ReaderT (\s -> do-            e <- Ex.try (restore s (PC.unProxy p))-            case e of-                Left exc -> return (PC.Pure (Left exc))-                Right fp -> case fp of-                    PC.Request a' fa  ->-                        return (PC.Request a' (\a  -> go (fa  a )))-                    PC.Respond b  fb' ->-                        return (PC.Respond b  (\b' -> go (fb' b')))-                    PC.Pure r -> return (PC.Pure (Right r)) )))--instance (CheckP p) => CheckP (P.IdentityP p) where-    try = EitherP . P.IdentityP . runEitherP . try . P.runIdentityP--instance (CheckP p) => CheckP (R.ReaderP i p) where-    try p = EitherP $ R.ReaderP $ \i -> runEitherP $ try (R.unReaderP p i)--{-| Check all exceptions for an 'IO' action--    'tryIO' is a monad morphism, with the same caveat as 'try'.--}-tryIO :: (P.Proxy p) => IO r -> ExceptionP p a' a b' b SafeIO r-tryIO io = EitherP $ P.runIdentityP $ lift $ SafeIO $ ReaderT $ \s ->-    Ex.try $ restore s io--{-| Similar to 'Ex.onException' from @Control.Exception@, except this also-    protects against:--    * premature termination, and--    * exceptions in other proxy stages.--    The first argument lifts 'onAbort' to work with other base monads.  Use-    'id' if your base monad is already 'SafeIO'.--    @(onAbort morph fin)@ is a monad morphism:--> onAbort morph fin $ do x <- m  =  do x <- onAbort morph fin m->                        f x           onAbort morph fin (f x)->-> onAbort morph fin (return x) = return x--    'onAbort' ensures finalizers are called from inside to out:--> onAbort morph fin1 . onAbort morph fin2 = onAbort morph (fin2 >> fin1)->-> onAbort morph (return ()) = id--}-onAbort-    :: (Monad m, P.Proxy p)-    => (forall x . SafeIO x -> m x)  -- ^ Monad morphism-    -> IO r'                         -- ^ Action to run on abort-    -> ExceptionP p a' a b' b m r    -- ^ Guarded computation-    -> ExceptionP p a' a b' b m r-onAbort morph after p =-    register morph (after >> return ()) p-        `E.catch` (\e -> do-            P.hoist morph $ tryIO after-            E.throw e )--{-| Analogous to 'Ex.finally' from @Control.Exception@--    The first argument lifts 'finally' to work with other base monads.  Use 'id'-    if your base monad is already 'SafeIO'.--> finally morph after p = do->     r <- onAbort morph after p->     hoist morph $ tryIO after->     return r--}-finally-    :: (Monad m, P.Proxy p)-    => (forall x . SafeIO x -> m x) -- ^ Monad morphism-    -> IO r'                        -- ^ Guaranteed final action-    -> ExceptionP p a' a b' b m r   -- ^ Guarded computation-    -> ExceptionP p a' a b' b m r-finally morph after p = do-    r <- onAbort morph after p-    P.hoist morph $ tryIO after-    return r--{-| Analogous to 'Ex.bracket' from @Control.Exception@--    The first argument lifts 'bracket' to work with other base monads.  Use 'id'-    if your base monad is already 'SafeIO'.--    'bracket' guarantees that if the resource acquisition completes, then the-    resource will be released.--> bracket morph before after p = do->     h <- hoist morph $ tryIO before->     finally morph (after h) (p h)--}-bracket-    :: (Monad m, P.Proxy p)-    => (forall x . SafeIO x -> m x)       -- ^ Monad morphism-    -> IO h                               -- ^ Acquire resource-    -> (h -> IO r')                       -- ^ Release resource-    -> (h -> ExceptionP p a' a b' b m r)  -- ^ Use resource-    -> ExceptionP p a' a b' b m r-bracket morph before after p = do-    h <- P.hoist morph $ tryIO before-    finally morph (after h) (p h)--{-| Analogous to 'Ex.bracket_' from @Control.Exception@--    The first argument lifts 'bracket_' to work with any base monad.  Use 'id'-    if your base monad is already 'SafeIO'.--> bracket_ morph before after p = do->     hoist morph $ tryIO before->     finally morph after p--}-bracket_-    :: (Monad m, P.Proxy p)-    => (forall x . SafeIO x -> m x)  -- ^ Monad morphism-    -> IO r1                         -- ^ Acquire resource-    -> IO r2                         -- ^ Release resource-    -> ExceptionP p a' a b' b m r    -- ^ Use resource-    -> ExceptionP p a' a b' b m r-bracket_ morph before after p = do-    P.hoist morph $ tryIO before-    finally morph after p--{-| Analogous to 'Ex.bracketOnError' from @Control.Exception@--    The first argument lifts 'bracketOnAbort' to work with any base monad.  Use-    'id' if your base monad is already 'SafeIO'.--> bracketOnAbort morph before after p = do->     h <- hoist morph $ tryIO before->     onAbort morph (after h) (p h)--}-bracketOnAbort-    :: (Monad m, P.Proxy p)-    => (forall x . SafeIO x -> m x)       -- ^ Monad morphism-    -> IO h                               -- ^ Acquire resource-    -> (h -> IO r')                       -- ^ Release resource-    -> (h -> ExceptionP p a' a b' b m r)  -- ^ Use resource-    -> ExceptionP p a' a b' b m r-bracketOnAbort morph before after p = do-    h <- P.hoist morph $ tryIO before-    onAbort morph (after h) (p h)--{- $prompt-    This implementation will not /promptly/ finalize a 'P.Proxy' if another-    composed 'P.Proxy' prematurely terminates.  However, the implementation will-    still save the dropped finalizer and run it when the 'P.Session' completes-    in order to guarantee deterministic finalization.--    To see why, consider the following 'P.Proxy' assembly:--> p1 >-> ((p2 >-> p3) >=> p4)--    Now ask yourself the question, \"If @p3@ prematurely terminates, should it-    promptly finalize @p1@?\"--    If you answered \"yes\", then you would have a bug if @p4@ were to-    'request', which would restore control to @p1@ after we already finalized-    it.--    If you answered \"no\", then consider the case where @p2 = idT@ and-    @p4 = return@:--> p1 >-> ((idT >-> p3) >=> return)-> p1 >-> (idT >-> p3)               -- f   >=> return = f-> p1 >-> p3                         -- idT >-> p      = p--    Answering \"no\" means that @p3@ would be unable to promptly finalize a-    'P.Proxy' immediately upstream of it.--    There is a solution that permits perfectly prompt finalization, but it-    requires indexed monads to guarantee the necessary safety through the type-    system.  In the absence of indexed monads, the next best solution is to let-    you promptly finalize things yourself, but then /you/ must prove that this-    finalization is safe and that all upstream pipes are unreachable.--    The following two unsafe operations allow you to trade safety for prompt-    finalization.  Use them if you desire prompter finalization guarantees and-    if you can prove their usage is safe.  However, this proof is not trivial.--    For example, you might suppose that the following usage of 'unsafeCloseU' is-    safe because it never 'request's after closing upstream, nor does it-    terminate:--> falseSenseOfSecurity () = do->     x <- request ()->     unsafeCloseU ()->     forever $ respond x--    However, this is not safe, as the following counter-example demonstrates:--> p1 >-> ((falseSenseOfSecurity >-> request) >=> request)--    @falseSenseOfSecurity@ will finalize the upstream @p1@, but then will-    abort when the downstream 'request' terminates, and then the second-    'request' will illegally access @p1@ after we already finalized it.--    In other words, you cannot prove any prompt finalization is safe unless you-    control the entire 'P.Session'.  Therefore, do not use the following unsafe-    operations in 'P.Proxy' libraries.  Only the end user assembling the-    final 'P.Session' may safely insert these calls.--}--{-| 'unsafeCloseU' calls all finalizers registered upstream of the current-    'P.Proxy'.--}-unsafeCloseU :: (P.Proxy p) => r -> ExceptionP p a' a b' b SafeIO r-unsafeCloseU r = do-    (huRef, hu) <- lift $ SafeIO $ do-        huRef <- asks upstream-        hu    <- lift $ readIORef huRef-        return (huRef, hu)-    tryIO hu-    lift $ SafeIO $ lift $ writeIORef huRef (return ())-    return r--{-| 'unsafeCloseD' calls all finalizers registered downstream of the current-    'P.Proxy'.--}-unsafeCloseD :: (P.Proxy p) => r -> ExceptionP p a' a b' b SafeIO r-unsafeCloseD r = do-    (hdRef, hd) <- lift $ SafeIO $ do-        hdRef <- asks downstream-        hd    <- lift $ readIORef hdRef-        return (hdRef, hd)-    tryIO hd-    lift $ SafeIO $ lift $ writeIORef hdRef (return ())-    return r--{-| 'unsafeClose' calls all registered finalizers--    'unsafeClose' is a Kleisli arrow so that you can easily seal terminating-    proxies if there is a risk of delayed finalization:--> (producer >-> (takeB_ 10 >=> unsafeClose) >-> consumer) >=> later--}-unsafeClose :: (P.Proxy p) => r -> ExceptionP p a' a b' b SafeIO r-unsafeClose = unsafeCloseU P.>=> unsafeCloseD--{- $deprecated-    To be removed in version @2.0.0@--}--tryK-    :: (CheckP p)-    => (q -> p a' a b' b IO r) -> (q -> ExceptionP p a' a b' b SafeIO r)-tryK = (try .)-{-# DEPRECATED tryK "Use '(try .)' instead" #-}
− Control/Proxy/Safe/Prelude.hs
@@ -1,63 +0,0 @@--- | Prelude of proxies providing simple resource management features--{-# LANGUAGE Rank2Types #-}--module Control.Proxy.Safe.Prelude (-    -- * Handle allocation-    withFile,--    -- * String I/O-    -- $string-    readFileS,-    writeFileD-    ) where--import Control.Proxy (Proxy(request, respond), Producer)-import Control.Proxy.Safe.Core (SafeIO, ExceptionP, bracket, tryIO)-import qualified System.IO as IO---- | Safely allocate a 'IO.Handle' within a managed 'Proxy'-withFile-    :: (Monad m, Proxy p)-    => (forall x . SafeIO x -> m x)               -- ^Monad morphism-    -> FilePath                                   -- ^File-    -> IO.IOMode                                  -- ^IO Mode-    -> (IO.Handle -> ExceptionP p a' a b' b m r)  -- ^Continuation-    -> ExceptionP p a' a b' b m r-withFile morph file ioMode = bracket morph (IO.openFile file ioMode) IO.hClose--{- $string-    Note that 'String's are very inefficient, and I will release future separate-    packages with 'ByteString' and 'Text' operations.  I only provide these to-    allow users to test simple I/O without requiring any additional library-    dependencies.--}-{-| Read from a file, lazily opening the 'IO.Handle' and automatically closing-    it afterwards--}-readFileS-    :: (Proxy p) => FilePath -> () -> Producer (ExceptionP p) String SafeIO ()-readFileS file () = withFile id file IO.ReadMode $ \handle -> do-    let go = do-            eof <- tryIO $ IO.hIsEOF handle-            if eof-                then return ()-                else do-                    str <- tryIO $ IO.hGetLine handle-                    respond str-                    go-    go--{-| Write to a file, lazily opening the 'IO.Handle' and automatically closing it-    afterwards--}-writeFileD-    :: (Proxy p) => FilePath -> x -> ExceptionP p x String x String SafeIO r-writeFileD file x0 = do-    withFile id file IO.WriteMode $ \handle -> do-        let go x = do-                str <- request x-                tryIO $ IO.hPutStrLn handle str-                x2 <- respond str-                go x2-        go x0
− Control/Proxy/Safe/Tutorial.hs
@@ -1,486 +0,0 @@-{-| This module provides the tutorial for the @pipes-safe@ library--    This tutorial assumes that you have already read the main @pipes@ tutorial-    in @Control.Proxy.Tutorial@.--}--module Control.Proxy.Safe.Tutorial (-    -- * Introduction-    -- $intro--    -- * Resource Safety-    -- $safety--    -- * Native Exception Handling-    -- $native--    -- * Checked Exceptions-    -- $checked--    -- * Prompt Finalization-    -- $prompt--    -- * Upgrade Proxy Transformers-    -- $trytransformer--    -- * Backwards Compatibility-    -- $backwards--    -- * Laziness-    -- $laziness--    -- * Conclusion-    -- $conclusion-    ) where--import Control.Proxy-import Control.Proxy.Safe-import System.IO (withFile)--{- $intro-    @pipes-safe@ adds exception-safe resource management to the @pipes@-    ecosystem.  Use this library if you want to:--    * Safely acquire and release resources within proxies--    * Natively catch and handle exceptions, including asynchronous exceptions--    The following example shows how to use 'P.Proxy' resource management to-    safely open and close a file:--> import Control.Monad (unless)-> import Control.Proxy-> import Control.Proxy.Safe-> import System.IO-> -> readFileS->     :: (Proxy p) => FilePath -> () -> Producer (ExceptionP p) String SafeIO ()-> readFileS file () = bracket id->     (do h <- openFile file ReadMode->         putStrLn $ "{File Open}"->         return h )->     (\h -> do putStrLn "{Closing File}"->               hClose h )->     (\h -> let loop = do->                    eof <- tryIO $ hIsEOF h->                    unless eof $ do->                        str <- tryIO $ hGetLine h->                        respond str->                        loop->             in loop )--    @readFileS@ uses 'bracket' from "Control.Proxy.Safe" to guard the file-    handle, which imposes two constraints on the type:--    * 'bracket' requires the 'ExceptionP' proxy transformer in order to handle-      exceptions--    * 'bracket' requires 'SafeIO' as the base monad, which checks all-      asynchronous exceptions and stores registered finalizers--    But what if we already wrote a 'Consumer' that doesn't use 'ExceptionP' or-    'SafeIO'?--> printer :: (Proxy p, Show a) => () -> Consumer p a IO r-> printer () = runIdentityP $ forever $ do->     a <- request ()->     lift $ print a--    Do we need to rewrite it to use resource management abstractions?  Not at-    all!  We can use 'try' to automatically promote any \"unmanaged\" proxy to a-    \"managed\" proxy:--> try :: (CheckP p) => p a' a b' b IO r -> ExceptionP p a' a b' b SafeIO r ->-> try . printer :: (CheckP p, Show a) => () -> Consumer (Exception p) a SafeIO r->-> session :: (CheckP p) => () -> Session (Exception p) SafeIO ()-> session = readFileS "test.txt" >-> try . printer--    The 'CheckP' constraint indicates that the base 'Proxy' type must be-    promotable using 'try'.--    To run this 'Session', we unwrap each layer:-->>> runSafeIO $ runProxy $ runEitherK session :: IO ()-{File Open}-"Line 1"-"Line 2"-"Line 3"-"Line 4"-{Closing File}---}--{- $safety-    'bracket' guarantees that every successful resource acquisition is paired-    with finalization, even in the face of exceptions or premature 'Session'-    termination.--    For example, if we only draw two lines of input, 'bracket' will still safely-    finalize the handle:--> main = runSafeIO $ runProxy $ runEitherK $->     readFileS "test.txt" >-> takeB_ 2 >-> try . printD-->>> main-{File Open}-"Line 1"-"Line 2"-{Closing File}--    We can even sabotage ourselves by killing our own thread after a delay:--> import Control.Concurrent->-> main = do->     tID <- myThreadId->     forkIO $ do->         threadDelay 1000->         killThread tID->     runSafeIO $ runProxy $ runEitherK $->         foreverK (readFileS "test.txt") >-> try . printD-->>> main-...-"Line 2"-"Line 3"-"Line 4"-{Closing File}-{File Open}-"Line 1"-"Line 2"-{Closing File}-*** Exception: thread killed--    ... yet 'bracket' still ensures deterministic resource finalization in the-    face of asynchronous exceptions.--}--{- $native-    Let's study the types a bit to understand what is going on:--> type ExceptionP = EitherP SomeException--    'ExceptionP' is just a type synonym around 'EitherP'.  @pipes-safe@ uses-    'EitherP' to check all exceptions in order to take advantage of the ability-    to 'catch' and 'throw' exceptions locally.  In fact, "Control.Proxy.Safe"-    defines specialized versions of 'throw' and 'catch' that mirror their-    equivalents in @Control.Exception@:--> throw :: (Monad m, Proxy p, Exception e) => e -> ExceptionP p a' a b' b m r->-> catch->     :: (Monad m, Proxy p, Exception e)->     => ExceptionP p a' a b' b m r->     -> (e -> ExceptionP p a' a b' b m r)->     -> ExceptionP p a' a b' b m r--    These let you embed native exception handling into proxies.  For example,-    we could use exception handling to recover from a file opening error:--> import Prelude hiding (catch)  -- if using `base <= 4.5`->-> openFileS :: (CheckP p) => () -> Producer (ExceptionP p) String SafeIO ()-> openFileS () = (do->     tryIO $ putStrLn "Select a file:"->     file <- tryIO getLine->     readFileS file () )->   `catch` (\e -> do->       tryIO $ print (e :: IOException)->       openFileS () )-->>> runSafeIO $ runProxy $ runEitherK $ openFileS >-> try . printD-Select a file:-oops-oops: openFile: does not exist (No such file or directory)-Select a file:-test.txt-{File Open}-"Line 1"-"Line 2"-"Line 3"-"Line 4"-{Closing File}--    You can even catch and resume from asynchronous exceptions:--> heartbeat->      :: Proxy p->      => ExceptionP p a' a b' b SafeIO r -> ExceptionP p a' a b' b SafeIO r-> heartbeat p = p `catch` (\e -> do->            let _ = e :: SomeException->            tryIO $ putStrLn "<Nice try!>"->            heartbeat p )->-> main = do->     tid <- myThreadId->     forkIO $ forever $ do->         threadDelay 5000000  -- Every 5 seconds->         killThread tid->     trySafeIO $ runProxy $ runEitherK $->         heartbeat . (openFileS >-> try . printD)-->>> main-Select a file:-te<Nice Try!>-Select a file:-st.txt-{File Open}-"Line 1"-"Line 2"-"Line 3"-"Line 4"-{Closing File}---}--{- $checked-    Exception handling works because 'SafeIO' checks all exceptions and stores-    them using the 'ExceptionP' proxy transformer.  'SafeIO' masks all-    asynchronous exceptions by default and only unmasks them in the middle of a-    'try' or 'tryIO' block.  This prevents asynchronous exceptions from leaking-    between the cracks.--    'runSafeIO' reraises the stored exception when the 'Session' completes, but-    you can also choose to preserve the exception as a 'Left' by using-    'trySafeIO' instead:--> main = do->     tID <- myThreadId->     forkIO $ do->         threadDelay 1000->         killThread tID->     trySafeIO $ runProxy $ runEitherK $->         foreverK (readFileS "test.txt") >-> try . printD-->>> main-...-"Line 2"-"Line 3"-"Line 4"-{Closing File}-{File Open}-"Line 1"-"Line 2"-{Closing File}-Left thread killed--    You can even choose whether to use 'mask' or 'uninterruptibleMask':--    * 'runSafeIO' and 'trySafeIO' both use 'mask'--    * 'runSaferIO' and 'trySaferIO' both use 'uninterruptibleMask'.--}--{- $prompt-    Resource management primitives like 'bracket' only guarantee prompt-    finalization in the face of exceptions.  Premature termination of-    composition will delay the finalizer until the end of the 'Session'.--    For example, consider the following 'Session':--> session () = do->    (readFileS "test.hs" >-> takeB_ 2 >-> try . printD) ()->    tryIO $ putStrLn "Look busy"-->>> runSafeIO $ runProxy $ runEitherK session-{File Open}-"Line 1"-"Line 2"-Look busy-{Closing File}--    @readFileS@ is interrupted when @takeB_@ terminates, so it does not get-    finalized until the very end of the 'Session'.--    The \"Prompt Finalization\" section of "Control.Proxy.Safe" documents why-    this behavior is the only safe default.  However, often we can prove that-    prompter finalization is safe, in which case we can take matters into our-    own hands and manually finalize things even more promptly:--> session () = do->     (readFileS "test.hs" >-> (takeB_ 2 >=> unsafeClose) >-> try . printD) ()->     tryIO $ putStrLn "Look busy"-->>> runSafeIO $ runProxy $ runEitherK session-{File Open}-"import Control.Concurrent"-"import Control.Monad (unless)"-{Closing File}-Look busy--    Fortunately, most of the time you will just assemble linear composition-    chains that look like this:--> runSafeIO $ runProxy $ runEitherK $ p1 >-> p2 >-> p3 >-> p4--    ... in which case the end of composition coincides with the end of the-    'Session' and there is no delay in finalization.  You only need to manually-    manage prompt finalization if you sequence anything after composition.--}--{- $trytransformer-    Not all proxy transformers implement 'try'.  You can look at the instance-    list for 'CheckP' and you will see that it mainly covers the base-    proxy implementations and trivial proxy transformers:--> instance CheckP ProxyFast-> instance CheckP ProxyCorrect-> instance (CheckP p) => CheckP (IdentityP p)-> instance (CheckP p) => CheckP (ReaderP   p)--    This means that we can usually only 'try' the base proxy.  However, this is-    not a problem because we can just 'hoistP' 'try' over the outer proxy-    transformers to target it to the base proxy.--    For example, if we have a 'Proxy' with two proxy transformer layers:--> p :: (CheckP p) => Producer (StateP s (MaybeP p)) IO r--    ... we just 'hoistP' the 'try' over the two outer layers to target it to the-    base 'Proxy':--> hoistP (hoistP try) p->     :: (CheckP p) => Producer (StateP s (MaybeP (ExceptionP p))) SafeIO r--    'hoistP' expects a proxy morphism for its argument, but is 'try' a proxy-    morphism?  Yes!  'try' satisfies the proxy morphism laws and the-    documentation in the @Control.Proxy.Morph@ module (from the @pipes@ package)-    lists the full set of laws.  The important laws you should remember are:--> try . (f >-> g) = try . f >-> try . g--> try (request a') = request a'--> try (respond b ) = respond b-->   do x <- try m->      try (f x)-> = try $ do x <- m->            f x->-> try (return x) = return x -- Almost true!--    The last equation is slightly incorrect.  The left hand-side may throw an-    asynchronous exception, but the right-hand side will not.  This does not-    compromise the safety of this library.  At worst, it will just overzealously-    mask pure segments of code if you don't wrap them in 'try', which just-    delays the asynchronous exception until the next 'try' or 'tryIO' block.--    There is one upgrade scenario that this library does not yet cover, which is-    'try'ing proxies that have base monads other than 'IO'.  For now, you will-    have to rewrite the proxy if that happens.--}--{- $backwards-    The biggest strength of @pipes-safe@ is that it requires no buy-in from the-    rest of the @pipes@ ecosystem.  Many proxies require no resource-management-    at all, so why should they clutter their implementation with such concerns?--    @pipes-safe@ lets you write these proxies using the simpler \"unmanaged\"-    types, and then transparently promote them with 'try' later on if you need-    to use them within a resource-managed 'Session'.--    For example, the main body of @readFileS@ is identical to the implementation-    of 'hGetLineS' from the proxy prelude:--> hGetLineS :: (Proxy p) => Handle -> () -> Producer p String IO ()-> hGetLineS h () = runIdentityP loop where->     loop = do->         eof <- lift $ hIsEOF h->         if eof->             then return ()->             else do->                 str <- lift $ hGetLine h->                 respond str->                 loop--    We can reuse 'hGetLineS' by define a 'withFileS' that abstracts away the-    handle management:--> withFileS->     :: (Proxy p)->     => FilePath->     -> (Handle -> b' -> ExceptionP p a' a b' b SafeIO r)->     -> b' -> ExceptionP p a' a b' b SafeIO r-> withFileS file p b' = bracket id->     (do h <- openFile file ReadMode->         putStrLn "{File Open}"->         return h )->     (\h -> do putStrLn "{Closing File}"->               hClose h )->     (\h -> p h b')--    ... and now we can define 'readFileS' in terms of 'withFileS' and-    'hGetLineS':--> readFileS file = withFileS file (\h -> try . (hGetLineS h))--    If 'hGetLineS' throws an error within its own code, 'withFileS' will still-    properly finalize the handle.  This works in spite of 'hGetLineS' never-    having been written to be resource safe.--}--{- $laziness-    Now you no longer need to open all resources before a 'Session' and close-    them afterwards.  Instead, you can lazily open resources in response to-    demand and trust that they finalize safely upon termination:--> files () = do->     readFileS "file1.txt" ()  -- 3 lines long->     readFileS "file2.txt" ()  -- 4 lines long-> -- or: files = readFileS "file1.txt" >=> readFileS "file2.txt"-->>> runSafeIO $ runProxy $ runEitherK $ files >-> takeB_ 2 >-> printD-{File Open}-"Line 1 of file1.txt"-"Line 2 of file1.txt"-{Closing File}--    @\"file2.txt\"@ never opens because we only demand two lines.--    Even if we use both files, we never keep more than one handle open at a-    time:- ->>> runSafeIO $ runProxy $ runEitherK $ files >-> takeB_ 5 >-> printD-{File Open}-"Line 1 of file1.txt"-"Line 2 of file1.txt"-"Line 3 of file1.txt"-{Closing File}-{File Open}-"Line 1 of file2.txt"-"Line 2 of file2.txt"-{Closing File}---}--{- $conclusion-    @pipes-safe@ lets you package streaming resources into self-contained units-    that include:--    * their allocation/deallocation code, and--    * their exception-handling strategies.--    @pipes-safe@ reuses 'EitherP' to let you easily reason about how local-    exception handling behaves.  More importantly, multiple resources can-    concurrently coexist with each other and not interfere with each other's-    exception-handling logic.  @pipes-safe@ isolates each streaming component's-    behavior so that you reason about it how it deals with failure independently-    of other components.--    I hope this inspires people to package up more powerful streaming-    abstractions into indivisible units.  Also, don't limit yourself to simple-    file or network resources.  You will find that @pipes-safe@ can also-    simplify and package up:--    * progress meters,--    * input devices (i.e. mice and keyboards), and--    * user interfaces.--    I encourage you to be creative!--}
pipes-safe.cabal view
@@ -1,5 +1,5 @@ Name: pipes-safe-Version: 1.2.0+Version: 2.0.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -11,24 +11,23 @@ Synopsis: Safety for the pipes ecosystem Description:     This package adds resource management and exception handling to the @pipes@-    ecosystem.  Notable features include:+    ecosystem.     .+    Notable features include:+    .     * /Resource Safety/: Guarantee finalization using @finally@, @bracket@ and       more     .-    * /Laziness/: Only acquire resources when you need them-    .-    * /Exception safe/: Even against asynchronous exceptions!+    * /Exception Safety/: Even against asynchronous exceptions!     .-    * /Native Exception Handling/: Catch and resume from exceptions within any-      @Session@+    * /Laziness/: Only acquire resources when you need them     .-    * /No Buy-in/: Managed pipes play nice with unmanaged pipes+    * /Promptness/: Finalize resources early when you are done with them     .-    Import @Control.Proxy.Safe@ to use this library+    * /Native Exception Handling/: Catch and resume from exceptions inside pipes     .-    Read @Control.Proxy.Safe.Tutorial@ for an introductory tutorial.-Category: Control, Pipes, Proxies+    * /No Buy-in/: Mix resource-safe pipes with unmanaged pipes using @hoist@+Category: Control, Pipes, Error Handling Source-Repository head     Type: git     Location: https://github.com/Gabriel439/Haskell-Pipes-Safe-Library@@ -36,11 +35,12 @@ Library     Build-Depends:         base         >= 4       && < 5  ,+        containers   >= 0.3.0.0 && < 0.6,+        exceptions   >= 0.3.2   && < 0.4,         transformers >= 0.2.0.0 && < 0.4,-        pipes        >= 3.2.0   && < 3.4+        pipes        >= 4.0.0   && < 4.1     Exposed-Modules:-        Control.Proxy.Safe,-        Control.Proxy.Safe.Core,-        Control.Proxy.Safe.Prelude,-        Control.Proxy.Safe.Tutorial-    GHC-Options: -O2+        Pipes.Safe,+        Pipes.Safe.Prelude+    HS-Source-Dirs: src+    GHC-Options: -O2 -Wall
+ src/Pipes/Safe.hs view
@@ -0,0 +1,399 @@+{-# LANGUAGE RankNTypes, TypeFamilies, FlexibleContexts, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-| This module provides an orphan 'MonadCatch' instance for 'Proxy' of the+    form:++> instance (MonadCatch m, MonadIO m) => MonadCatch (Proxy a' a b' b m) where++    ... so you can throw and catch exceptions within pipes using all+    'MonadCatch' operations.++    This module also provides generalized versions of some 'MonadCatch'+    operations so that you can also protect against premature termination of+    connected components.  For example, if you protect a 'readFile' computation+    using 'bracket' from this module:++> -- readFile.hs+> import Pipes+> import qualified Pipes.Prelude as P+> import Pipes.Safe+> import qualified System.IO as IO+> import Prelude hiding (readFile)+>+> readFile :: FilePath -> Producer' String (SafeT IO) ()+> readFile file = bracket+>     (do h <- IO.openFile file IO.ReadMode+>         putStrLn $ "{" ++ file ++ " open}"+>         return h )+>     (\h -> do+>         IO.hClose h+>         putStrLn $ "{" ++ file ++ " closed}" )+>     P.fromHandle++    ... then this generalized 'bracket' will guard against both exceptions and+    premature termination of other pipes:++>>> runSafeT $ runEffect $ readFile "readFile.hs" >-> P.take 4 >-> P.stdoutLn+{readFile.hs open}+-- readFile.hs+import Pipes+import qualified Pipes.Prelude as P+import Pipes.Safe+{readFile.hs closed}++    Note that the 'MonadCatch' instance for 'Proxy' provides weaker versions of+    'mask' and 'uninterruptibleMask' that do not completely prevent asynchronous+    exceptions.  Instead, they provide a weaker guarantee that asynchronous+    exceptions will only occur during 'Pipes.await's or 'Pipes.yield's and+    nowhere else.  For example, if you write:++> mask_ $ do+>     x <- await+>     lift $ print x+>     lift $ print x++    ... then you may receive an asynchronous exception during the 'Pipes.await',+    but you will not receive an asynchronous exception during or in between the+    two 'print' statements.  This weaker guarantee suffices to provide+    asynchronous exception safety.+-}++module Pipes.Safe+    ( -- * SafeT+      SafeT+    , runSafeT+    , runSafeP++     -- * MonadSafe+    , ReleaseKey+    , Base+    , MonadSafe(..)+    , onException+    , finally+    , bracket+    , bracket_+    , bracketOnError++    -- * Re-exports+    -- $reexports+    , module Control.Monad.Catch+    , module Control.Exception+    ) where++import Control.Applicative (Applicative(pure, (<*>)))+import Control.Exception(Exception(..), SomeException(..))+import qualified Control.Monad.Catch as C+import Control.Monad.Catch+    ( MonadCatch(..)+    , mask_+    , uninterruptibleMask_+    , catchAll+    , catchIOError+    , catchJust+    , catchIf+    , Handler(..)+    , catches+    , handle+    , handleAll+    , handleIOError+    , handleJust+    , handleIf+    , try+    , tryJust+    , Exception(..)+    , SomeException+    )+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Trans.Class (MonadTrans(lift))+import qualified Control.Monad.Catch.Pure          as E+import qualified Control.Monad.Trans.Identity      as I+import qualified Control.Monad.Trans.Reader        as R+import qualified Control.Monad.Trans.RWS.Lazy      as RWS+import qualified Control.Monad.Trans.RWS.Strict    as RWS'+import qualified Control.Monad.Trans.State.Lazy    as S+import qualified Control.Monad.Trans.State.Strict  as S'+import qualified Control.Monad.Trans.Writer.Lazy   as W+import qualified Control.Monad.Trans.Writer.Strict as W'+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import qualified Data.Map as M+import Data.Monoid (Monoid)+import Pipes (Proxy, Effect, Effect', runEffect)+import Pipes.Internal (unsafeHoist, Proxy(..))+import Pipes.Lift (liftCatchError)++data Restore m = Unmasked | Masked (forall x . m x -> m x)++liftMask+    :: forall m a' a b' b r . (MonadIO m, MonadCatch m)+    => (forall s . ((forall x . m x -> m x) -> m s) -> m s)+    -> ((forall x . Proxy a' a b' b m x -> Proxy a' a b' b m x)+        -> Proxy a' a b' b m r)+    -> Proxy a' a b' b m r+liftMask maskFunction k = do+        ioref <- liftIO (newIORef Unmasked)+        let unmask+                :: forall y . (Monad m)+                => Proxy a' a b' b m y -> Proxy a' a b' b m y+            unmask p = do+                mRestore <- liftIO (readIORef ioref)+                case mRestore of+                    Unmasked       -> p+                    Masked restore -> do+                        r <- unsafeHoist restore p+                        lift $ restore $ return ()+                        return r+            loop p = case p of+                Request a' fa  -> Request a' (loop . fa )+                Respond b  fb' -> Respond b  (loop . fb')+                M m0           -> M $ maskFunction $ \restore -> do+                    liftIO $ writeIORef ioref (Masked restore)+                    let loop' m = do+                            p' <- m+                            case p' of+                                M m' -> loop' m'+                                _    -> return p'+                    p' <- loop' m0+                    liftIO $ writeIORef ioref  Unmasked+                    return (loop p')+                Pure r         -> Pure r+        loop (k unmask)++instance (MonadCatch m, MonadIO m) => MonadCatch (Proxy a' a b' b m) where+    throwM = lift . throwM+    catch  = liftCatchError C.catch+    mask                = liftMask mask+    uninterruptibleMask = liftMask uninterruptibleMask++data Finalizers m = Finalizers+    { _nextKey    :: !Integer+    , _finalizers :: !(M.Map Integer (m ()))+    }++{-| 'SafeT' is a monad transformer that extends the base monad with the ability+    to 'register' and 'release' finalizers.++    All unreleased finalizers are called at the end of the 'SafeT' block, even+    in the event of exceptions.+-}+newtype SafeT m r = SafeT { unSafeT :: R.ReaderT (IORef (Finalizers m)) m r }++-- Deriving 'Functor'+instance (Monad m) => Functor (SafeT m) where+    fmap f m = SafeT (do+        r <- unSafeT m+        return (f r) )++-- Deriving 'Applicative'+instance (Monad m) => Applicative (SafeT m) where+    pure r = SafeT (return r)+    mf <*> mx = SafeT (do+        f <- unSafeT mf+        x <- unSafeT mx+        return (f x) )++-- Deriving 'Monad'+instance (Monad m) => Monad (SafeT m) where+    return r = SafeT (return r)+    m >>= f = SafeT (do+        r <- unSafeT m+        unSafeT (f r) )++-- Deriving 'MonadIO'+instance (MonadIO m) => MonadIO (SafeT m) where+    liftIO m = SafeT (liftIO m)++-- Deriving 'MonadCatch'+instance (MonadCatch m) => MonadCatch (SafeT m) where+    throwM e = SafeT (throwM e)+    m `catch` f = SafeT (unSafeT m `C.catch` \r -> unSafeT (f r))+    mask k = SafeT (mask (\restore ->+        unSafeT (k (\ma -> SafeT (restore (unSafeT ma)))) ))+    uninterruptibleMask k = SafeT (uninterruptibleMask (\restore ->+        unSafeT (k (\ma -> SafeT (restore (unSafeT ma)))) ))++instance MonadTrans SafeT where+    lift m = SafeT (lift m)++{-| Run the 'SafeT' monad transformer, executing all unreleased finalizers at+    the end of the computation+-}+runSafeT :: (MonadCatch m, MonadIO m) => SafeT m r -> m r+runSafeT m = C.bracket+    (liftIO $ newIORef $! Finalizers 0 M.empty)+    (\ioref -> do+        Finalizers _ fs <- liftIO (readIORef ioref)+        mapM snd (M.toDescList fs) )+    (R.runReaderT (unSafeT m))+{-# INLINABLE runSafeT #-}++{-| Run 'SafeT' in the base monad, executing all unreleased finalizers at the+    end of the computation++    Use 'runSafeP' to safely flush all unreleased finalizers and ensure prompt+    finalization without exiting the 'Proxy' monad.+-}+runSafeP :: (MonadCatch m, MonadIO m) => Effect (SafeT m) r -> Effect' m r+runSafeP = lift . runSafeT . runEffect+{-# INLINABLE runSafeP #-}++-- | Token used to 'release' a previously 'register'ed finalizer+newtype ReleaseKey = ReleaseKey { unlock :: Integer }++-- | The monad used to run resource management actions, typically 'IO'+type family Base (m :: * -> *) :: * -> *++type instance Base IO = IO+type instance Base (SafeT m) = m+type instance Base (Proxy a' a b' b m) = Base m+type instance Base (I.IdentityT m) = Base m+type instance Base (E.CatchT m) = Base m+type instance Base (R.ReaderT i m) = Base m+type instance Base (S.StateT s m) = Base m+type instance Base (S'.StateT s m) = Base m+type instance Base (W.WriterT w m) = Base m+type instance Base (W'.WriterT w m) = Base m+type instance Base (RWS.RWST i w s m) = Base m+type instance Base (RWS'.RWST i w s m) = Base m++{-| 'MonadSafe' lets you 'register' and 'release' finalizers that execute in a+    'Base' monad+-}+class (MonadCatch m, MonadIO m, Monad (Base m)) => MonadSafe m where+    -- | Lift an action from the 'Base' monad+    liftBase :: Base m r -> m r++    {-| 'register' a finalizer, ensuring that the finalizer gets called if the+        finalizer is not 'release'd before the end of the surrounding 'SafeT'+        block.+    -}+    register :: Base m () -> m ReleaseKey++    {-| 'release' a registered finalizer++        You can safely call 'release' more than once on the same 'ReleaseKey'.+        Every 'release' after the first one does nothing.+    -}+    release  :: ReleaseKey -> m ()++instance (MonadIO m, MonadCatch m) => MonadSafe (SafeT m) where+    liftBase = lift++    register io = do+        ioref <- SafeT R.ask+        liftIO $ do+            Finalizers n fs <- readIORef ioref+            writeIORef ioref $! Finalizers (n + 1) (M.insert n io fs)+            return (ReleaseKey n)++    release key = do+        ioref <- SafeT R.ask+        liftIO $ do+            Finalizers n fs <- readIORef ioref+            writeIORef ioref $! Finalizers n (M.delete (unlock key) fs)++instance (MonadSafe m) => MonadSafe (Proxy a' a b' b m) where+    liftBase = lift . liftBase+    register = lift . register+    release  = lift . release++instance (MonadSafe m) => MonadSafe (I.IdentityT m) where+    liftBase = lift . liftBase+    register = lift . register+    release  = lift . release++instance (MonadSafe m) => MonadSafe (E.CatchT m) where+    liftBase = lift . liftBase+    register = lift . register+    release  = lift . release++instance (MonadSafe m) => MonadSafe (R.ReaderT i m) where+    liftBase = lift . liftBase+    register = lift . register+    release  = lift . release++instance (MonadSafe m) => MonadSafe (S.StateT s m) where+    liftBase = lift . liftBase+    register = lift . register+    release  = lift . release++instance (MonadSafe m) => MonadSafe (S'.StateT s m) where+    liftBase = lift . liftBase+    register = lift . register+    release  = lift . release++instance (MonadSafe m, Monoid w) => MonadSafe (W.WriterT w m) where+    liftBase = lift . liftBase+    register = lift . register+    release  = lift . release++instance (MonadSafe m, Monoid w) => MonadSafe (W'.WriterT w m) where+    liftBase = lift . liftBase+    register = lift . register+    release  = lift . release++instance (MonadSafe m, Monoid w) => MonadSafe (RWS.RWST i w s m) where+    liftBase = lift . liftBase+    register = lift . register+    release  = lift . release++instance (MonadSafe m, Monoid w) => MonadSafe (RWS'.RWST i w s m) where+    liftBase = lift . liftBase+    register = lift . register+    release  = lift . release++{-| Analogous to 'C.onException' from @Control.Monad.Catch@, except this also+    protects against premature termination++    @(\`onException\` io)@ is a monad morphism.+-}+onException :: (MonadSafe m) => m a -> Base m b -> m a+m1 `onException` io = do+    key <- register (io >> return ())+    r   <- m1+    release key+    return r+{-# INLINABLE onException #-}++{-| Analogous to 'C.finally' from @Control.Monad.Catch@, except this also+    protects against premature termination+-}+finally :: (MonadSafe m) => m a -> Base m b -> m a+m1 `finally` after = bracket_ (return ()) after m1+{-# INLINABLE finally #-}++{-| Analogous to 'C.bracket' from @Control.Monad.Catch@, except this also+    protects against premature termination+-}+bracket :: (MonadSafe m) => Base m a -> (a -> Base m b) -> (a -> m c) -> m c+bracket before after action = mask $ \restore -> do+    h <- liftBase before+    r <- restore (action h) `onException` after h+    _ <- liftBase (after h)+    return r+{-# INLINABLE bracket #-}++{-| Analogous to 'C.bracket_' from @Control.Monad.Catch@, except this also+    protects against premature termination+-}+bracket_ :: (MonadSafe m) => Base m a -> Base m b -> m c -> m c+bracket_ before after action = bracket before (\_ -> after) (\_ -> action)+{-# INLINABLE bracket_ #-}++{-| Analogous to 'C.bracketOnError' from @Control.Monad.Catch@, except this also+    protects against premature termination+-}+bracketOnError+    :: (MonadSafe m) => Base m a -> (a -> Base m b) -> (a -> m c) -> m c+bracketOnError before after action = mask $ \restore -> do+    h <- liftBase before+    restore (action h) `onException` after h+{-# INLINABLE bracketOnError #-}++{- $reexports+    @Control.Monad.Catch@ re-exports all functions except for the ones that+    conflict with the generalized versions provided here (i.e. 'bracket',+    'finally', etc.).++    @Control.Exception@ re-exports 'Exception' and 'SomeException'.+-}
+ src/Pipes/Safe/Prelude.hs view
@@ -0,0 +1,47 @@+-- | Simple resource management functions++{-# LANGUAGE RankNTypes, TypeFamilies #-}++module Pipes.Safe.Prelude (+    -- * Handle management+    withFile,++    -- * String I/O+    -- $strings+    readFile,+    writeFile+    ) where++import Pipes (Producer', Consumer')+import Pipes.Safe (bracket, MonadSafe, Base)+import qualified Pipes.Prelude as P+import qualified System.IO as IO+import Prelude hiding (readFile, writeFile)++-- | Acquire a 'IO.Handle' within 'MonadSafe'+withFile+    :: (MonadSafe m, Base m ~ IO)+    => FilePath -> IO.IOMode -> (IO.Handle -> m r) -> m r+withFile file ioMode = bracket (IO.openFile file ioMode) IO.hClose+{-# INLINABLE withFile #-}++{- $strings+    Note that 'String's are very inefficient, and I will release future separate+    packages with 'Data.ByteString.ByteString' and 'Data.Text.Text' operations.+    I only provide these to allow users to test simple I/O without requiring any+    additional library dependencies.+-}++{-| Read lines from a file, automatically opening and closing the file as+    necessary+-}+readFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Producer' String m ()+readFile file = withFile file IO.ReadMode P.fromHandle+{-# INLINABLE readFile #-}++{-| Write lines to a file, automatically opening and closing the file as+    necessary+-}+writeFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Consumer' String m r+writeFile file = withFile file IO.WriteMode P.toHandle+{-# INLINABLE writeFile #-}