streaming-with-0.2.2.0: with/bracket-style idioms for use with streaming

CopyrightIvan Lazar Miljenovic
LicenseMIT
MaintainerIvan.Miljenovic@gmail.com
Safe HaskellNone
LanguageHaskell2010

Streaming.With

Contents

Description

 

Synopsis

File-handling

withFile :: (MonadMask m, MonadIO m) => FilePath -> IOMode -> (Handle -> m r) -> m r Source #

A lifted variant of withFile.

You almost definitely don't want to use this; instead, use withBinaryFile in conjunction with Data.ByteString.Streaming.

withBinaryFile :: (MonadMask m, MonadIO m) => FilePath -> IOMode -> (Handle -> m r) -> m r Source #

A lifted variant of withBinaryFile.

Common file-handling cases

writeBinaryFile :: (MonadMask m, MonadIO m) => FilePath -> ByteString m r -> m r Source #

Write to the specified file.

appendBinaryFile :: (MonadMask m, MonadIO m) => FilePath -> ByteString m r -> m r Source #

Append to the specified file.

withBinaryFileContents :: (MonadMask m, MonadIO m, MonadIO n) => FilePath -> (ByteString n () -> m r) -> m r Source #

Apply a function to the contents of the file.

Note that a different monadic stack is allowed for the ByteString input, as long as it later gets resolved to the required output type (e.g. remove transformer).

Temporary files

withSystemTempFile Source #

Arguments

:: (MonadIO m, MonadMask m) 
=> String

File name template. See openTempFile

-> ((FilePath, Handle) -> m r) 
-> m r 

This is withSystemTempFile from the temporary package with the continuation re-structured to only take one argument.

Create and use a temporary file in the system standard temporary directory.

Behaves exactly the same as withTempFile, except that the parent temporary directory will be that returned by getCanonicalTemporaryDirectory.

Since: 0.1.1.0

withTempFile Source #

Arguments

:: (MonadIO m, MonadMask m) 
=> FilePath

Temp dir to create the file in

-> String

File name template. See openTempFile.

-> ((FilePath, Handle) -> m r) 
-> m r 

This is withTempFile from the temporary package with the continuation re-structured to only take one argument.

Use a temporary filename that doesn't already exist.

Creates a new temporary file inside the given directory, making use of the template. The temp file is deleted after use. For example:

withTempFile "src" "sdist." $ \(tmpFile, hFile) -> ...

The tmpFile will be file in the given directory, e.g. src/sdist.342.

Since: 0.1.1.0

Re-exports

These functions are re-exported from the temporary package as-is as their structure already matches those found here.

Since: 0.1.1.0

withSystemTempDirectory #

Arguments

:: (MonadIO m, MonadMask m) 
=> String

Directory name template

-> (FilePath -> m a)

Callback that can use the directory

-> m a 

Create and use a temporary directory in the system standard temporary directory.

Behaves exactly the same as withTempDirectory, except that the parent temporary directory will be that returned by getCanonicalTemporaryDirectory.

withTempDirectory #

Arguments

:: (MonadMask m, MonadIO m) 
=> FilePath

Parent directory to create the directory in

-> String

Directory name template

-> (FilePath -> m a)

Callback that can use the directory

-> m a 

Create and use a temporary directory inside the given directory.

The directory is deleted after use.

Re-exports

These may assist in writing your own bracket-style functions.

Note that not everything is re-exported: for example, Handle isn't re-exported for use with withFile as it's unlikely that you will write another wrapper around it, and furthermore it wouldn't be a common enough extension to warrant it.

class MonadCatch m => MonadMask (m :: * -> *) #

A class for monads which provide for the ability to account for all possible exit points from a computation, and to mask asynchronous exceptions. Continuation-based monads are invalid instances of this class.

Instances should ensure that, in the following code:

fg = f `finally` g

The action g is called regardless of what occurs within f, including async exceptions. Some monads allow f to abort the computation via other effects than throwing an exception. For simplicity, we will consider aborting and throwing an exception to be two forms of "throwing an error".

If f and g both throw an error, the error thrown by fg depends on which errors we're talking about. In a monad transformer stack, the deeper layers override the effects of the inner layers; for example, ExceptT e1 (Except e2) a represents a value of type Either e2 (Either e1 a), so throwing both an e1 and an e2 will result in Left e2. If f and g both throw an error from the same layer, instances should ensure that the error from g wins.

Effects other than throwing an error are also overriden by the deeper layers. For example, StateT s Maybe a represents a value of type s -> Maybe (a, s), so if an error thrown from f causes this function to return Nothing, any changes to the state which f also performed will be erased. As a result, g will see the state as it was before f. Once g completes, f's error will be rethrown, so g' state changes will be erased as well. This is the normal interaction between effects in a monad transformer stack.

By contrast, lifted-base's version of finally always discards all of g's non-IO effects, and g never sees any of f's non-IO effects, regardless of the layer ordering and regardless of whether f throws an error. This is not the result of interacting effects, but a consequence of MonadBaseControl's approach.

Minimal complete definition

mask, uninterruptibleMask, generalBracket

Instances

MonadMask IO 

Methods

mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b #

uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b #

generalBracket :: IO a -> (a -> ExitCase b -> IO c) -> (a -> IO b) -> IO (b, c) #

(~) * e SomeException => MonadMask (Either e)

Since: 0.8.3

Methods

mask :: ((forall a. Either e a -> Either e a) -> Either e b) -> Either e b #

uninterruptibleMask :: ((forall a. Either e a -> Either e a) -> Either e b) -> Either e b #

generalBracket :: Either e a -> (a -> ExitCase b -> Either e c) -> (a -> Either e b) -> Either e (b, c) #

MonadMask m => MonadMask (MaybeT m)

Since: 0.10.0

Methods

mask :: ((forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b) -> MaybeT m b #

uninterruptibleMask :: ((forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b) -> MaybeT m b #

generalBracket :: MaybeT m a -> (a -> ExitCase b -> MaybeT m c) -> (a -> MaybeT m b) -> MaybeT m (b, c) #

MonadMask m => MonadMask (ExceptT e m)

Since: 0.9.0

Methods

mask :: ((forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b) -> ExceptT e m b #

uninterruptibleMask :: ((forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b) -> ExceptT e m b #

generalBracket :: ExceptT e m a -> (a -> ExitCase b -> ExceptT e m c) -> (a -> ExceptT e m b) -> ExceptT e m (b, c) #

(Error e, MonadMask m) => MonadMask (ErrorT e m) 

Methods

mask :: ((forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b) -> ErrorT e m b #

uninterruptibleMask :: ((forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b) -> ErrorT e m b #

generalBracket :: ErrorT e m a -> (a -> ExitCase b -> ErrorT e m c) -> (a -> ErrorT e m b) -> ErrorT e m (b, c) #

MonadMask m => MonadMask (StateT s m) 

Methods

mask :: ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b #

uninterruptibleMask :: ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b #

generalBracket :: StateT s m a -> (a -> ExitCase b -> StateT s m c) -> (a -> StateT s m b) -> StateT s m (b, c) #

MonadMask m => MonadMask (StateT s m) 

Methods

mask :: ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b #

uninterruptibleMask :: ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b #

generalBracket :: StateT s m a -> (a -> ExitCase b -> StateT s m c) -> (a -> StateT s m b) -> StateT s m (b, c) #

(MonadMask m, Monoid w) => MonadMask (WriterT w m) 

Methods

mask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b #

uninterruptibleMask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b #

generalBracket :: WriterT w m a -> (a -> ExitCase b -> WriterT w m c) -> (a -> WriterT w m b) -> WriterT w m (b, c) #

(MonadMask m, Monoid w) => MonadMask (WriterT w m) 

Methods

mask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b #

uninterruptibleMask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b #

generalBracket :: WriterT w m a -> (a -> ExitCase b -> WriterT w m c) -> (a -> WriterT w m b) -> WriterT w m (b, c) #

MonadMask m => MonadMask (IdentityT * m) 

Methods

mask :: ((forall a. IdentityT * m a -> IdentityT * m a) -> IdentityT * m b) -> IdentityT * m b #

uninterruptibleMask :: ((forall a. IdentityT * m a -> IdentityT * m a) -> IdentityT * m b) -> IdentityT * m b #

generalBracket :: IdentityT * m a -> (a -> ExitCase b -> IdentityT * m c) -> (a -> IdentityT * m b) -> IdentityT * m (b, c) #

MonadMask m => MonadMask (ReaderT * r m) 

Methods

mask :: ((forall a. ReaderT * r m a -> ReaderT * r m a) -> ReaderT * r m b) -> ReaderT * r m b #

uninterruptibleMask :: ((forall a. ReaderT * r m a -> ReaderT * r m a) -> ReaderT * r m b) -> ReaderT * r m b #

generalBracket :: ReaderT * r m a -> (a -> ExitCase b -> ReaderT * r m c) -> (a -> ReaderT * r m b) -> ReaderT * r m (b, c) #

(MonadMask m, Monoid w) => MonadMask (RWST r w s m) 

Methods

mask :: ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b #

uninterruptibleMask :: ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b #

generalBracket :: RWST r w s m a -> (a -> ExitCase b -> RWST r w s m c) -> (a -> RWST r w s m b) -> RWST r w s m (b, c) #

(MonadMask m, Monoid w) => MonadMask (RWST r w s m) 

Methods

mask :: ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b #

uninterruptibleMask :: ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b #

generalBracket :: RWST r w s m a -> (a -> ExitCase b -> RWST r w s m c) -> (a -> RWST r w s m b) -> RWST r w s m (b, c) #

bracket :: MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b #

Generalized abstracted pattern of safe resource acquisition and release in the face of errors. The first action "acquires" some value, which is "released" by the second action at the end. The third action "uses" the value and its result is the result of the bracket.

If an error is thrown during the use, the release still happens before the error is rethrown.

Note that this is essentially a type-specialized version of generalBracket. This function has a more common signature (matching the signature from Control.Exception), and is often more convenient to use. By contrast, generalBracket is more expressive, allowing us to implement other functions like bracketOnError.