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)
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