{- |
   Module      : Streaming.With
   Description : with/bracket-style idioms for use with streaming
   Copyright   : Ivan Lazar Miljenovic
   License     : MIT
   Maintainer  : Ivan.Miljenovic@gmail.com



 -}
module Streaming.With
  ( -- * File-handling
    withFile
  , withBinaryFile
    -- ** Common file-handling cases
  , writeBinaryFile
  , appendBinaryFile
  , withBinaryFileContents
    -- ** Temporary files
  , withSystemTempFile
  , withTempFile
    -- *** Re-exports
    -- $tempreexports
  , withSystemTempDirectory
  , withTempDirectory
    -- * Re-exports
    -- $reexports
  , MonadMask
  , bracket
  ) where

import           Streaming.ByteString   (ByteStream)
import qualified Streaming.ByteString   as B

import           Control.Monad.Catch    (MonadMask, bracket)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           System.IO              (Handle, IOMode (..), hClose,
                                         openBinaryFile, openFile)
import           System.IO.Temp         (withSystemTempDirectory,
                                         withTempDirectory)
import qualified System.IO.Temp         as T

--------------------------------------------------------------------------------

-- | A lifted variant of 'System.IO.withFile'.
--
--   You almost definitely don't want to use this; instead, use
--   'withBinaryFile' in conjunction with "Streaming.ByteString".
withFile :: (MonadMask m, MonadIO m) => FilePath -> IOMode -> (Handle -> m r) -> m r
withFile :: FilePath -> IOMode -> (Handle -> m r) -> m r
withFile FilePath
fp IOMode
md = m Handle -> (Handle -> m ()) -> (Handle -> m r) -> m r
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
md)) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose)

-- | A lifted variant of 'System.IO.withBinaryFile'.
withBinaryFile :: (MonadMask m, MonadIO m) => FilePath -> IOMode -> (Handle -> m r) -> m r
withBinaryFile :: FilePath -> IOMode -> (Handle -> m r) -> m r
withBinaryFile FilePath
fp IOMode
md = m Handle -> (Handle -> m ()) -> (Handle -> m r) -> m r
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IOMode -> IO Handle
openBinaryFile FilePath
fp IOMode
md)) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose)

-- | Write to the specified file.
writeBinaryFile :: (MonadMask m, MonadIO m) => FilePath -> ByteStream m r -> m r
writeBinaryFile :: FilePath -> ByteStream m r -> m r
writeBinaryFile FilePath
fp = FilePath -> IOMode -> (Handle -> m r) -> m r
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
FilePath -> IOMode -> (Handle -> m r) -> m r
withBinaryFile FilePath
fp IOMode
WriteMode ((Handle -> m r) -> m r)
-> (ByteStream m r -> Handle -> m r) -> ByteStream m r -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> ByteStream m r -> m r)
-> ByteStream m r -> Handle -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> ByteStream m r -> m r
forall (m :: * -> *) r.
MonadIO m =>
Handle -> ByteStream m r -> m r
B.hPut

-- | Append to the specified file.
appendBinaryFile :: (MonadMask m, MonadIO m) => FilePath -> ByteStream m r -> m r
appendBinaryFile :: FilePath -> ByteStream m r -> m r
appendBinaryFile FilePath
fp = FilePath -> IOMode -> (Handle -> m r) -> m r
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
FilePath -> IOMode -> (Handle -> m r) -> m r
withBinaryFile FilePath
fp IOMode
AppendMode ((Handle -> m r) -> m r)
-> (ByteStream m r -> Handle -> m r) -> ByteStream m r -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> ByteStream m r -> m r)
-> ByteStream m r -> Handle -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> ByteStream m r -> m r
forall (m :: * -> *) r.
MonadIO m =>
Handle -> ByteStream m r -> m r
B.hPut

-- | Apply a function to the contents of the file.
--
--   Note that a different monadic stack is allowed for the
--   'ByteStream' input, as long as it later gets resolved to the
--   required output type (e.g. remove transformer).
withBinaryFileContents :: (MonadMask m, MonadIO m, MonadIO n) => FilePath
                          -> (ByteStream n () -> m r) -> m r
withBinaryFileContents :: FilePath -> (ByteStream n () -> m r) -> m r
withBinaryFileContents FilePath
fp ByteStream n () -> m r
f = FilePath -> IOMode -> (Handle -> m r) -> m r
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
FilePath -> IOMode -> (Handle -> m r) -> m r
withBinaryFile FilePath
fp IOMode
ReadMode (ByteStream n () -> m r
f (ByteStream n () -> m r)
-> (Handle -> ByteStream n ()) -> Handle -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ByteStream n ()
forall (m :: * -> *). MonadIO m => Handle -> ByteStream m ()
B.hGetContents)

--------------------------------------------------------------------------------

-- | /This is 'T.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
--   'T.getCanonicalTemporaryDirectory'.
--
--   @since 0.1.1.0
withSystemTempFile :: (MonadIO m, MonadMask m)
                   => String -- ^ File name template.  See 'T.openTempFile'
                   -> ((FilePath, Handle) -> m r)
                   -> m r
withSystemTempFile :: FilePath -> ((FilePath, Handle) -> m r) -> m r
withSystemTempFile FilePath
template = FilePath -> (FilePath -> Handle -> m r) -> m r
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
T.withSystemTempFile FilePath
template ((FilePath -> Handle -> m r) -> m r)
-> (((FilePath, Handle) -> m r) -> FilePath -> Handle -> m r)
-> ((FilePath, Handle) -> m r)
-> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, Handle) -> m r) -> FilePath -> Handle -> m r
forall a b c. ((a, b) -> c) -> a -> b -> c
curry

-- | /This is 'T.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
withTempFile :: (MonadIO m, MonadMask m)
             => FilePath -- ^ Temp dir to create the file in
             -> String   -- ^ File name template.  See
                         --   'T.openTempFile'.
             -> ((FilePath, Handle) -> m r)
             -> m r
withTempFile :: FilePath -> FilePath -> ((FilePath, Handle) -> m r) -> m r
withTempFile FilePath
dir FilePath
template = FilePath -> FilePath -> (FilePath -> Handle -> m r) -> m r
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> FilePath -> (FilePath -> Handle -> m a) -> m a
T.withTempFile FilePath
dir FilePath
template ((FilePath -> Handle -> m r) -> m r)
-> (((FilePath, Handle) -> m r) -> FilePath -> Handle -> m r)
-> ((FilePath, Handle) -> m r)
-> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, Handle) -> m r) -> FilePath -> Handle -> m r
forall a b c. ((a, b) -> c) -> a -> b -> c
curry

{- $tempreexports

These functions are re-exported from the
<http://hackage.haskell.org/package/temporary temporary> package as-is
as their structure already matches those found here.

@since 0.1.1.0

-}

--------------------------------------------------------------------------------

{- $reexports

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.

-}