{-# LANGUAGE CPP #-}
module RIO.Prelude.IO
  ( withLazyFile
  , withLazyFileUtf8
  , readFileBinary
  , writeFileBinary
  , readFileUtf8
  , writeFileUtf8
  , hPutBuilder
  ) where

import           RIO.Prelude.Reexports
import qualified Data.ByteString         as B
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy    as BL
import qualified Data.Text.Lazy          as TL
import qualified Data.Text.Lazy.IO       as TL
import qualified Data.Text.IO            as T
import           System.IO               (hSetEncoding, utf8)


-- | Lazily get the contents of a file. Unlike 'BL.readFile', this
-- ensures that if an exception is thrown, the file handle is closed
-- immediately.
withLazyFile :: MonadUnliftIO m => FilePath -> (BL.ByteString -> m a) -> m a
withLazyFile :: FilePath -> (ByteString -> m a) -> m a
withLazyFile FilePath
fp ByteString -> m a
inner = FilePath -> IOMode -> (Handle -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> IOMode -> (Handle -> m a) -> m a
withBinaryFile FilePath
fp IOMode
ReadMode ((Handle -> m a) -> m a) -> (Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ ByteString -> m a
inner (ByteString -> m a) -> (Handle -> m ByteString) -> Handle -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString)
-> (Handle -> IO ByteString) -> Handle -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ByteString
BL.hGetContents

-- | Lazily read a file in UTF8 encoding.
--
-- @since 0.1.13
withLazyFileUtf8 :: MonadUnliftIO m => FilePath -> (TL.Text -> m a) -> m a
withLazyFileUtf8 :: FilePath -> (Text -> m a) -> m a
withLazyFileUtf8 FilePath
fp Text -> m a
inner = FilePath -> IOMode -> (Handle -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> IOMode -> (Handle -> m a) -> m a
withFile FilePath
fp IOMode
ReadMode ((Handle -> m a) -> m a) -> (Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
  Text -> m a
inner (Text -> m a) -> m Text -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8 IO () -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO Text
TL.hGetContents Handle
h)

-- | Write a file in UTF8 encoding
--
-- This function will use OS-specific line ending handling.
writeFileUtf8 :: MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 :: FilePath -> Text -> m ()
writeFileUtf8 FilePath
fp Text
text = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> IOMode -> (Handle -> m a) -> m a
withFile FilePath
fp IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
  Handle -> Text -> IO ()
T.hPutStr Handle
h Text
text

hPutBuilder :: MonadIO m => Handle -> Builder -> m ()
hPutBuilder :: Handle -> Builder -> m ()
hPutBuilder Handle
h = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Builder -> IO ()) -> Builder -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Builder -> IO ()
BB.hPutBuilder Handle
h
{-# INLINE hPutBuilder #-}

-- | Same as 'B.readFile', but generalized to 'MonadIO'
readFileBinary :: MonadIO m => FilePath -> m ByteString
readFileBinary :: FilePath -> m ByteString
readFileBinary = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString)
-> (FilePath -> IO ByteString) -> FilePath -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
B.readFile

-- | Same as 'B.writeFile', but generalized to 'MonadIO'
writeFileBinary :: MonadIO m => FilePath -> ByteString -> m ()
writeFileBinary :: FilePath -> ByteString -> m ()
writeFileBinary FilePath
fp = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (ByteString -> IO ()) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString -> IO ()
B.writeFile FilePath
fp

-- | Read a file in UTF8 encoding, throwing an exception on invalid character
-- encoding.
--
-- This function will use OS-specific line ending handling.
readFileUtf8 :: MonadIO m => FilePath -> m Text
readFileUtf8 :: FilePath -> m Text
readFileUtf8 FilePath
fp = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> (Handle -> IO Text) -> IO Text
forall (m :: * -> *) a.
MonadUnliftIO m =>
FilePath -> IOMode -> (Handle -> m a) -> m a
withFile FilePath
fp IOMode
ReadMode ((Handle -> IO Text) -> IO Text) -> (Handle -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
  Handle -> IO Text
T.hGetContents Handle
h