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 +0/−18
- Control/Proxy/Safe/Core.hs +0/−552
- Control/Proxy/Safe/Prelude.hs +0/−63
- Control/Proxy/Safe/Tutorial.hs +0/−486
- pipes-safe.cabal +17/−17
- src/Pipes/Safe.hs +399/−0
- src/Pipes/Safe/Prelude.hs +47/−0
− 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 #-}