{- SPDX-FileCopyrightText: 2020 Serokell <https://serokell.io/>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

-- | "Data.Text.Lazy.IO" for the modern world.
--
-- Wrappers around simple file reading/writing functions from the
-- @text@ package that reset the handle encoding to UTF-8.
module Data.Text.Lazy.IO.Utf8
  ( readFile
  , writeFile
  ) where

import Prelude hiding (readFile, writeFile)

import Control.Exception.Safe (MonadMask)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Text.Lazy (Text)

import qualified Data.Text.Lazy.IO as T
import qualified System.IO as IO

import qualified System.IO.Utf8 as Utf8


-- | Like @readFile@, but assumes the file is encoded in UTF-8, regardless
-- of the current locale.
readFile :: MonadIO m => IO.FilePath -> m Text
readFile :: FilePath -> m Text
readFile FilePath
path = FilePath -> IOMode -> m Handle
forall (m :: * -> *). MonadIO m => FilePath -> IOMode -> m Handle
Utf8.openFile FilePath
path IOMode
IO.ReadMode m Handle -> (Handle -> m Text) -> m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> (Handle -> IO Text) -> Handle -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Text
T.hGetContents

-- | Like @writeFile@, but encodes the data in UTF-8, regardless
-- of the current locale.
writeFile :: (MonadIO m, MonadMask m) => IO.FilePath -> Text -> m ()
writeFile :: FilePath -> Text -> m ()
writeFile FilePath
path = FilePath -> IOMode -> (Handle -> m ()) -> m ()
forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
FilePath -> IOMode -> (Handle -> m r) -> m r
Utf8.withFile FilePath
path IOMode
IO.WriteMode ((Handle -> m ()) -> m ())
-> (Text -> Handle -> m ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 ()) -> Handle -> m ())
-> (Text -> Handle -> IO ()) -> Text -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> Text -> IO ()) -> Text -> Handle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> Text -> IO ()
T.hPutStr