module Util.IO
  ( readFileUtf8
  , writeFileUtf8
  , appendFileUtf8
  , withEncoding
  , hSetTranslit
  ) where

import Data.Text.IO (hGetContents)
import GHC.IO.Encoding (textEncodingName)
import System.IO (TextEncoding, hGetEncoding, hSetBinaryMode, hSetEncoding, mkTextEncoding, utf8)

readFileUtf8 :: FilePath -> IO Text
readFileUtf8 :: FilePath -> IO Text
readFileUtf8 name :: FilePath
name =
  FilePath -> IOMode -> IO Handle
forall (m :: * -> *). MonadIO m => FilePath -> IOMode -> m Handle
openFile FilePath
name IOMode
ReadMode IO Handle -> (Handle -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \h :: Handle
h -> 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
hGetContents Handle
h

writeFileUtf8 :: Print text => FilePath -> text -> IO ()
writeFileUtf8 :: FilePath -> text -> IO ()
writeFileUtf8 name :: FilePath
name txt :: text
txt =
  FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> IOMode -> (Handle -> m a) -> m a
withFile FilePath
name IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => Handle -> a -> m ()
hPutStr Handle
h text
txt

appendFileUtf8 :: Print text => FilePath -> text -> IO ()
appendFileUtf8 :: FilePath -> text -> IO ()
appendFileUtf8 name :: FilePath
name txt :: text
txt =
  FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> IOMode -> (Handle -> m a) -> m a
withFile FilePath
name IOMode
AppendMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> text -> IO ()
forall a (m :: * -> *). (Print a, MonadIO m) => Handle -> a -> m ()
hPutStr Handle
h text
txt

withEncoding :: Handle -> TextEncoding -> IO () -> IO ()
withEncoding :: Handle -> TextEncoding -> IO () -> IO ()
withEncoding handle :: Handle
handle encoding :: TextEncoding
encoding action :: IO ()
action = do
  Maybe TextEncoding
mbInitialEncoding <- Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
handle
  IO () -> (() -> IO ()) -> (() -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (Handle -> TextEncoding -> IO ()
hSetEncoding Handle
handle TextEncoding
encoding)
    (\_ -> IO () -> (TextEncoding -> IO ()) -> Maybe TextEncoding -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Handle -> Bool -> IO ()
hSetBinaryMode Handle
handle Bool
True) (Handle -> TextEncoding -> IO ()
hSetEncoding Handle
handle) Maybe TextEncoding
mbInitialEncoding)
    (\_ -> IO ()
action)

-- This function was copied (with slight modifications) from
-- <https://gitlab.haskell.org/ghc/ghc/blob/7105fb66a7bacf822f7f23028136f89ff5737d0e/libraries/ghc-boot/GHC/HandleEncoding.hs>
--
-- © 2002 The University Court of the University of Glasgow
-- (original license: LicenseRef-BSD-3-Clause-TheUniversityCourtOfTheUniversityOfGlasgow)
-- | Change the character encoding of the given Handle to transliterate
-- on unsupported characters instead of throwing an exception.
hSetTranslit :: Handle -> IO ()
hSetTranslit :: Handle -> IO ()
hSetTranslit h :: Handle
h = do
    Maybe TextEncoding
menc <- Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
h
    case (TextEncoding -> FilePath) -> Maybe TextEncoding -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoding -> FilePath
textEncodingName Maybe TextEncoding
menc of
        Just name :: FilePath
name | Element FilePath
'/' Element FilePath -> FilePath -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
`notElem` FilePath
name -> do
            TextEncoding
enc' <- FilePath -> IO TextEncoding
mkTextEncoding (FilePath -> IO TextEncoding) -> FilePath -> IO TextEncoding
forall a b. (a -> b) -> a -> b
$ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "//TRANSLIT"
            Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
enc'
        _ -> IO ()
forall (f :: * -> *). Applicative f => f ()
pass