-- | Input and output streams for files.
--
-- The functions in this file use \"with*\" or \"bracket\" semantics, i.e. they
-- open the supplied 'FilePath', run a user computation, and then close the
-- file handle. If you need more control over the lifecycle of the underlying
-- file descriptor resources, you are encouraged to use the functions from
-- "System.IO.Streams.Handle" instead.
module System.IO.Streams.File
  ( -- * File conversions
    withFileAsInput
  , withFileAsInputStartingAt
  , unsafeWithFileAsInputStartingAt
  , withFileAsOutput
  , withFileAsOutputExt
  ) where

------------------------------------------------------------------------------
import           Control.Monad              (unless)
import           Data.ByteString            (ByteString)
import           Data.Int                   (Int64)
import           System.IO                  (BufferMode (NoBuffering), IOMode (ReadMode, WriteMode), SeekMode (AbsoluteSeek), hSeek, hSetBuffering, withBinaryFile)
------------------------------------------------------------------------------
import           System.IO.Streams.Handle   (handleToInputStream, handleToOutputStream)
import           System.IO.Streams.Internal (InputStream, OutputStream)


------------------------------------------------------------------------------
-- | @'withFileAsInput' name act@ opens the specified file in \"read mode\" and
-- passes the resulting 'InputStream' to the computation @act@. The file will
-- be closed on exit from @withFileAsInput@, whether by normal termination or
-- by raising an exception.
--
-- If closing the file raises an exception, then /that/ exception will be
-- raised by 'withFileAsInput' rather than any exception raised by @act@.
withFileAsInput :: FilePath                          -- ^ file to open
                -> (InputStream ByteString -> IO a)  -- ^ function to run
                -> IO a
withFileAsInput :: FilePath -> (InputStream ByteString -> IO a) -> IO a
withFileAsInput = Int64 -> FilePath -> (InputStream ByteString -> IO a) -> IO a
forall a.
Int64 -> FilePath -> (InputStream ByteString -> IO a) -> IO a
withFileAsInputStartingAt Int64
0


------------------------------------------------------------------------------
-- | Like 'withFileAsInput', but seeks to the specified byte offset before
-- attaching the given file descriptor to the 'InputStream'.
withFileAsInputStartingAt
    :: Int64                             -- ^ starting index to seek to
    -> FilePath                          -- ^ file to open
    -> (InputStream ByteString -> IO a)  -- ^ function to run
    -> IO a
withFileAsInputStartingAt :: Int64 -> FilePath -> (InputStream ByteString -> IO a) -> IO a
withFileAsInputStartingAt Int64
idx FilePath
fp InputStream ByteString -> IO a
m = FilePath -> IOMode -> (Handle -> IO a) -> IO a
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fp IOMode
ReadMode Handle -> IO a
go
  where
    go :: Handle -> IO a
go Handle
h = do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int64
idx Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
idx
        Handle -> IO (InputStream ByteString)
handleToInputStream Handle
h IO (InputStream ByteString)
-> (InputStream ByteString -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputStream ByteString -> IO a
m


------------------------------------------------------------------------------
-- | Like 'withFileAsInputStartingAt', except that the 'ByteString' emitted by
-- the created 'InputStream' may reuse its buffer. You may only use this
-- function if you do not retain references to the generated bytestrings
-- emitted.
unsafeWithFileAsInputStartingAt
    :: Int64                             -- ^ starting index to seek to
    -> FilePath                          -- ^ file to open
    -> (InputStream ByteString -> IO a)  -- ^ function to run
    -> IO a
unsafeWithFileAsInputStartingAt :: Int64 -> FilePath -> (InputStream ByteString -> IO a) -> IO a
unsafeWithFileAsInputStartingAt = Int64 -> FilePath -> (InputStream ByteString -> IO a) -> IO a
forall a.
Int64 -> FilePath -> (InputStream ByteString -> IO a) -> IO a
withFileAsInputStartingAt


------------------------------------------------------------------------------
-- | Open a file for writing and  attaches an 'OutputStream' for you to write
-- to. The file will be closed on error or completion of your action.
withFileAsOutput
    :: FilePath                           -- ^ file to open
    -> (OutputStream ByteString -> IO a)  -- ^ function to run
    -> IO a
withFileAsOutput :: FilePath -> (OutputStream ByteString -> IO a) -> IO a
withFileAsOutput FilePath
f = FilePath
-> IOMode
-> BufferMode
-> (OutputStream ByteString -> IO a)
-> IO a
forall a.
FilePath
-> IOMode
-> BufferMode
-> (OutputStream ByteString -> IO a)
-> IO a
withFileAsOutputExt FilePath
f IOMode
WriteMode BufferMode
NoBuffering


------------------------------------------------------------------------------
-- | Like 'withFileAsOutput', but allowing you control over the output file
-- mode and buffering behaviour.
withFileAsOutputExt
    :: FilePath                           -- ^ file to open
    -> IOMode                             -- ^ mode to write in
    -> BufferMode                         -- ^ should we buffer the output?
    -> (OutputStream ByteString -> IO a)  -- ^ function to run
    -> IO a
withFileAsOutputExt :: FilePath
-> IOMode
-> BufferMode
-> (OutputStream ByteString -> IO a)
-> IO a
withFileAsOutputExt FilePath
fp IOMode
iomode BufferMode
buffermode OutputStream ByteString -> IO a
m = FilePath -> IOMode -> (Handle -> IO a) -> IO a
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fp IOMode
iomode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
buffermode
    Handle -> IO (OutputStream ByteString)
handleToOutputStream Handle
h IO (OutputStream ByteString)
-> (OutputStream ByteString -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= OutputStream ByteString -> IO a
m