{-# LANGUAGE LambdaCase #-}
module System.IO.Utf8
( withHandle
, withTerminalHandle
, setHandleEncoding
, setTerminalHandleEncoding
, openFile
, withFile
) where
import Control.Exception.Safe (MonadMask, bracket)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Functor (void)
import GHC.IO.Encoding (mkTextEncoding, utf8)
import qualified System.IO as IO
import System.IO.Utf8.Internal (EncodingAction (..), chooseBestEnc)
type EncRestoreAction m = IO.Handle -> m ()
hSetBestUtf8Enc
:: MonadIO m
=> (IO.Handle -> IO Bool)
-> IO.Handle
-> m (EncRestoreAction m)
hSetBestUtf8Enc :: forall (m :: * -> *).
MonadIO m =>
(Handle -> IO Bool) -> Handle -> m (EncRestoreAction m)
hSetBestUtf8Enc Handle -> IO Bool
hIsTerm Handle
h = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Handle -> IO (Maybe TextEncoding)
IO.hGetEncoding Handle
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle
-> (Handle -> IO Bool) -> Maybe TextEncoding -> IO EncodingAction
chooseBestEnc Handle
h Handle -> IO Bool
hIsTerm forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
EncodingAction
Keep -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Handle
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
ChangeFromTo TextEncoding
enc String
newName -> do
String -> IO TextEncoding
mkTextEncoding String
newName forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> TextEncoding -> IO ()
IO.hSetEncoding Handle
h
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> TextEncoding -> IO ()
IO.hSetEncoding TextEncoding
enc
setHandleEncoding :: MonadIO m => IO.Handle -> m ()
setHandleEncoding :: forall (m :: * -> *). MonadIO m => Handle -> m ()
setHandleEncoding = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadIO m =>
(Handle -> IO Bool) -> Handle -> m (EncRestoreAction m)
hSetBestUtf8Enc Handle -> IO Bool
IO.hIsTerminalDevice
withHandle :: (MonadIO m, MonadMask m) => IO.Handle -> m r -> m r
withHandle :: forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
Handle -> m r -> m r
withHandle Handle
h = forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (forall (m :: * -> *).
MonadIO m =>
(Handle -> IO Bool) -> Handle -> m (EncRestoreAction m)
hSetBestUtf8Enc Handle -> IO Bool
IO.hIsTerminalDevice Handle
h) (forall a b. (a -> b) -> a -> b
$ Handle
h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
setTerminalHandleEncoding :: MonadIO m => IO.Handle -> m ()
setTerminalHandleEncoding :: forall (m :: * -> *). MonadIO m => Handle -> m ()
setTerminalHandleEncoding = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadIO m =>
(Handle -> IO Bool) -> Handle -> m (EncRestoreAction m)
hSetBestUtf8Enc (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
withTerminalHandle :: (MonadIO m, MonadMask m) => IO.Handle -> m r -> m r
withTerminalHandle :: forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
Handle -> m r -> m r
withTerminalHandle Handle
h = forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (forall (m :: * -> *).
MonadIO m =>
(Handle -> IO Bool) -> Handle -> m (EncRestoreAction m)
hSetBestUtf8Enc (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) Handle
h) (forall a b. (a -> b) -> a -> b
$ Handle
h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
openFile :: MonadIO m => IO.FilePath -> IO.IOMode -> m IO.Handle
openFile :: forall (m :: * -> *). MonadIO m => String -> IOMode -> m Handle
openFile String
path IOMode
mode = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Handle
h <- String -> IOMode -> IO Handle
IO.openFile String
path IOMode
mode
Handle -> TextEncoding -> IO ()
IO.hSetEncoding Handle
h TextEncoding
utf8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
h
withFile
:: (MonadIO m, MonadMask m)
=> IO.FilePath -> IO.IOMode -> (IO.Handle -> m r) -> m r
withFile :: forall (m :: * -> *) r.
(MonadIO m, MonadMask m) =>
String -> IOMode -> (Handle -> m r) -> m r
withFile String
path IOMode
mode = forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (forall (m :: * -> *). MonadIO m => String -> IOMode -> m Handle
openFile String
path IOMode
mode) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
IO.hClose)