-- | 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 Data.Text.Encoding.Error (UnicodeException (..))
import qualified Data.Text.Encoding as TextEncoding

-- 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 :: forall base. Path base File -> IO Text
readFile Path base File
path =
    ByteString -> Text
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile (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 :: forall base. Path base File -> IO (Either ReadError Text)
tryReadFile Path base File
path =
    Either IOError ByteString -> Either ReadError Text
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadCatch m => m a -> m (Either IOError a)
Exception.tryIO (FilePath -> IO ByteString
BS.readFile (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) = forall a b. a -> Either a b
Left (IOError -> ReadError
ReadErrorIO IOError
e)
    f (Right ByteString
bs) = 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 :: forall base. Path base File -> Text -> IO ()
writeFile Path base File
path Text
text =
    FilePath -> ByteString -> IO ()
BS.writeFile (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 :: forall base. Path base File -> Text -> IO (Either IOError ())
tryWriteFile Path base File
path Text
text = forall (m :: * -> *) a. MonadCatch m => m a -> m (Either IOError a)
Exception.tryIO (forall base. Path base File -> Text -> IO ()
writeFile Path base File
path Text
text)

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