packages feed

pipes-safe 1.0.0 → 1.1.0

raw patch · 5 files changed

+668/−609 lines, 5 filesdep ~pipesdep ~transformersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: pipes, transformers

API changes (from Hackage documentation)

- Control.Proxy.Safe: 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: 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: 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: 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: class Proxy p => CheckP p
- Control.Proxy.Safe: data SafeIO r
- Control.Proxy.Safe: 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: 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: instance Applicative SafeIO
- Control.Proxy.Safe: instance CheckP ProxyCorrect
- Control.Proxy.Safe: instance CheckP ProxyFast
- Control.Proxy.Safe: instance CheckP p => CheckP (IdentityP p)
- Control.Proxy.Safe: instance CheckP p => CheckP (ReaderP i p)
- Control.Proxy.Safe: instance Functor SafeIO
- Control.Proxy.Safe: instance Monad SafeIO
- Control.Proxy.Safe: 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: runSafeIO :: SafeIO (Either SomeException r) -> IO r
- Control.Proxy.Safe: runSaferIO :: SafeIO (Either SomeException r) -> IO r
- Control.Proxy.Safe: throw :: (Monad m, Proxy p, Exception e) => e -> ExceptionP p a' a b' b m r
- Control.Proxy.Safe: try :: CheckP p => p a' a b' b IO r -> ExceptionP p a' a b' b SafeIO r
- Control.Proxy.Safe: tryIO :: Proxy p => IO r -> ExceptionP p a' a b' b SafeIO r
- Control.Proxy.Safe: tryK :: CheckP p => (q -> p a' a b' b IO r) -> (q -> ExceptionP p a' a b' b SafeIO r)
- Control.Proxy.Safe: trySafeIO :: SafeIO e -> IO e
- Control.Proxy.Safe: trySaferIO :: SafeIO e -> IO e
- Control.Proxy.Safe: type ExceptionP = EitherP SomeException
- Control.Proxy.Safe: unsafeClose :: Proxy p => r -> ExceptionP p a' a b' b SafeIO r
- Control.Proxy.Safe: unsafeCloseD :: Proxy p => r -> ExceptionP p a' a b' b SafeIO r
- Control.Proxy.Safe: unsafeCloseU :: Proxy p => r -> ExceptionP p a' a b' b SafeIO r
+ 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

Files

Control/Proxy/Safe.hs view
@@ -1,577 +1,18 @@--- | Exception handling and resource management integrated with proxies--{-# LANGUAGE Rank2Types, CPP, KindSignatures #-}--module Control.Proxy.Safe (-    -- * Exception Handling-    -- $exceptionp-    module Control.Proxy.Trans.Either,-    module Exception,-    ExceptionP,-    throw,-    catch,-    handle,--    -- * Safe IO-    SafeIO,-    runSafeIO,-    runSaferIO,-    trySafeIO,-    trySaferIO,--    -- * Checked Exceptions-    -- $check-    CheckP(..),-    tryK,-    tryIO,--    -- * Finalization-    onAbort,-    finally,-    bracket,-    bracket_,-    bracketOnAbort,--    -- * Prompt Finalization-    -- $prompt-    unsafeCloseU,-    unsafeCloseD,-    unsafeClose-    ) where--import qualified Control.Exception as Ex-import Control.Exception as 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 Control.Proxy.Trans.Identity-import qualified Control.Proxy.Trans.Either as E-import qualified Control.Proxy.Trans.Reader as R-import Control.Proxy.Trans.Either hiding (throw, catch, handle)-import Data.IORef (IORef, newIORef, readIORef, writeIORef)-#if MIN_VERSION_base(4,6,0)-#else-import Prelude hiding (catch)-#endif--{- $exceptionp-    This library checks and stores all exceptions using the 'EitherP' proxy-    transformer.  The following 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' 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 registerK/register only because people rarely want to guard-   solely against premature termination.  Usually they also want to guard-   against exceptions, too.--    'registerK' 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 'registerK' and-    consider any violations of the above laws as bugs.--}-registerK- :: (Monad m, P.Proxy p)- => (forall x . SafeIO x -> m x)- -> IO ()- -> (b' -> p a' a b' b m r)- -> (b' -> p a' a b' b m r)-registerK morph h k =-    P.runIdentityK (P.hoistK morph up) >-> k >-> P.runIdentityK (P.hoistK morph dn)-  where-    dn b'0 = do-        b0 <- P.request b'0-        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 (h >> hd)-                    return hd-                a   <- P.request a'-                lift $ SafeIO $ lift $ writeIORef hdRef hd-                a'2 <- P.respond a-                up' a'2-        up' a'0--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 p = registerK morph h (\_ -> p) undefined-{- This is safe and there is a way that does not use 'undefined' if I slightly-   restructure the Proxy type class, but this will work for now. -}--{- $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.--}--{-| You can retroactively check all exceptions for proxies that implement-    'CheckP'.--    'try' is /almost/ a proxy morphism, which means that @tryK = (try .)@-    defines a functor that preserves five categories.  I say \"almost\" because-    it unmasks asynchronous exceptions for 'return'.  However, this does not-    affect the exception safety of this implementation.--    Functor between \'@K@\'leisli categories:--> tryK f >=> tryK g = tryK (f >=> g)->-> tryK return = return  -- Not true for asynchronous exceptions--    Functor between 'P.Proxy' categories:--> tryK f >-> tryK g = tryK (f >-> g)->-> tryK idT = idT--> tryK f >~> tryK g = tryK (f >~> g)-> -> tryK coidT = coidT--    Functor between \"request\" categories:--> tryK f \>\ tryK g = tryK (f \>\ g)->-> tryK request = request--    Functor between \"respond\" categories:--> tryK f />/ tryK g = tryK (f />/ g)->-> tryK respond = respond--}-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 (IdentityP p) where-    try = EitherP . IdentityP . runEitherP . try . 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 a 'P.Proxy' \'@K@\'leisli arrow-tryK- :: (CheckP p)- => (q -> p a' a b' b IO r) -> (q -> ExceptionP p a' a b' b SafeIO r)-tryK = (try .)--{-| Check all exceptions for an 'IO' action--> (tryIO .) f >=> (tryIO .) g = (tryIO .) (f >=> g)->-> (tryIO .) return = return  -- Not true for asynchronous exceptions--}-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'.--> do x <- onAbort morph fin m->    onAbort morph fin (f x)-> = onAbort morph fin $ do x <- m->                          f x->-> onAbort morph fin (return x) = return x--> 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.bracketOnAbort' 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:+{-| I recommend you use this module as the default entry point. -> p1 >-> ((falseSenseOfSecurity >-> request) >=> request)+    This module exports the entire library for convenience: -    @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.+    * "Control.Proxy.Safe.Core": All exception safety and resource management+      primitives -    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.+    * "Control.Proxy.Safe.Prelude": Prelude of managed proxies -} -{-| '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:+module Control.Proxy.Safe (+    -- * Modules+    module Control.Proxy.Safe.Core,+    module Control.Proxy.Safe.Prelude,+    ) where -> (producer >-> (takeB_ 10 >=> unsafeClose) >-> consumer) >=> later--}-unsafeClose :: (P.Proxy p) => r -> ExceptionP p a' a b' b SafeIO r-unsafeClose = unsafeCloseU P.>=> unsafeCloseD+import Control.Proxy.Safe.Core+import Control.Proxy.Safe.Prelude
+ Control/Proxy/Safe/Core.hs view
@@ -0,0 +1,551 @@+-- | Exception handling and resource management integrated with proxies++{-# LANGUAGE Rank2Types, CPP, KindSignatures #-}++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(..),+    tryK,+    tryIO,++    -- * Finalization+    onAbort,+    finally,+    bracket,+    bracket_,+    bracketOnAbort,++    -- * Prompt Finalization+    -- $prompt+    unsafeCloseU,+    unsafeCloseD,+    unsafeClose+    ) 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 Control.Proxy.Trans.Maybe (MaybeP(runMaybeP))+import qualified Control.Proxy.Trans.Either as E+import qualified Control.Proxy.Trans.Reader as R+import Control.Proxy.Trans.Either hiding (throw, catch, handle)+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.runIdentityK (P.hoistK morph up) ->> k) >>~ P.runIdentityK (P.hoistK 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 a 'P.Proxy' \'@K@\'leisli arrow+tryK+    :: (CheckP p)+    => (q -> p a' a b' b IO r) -> (q -> ExceptionP p a' a b' b SafeIO r)+tryK = (try .)++{-| Check all exceptions for an 'IO' action++    'tryIO' is a monad morphism:++> tryIO $ do x <- m  =  do x <- tryIO m+>            f x           tryIO (f x)+>+> tryIO (return x) = return x  -- Not true for asynchronous exceptions+-}+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
+ Control/Proxy/Safe/Prelude.hs view
@@ -0,0 +1,63 @@+-- | 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 view
@@ -54,7 +54,7 @@ > import System.IO >  > readFileS->  :: (Proxy p) => FilePath -> () -> Producer (ExceptionP p) String SafeIO ()+>     :: (Proxy p) => FilePath -> () -> Producer (ExceptionP p) String SafeIO () > readFileS file () = bracket id >     (do h <- openFile file ReadMode >         putStrLn $ "{File Open}"@@ -91,8 +91,8 @@     proxy to a \"managed\" proxy:  > tryK->  :: CheckP p->  => (q -> p a' a b' b IO r) -> q -> ExceptionP p a' a b' b SafeIO r +>     :: (CheckP p)+>     => (q -> p a' a b' b IO r) -> q -> ExceptionP p a' a b' b SafeIO r  > > tryK printer :: (CheckP p, Show a) => () -> Consumer (Exception p) a SafeIO r >@@ -173,13 +173,13 @@ > 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+>     :: (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 exception handling to recover from a file opening error:+    we could use exception handling to recover from a file opening error:  > import Prelude hiding (catch) -- if using base <= 4.5 >@@ -187,7 +187,7 @@ > openFileS () = (do >     tryIO $ putStrLn "Select a file:" >     file <- tryIO getLine->     readFileS file ())+>     readFileS file () ) >   `catch` (\e -> do >       tryIO $ print (e :: IOException) >       openFileS () )@@ -208,8 +208,8 @@     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+>      :: 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!>"@@ -253,7 +253,7 @@ >     forkIO $ do >         threadDelay 1000 >         killThread tID->     runSafeIO $ runProxy $ runEitherK $+>     trySafeIO $ runProxy $ runEitherK $ >         foreverK (readFileS "test.txt") >-> tryK printD  >>> main@@ -325,28 +325,31 @@ {- $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:+    proxy implementations and trivial proxy transformers:  > instance CheckP ProxyFast > instance CheckP ProxyCorrect > instance (CheckP p) => CheckP (IdentityP p) > instance (CheckP p) => CheckP (ReaderP   p) -    However, you actually can upgrade more sophisticated proxy transformer-    stacks.  I've relaxed the type signature of the 'PFunctor' type class to-    accept proxy morphisms that change the base monad, so now it accepts 'try'-    as a valid argument.  This means that you can use 'hoistP' as many times as-    necessary to target 'try' to the base proxy:+    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+>     :: (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, which are the same-    as the proxy transformer laws.  The documentation for 'try' lists the full-    set of equations, but the ones you should remember are:+    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:  > tryK (f >-> g) = tryK f >-> tryK g @@ -365,10 +368,10 @@     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 'IO' action.+    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-    upgrading proxies that have base monads other than 'IO'.  For now, you will+    'try'ing proxies that have base monads other than 'IO'.  For now, you will     have to rewrite the proxy if that happens. -} @@ -399,10 +402,10 @@     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+>     :: (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}"@@ -426,8 +429,8 @@     demand and trust that they finalize safely upon termination:  > files () = do->     readFileS "file1.txt" () -- 3 lines long->     readFileS "file2.txt" () -- 4 lines long+>     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
pipes-safe.cabal view
@@ -1,6 +1,6 @@ Name: pipes-safe-Version: 1.0.0-Cabal-Version: >=1.14.0+Version: 1.1.0+Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3 License-File: LICENSE@@ -29,17 +29,18 @@     .     Read @Control.Proxy.Safe.Tutorial@ for an introductory tutorial. Category: Control, Pipes, Proxies-Tested-With: GHC ==7.4.1 Source-Repository head     Type: git     Location: https://github.com/Gabriel439/Haskell-Pipes-Safe-Library  Library     Build-Depends:-        base >= 4 && < 5,-        transformers >= 0.2.0.0,-        pipes >= 3.1.0+        base         >= 4       && < 5  ,+        transformers >= 0.2.0.0 && < 0.4,+        pipes        >= 3.2.0   && < 3.3     Exposed-Modules:         Control.Proxy.Safe,+        Control.Proxy.Safe.Core,+        Control.Proxy.Safe.Prelude,         Control.Proxy.Safe.Tutorial-    Default-Language: Haskell98+    GHC-Options: -O2