{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | Read and write UTF-8 text files.
module Path.Text.UTF8
  (
  -- * Reading
    readFile
  , tryReadFile
  , ReadError (..)
  -- * Writing
  , writeFile
  , tryWriteFile
  , WriteError
  -- * Re-exports
  , IOError
  , UnicodeException (DecodeError)
  , parseAbsFile
  , parseRelFile
  ) where

-- base
import Data.Either     (Either (..))
import Data.Functor    ((<$>))
import System.IO       (IO)
import System.IO.Error (IOError)

-- safe-exceptions
import qualified Control.Exception.Safe as Exception

-- bytestring
import qualified Data.ByteString as BS

-- text
import           Data.Text                (Text)
import qualified Data.Text.Encoding       as TextEncoding
import           Data.Text.Encoding.Error (UnicodeException (..))

-- path
import           Path (Path, parseAbsFile, parseRelFile)
import qualified Path

data ReadError
  = ReadErrorIO IOError
  | ReadErrorDecode UnicodeException

type WriteError = IOError

-- | Read the contents of a UTF-8 encoded text file.
--
-- May throw 'IOError' or 'UnicodeException'. To handle these errors in 'Either'
-- instead, use 'tryReadFile'.
readFile :: Path base Path.File -> IO Text
readFile :: Path base File -> IO Text
readFile Path base File
path =
  ByteString -> Text
f (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile (Path base File -> FilePath
forall b t. Path b t -> FilePath
Path.toFilePath Path base File
path)
  where
    f :: ByteString -> Text
f ByteString
bs = let !text :: Text
text = ByteString -> Text
TextEncoding.decodeUtf8 ByteString
bs in Text
text

-- | Read the contents of a UTF-8 encoded text file.
--
-- Any 'IOError' or 'UnicodeException' that occurs is caught and returned as a
-- 'ReadError' on the 'Left' side of the 'Either'. To throw these exceptions
-- instead, use 'readFile'.
tryReadFile :: Path base Path.File -> IO (Either ReadError Text)
tryReadFile :: Path base File -> IO (Either ReadError Text)
tryReadFile Path base File
path =
  Either IOError ByteString -> Either ReadError Text
f (Either IOError ByteString -> Either ReadError Text)
-> IO (Either IOError ByteString) -> IO (Either ReadError Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> IO (Either IOError ByteString)
forall (m :: * -> *) a. MonadCatch m => m a -> m (Either IOError a)
Exception.tryIO (FilePath -> IO ByteString
BS.readFile (Path base File -> FilePath
forall b t. Path b t -> FilePath
Path.toFilePath Path base File
path))
  where
    f :: Either IOError ByteString -> Either ReadError Text
f (Left IOError
e) = ReadError -> Either ReadError Text
forall a b. a -> Either a b
Left (IOError -> ReadError
ReadErrorIO IOError
e)
    f (Right ByteString
bs) = (UnicodeException -> ReadError)
-> Either UnicodeException Text -> Either ReadError Text
forall a a' b. (a -> a') -> Either a b -> Either a' b
first UnicodeException -> ReadError
ReadErrorDecode (ByteString -> Either UnicodeException Text
TextEncoding.decodeUtf8' ByteString
bs)

-- | Write text to a file in a UTF-8 encoding.
--
-- May throw 'IOError'. To handle this error in 'Either' instead, use
-- 'tryWriteFile'.
writeFile :: Path base Path.File -> Text -> IO ()
writeFile :: Path base File -> Text -> IO ()
writeFile Path base File
path Text
text =
  FilePath -> ByteString -> IO ()
BS.writeFile (Path base File -> FilePath
forall b t. Path b t -> FilePath
Path.toFilePath Path base File
path) (Text -> ByteString
TextEncoding.encodeUtf8 Text
text)

-- | Write text to a file in a UTF-8 encoding.
--
-- Any 'IOError' that occurs is caught and returned on the 'Left' side of the
-- 'Either'. To throw the exception instead, use 'writeFile'.
tryWriteFile :: Path base Path.File -> Text -> IO (Either WriteError ())
tryWriteFile :: Path base File -> Text -> IO (Either IOError ())
tryWriteFile Path base File
path Text
text =
  IO () -> IO (Either IOError ())
forall (m :: * -> *) a. MonadCatch m => m a -> m (Either IOError a)
Exception.tryIO (Path base File -> Text -> IO ()
forall base. Path base File -> Text -> IO ()
writeFile Path base File
path Text
text)

first :: (a -> a') -> Either a b -> Either a' b
first :: (a -> a') -> Either a b -> Either a' b
first a -> a'
f (Left a
x) = a' -> Either a' b
forall a b. a -> Either a b
Left (a -> a'
f a
x)
first a -> a'
_ (Right b
x) = b -> Either a' b
forall a b. b -> Either a b
Right b
x