{- SPDX-FileCopyrightText: 2020 Serokell <https://serokell.io/> - - SPDX-License-Identifier: MPL-2.0 -} ----------------------------------------------------------------------------- -- | -- -- Functions in this module will help you make your /executable/ work -- correctly with encodings of text files and standard handles. -- -- /Note: if you are developing a library, see "System.IO.Utf8"./ -- -- = Quick start -- -- Wrap a call to 'withUtf8' around your @main@: -- -- @ -- import Main.Utf8 (withUtf8) -- -- main :: IO () -- main = 'withUtf8' $ do -- putStrLn "Hello, мир!" -- @ -- -- Basically, this is all you have to do for a program that uses -- @stdin@ and @stdout@ to interact with the user. However, some -- programs read input from and write output to files and, -- at the same time, allow the user to redirect @stdin@ and @stdout@ -- instead of providing explicit file names. -- -- If this is the case for your executable, you should also wrap -- @Utf8.@'System.IO.Utf8.withHandle' around the code that passes -- the handle to a third-party library. It is not necessary to do -- when passing it to your own library, assuming that it follows -- the recommendations from the documentation of "System.IO.Utf8". module Main.Utf8 ( withUtf8 , withStdTerminalHandles ) where import Control.Exception.Safe (MonadMask, bracket) import Control.Monad.IO.Class (MonadIO, liftIO) import GHC.IO.Encoding (getLocaleEncoding, setLocaleEncoding, utf8) import System.IO (stderr, stdin, stdout) import System.IO.Utf8 (withTerminalHandle) -- | Make standard handles safe to write anything to them and change -- program-global default file handle encoding to UTF-8. -- -- This function will: -- -- 1. Adjust the encoding of 'stdin', 'stdout', and 'stderr' to -- enable transliteration, like 'withStdTerminalHandles' does. -- 2. Call 'setLocaleEncoding' to change the program-global locale -- encoding to UTF-8. -- 3. Undo everything when the wrapped action finishes. withUtf8 :: (MonadIO m, MonadMask m) => m r -> m r withUtf8 :: m r -> m r withUtf8 m r act = m r -> m r forall (m :: * -> *) r. (MonadIO m, MonadMask m) => m r -> m r withStdTerminalHandles (m r -> m r) -> m r -> m r forall a b. (a -> b) -> a -> b $ m TextEncoding -> (TextEncoding -> m ()) -> (TextEncoding -> m r) -> m r forall (m :: * -> *) a b c. MonadMask m => m a -> (a -> m b) -> (a -> m c) -> m c bracket (IO TextEncoding -> m TextEncoding forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO TextEncoding -> m TextEncoding) -> IO TextEncoding -> m TextEncoding forall a b. (a -> b) -> a -> b $ IO TextEncoding getLocaleEncoding IO TextEncoding -> IO () -> IO TextEncoding forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* TextEncoding -> IO () setLocaleEncoding TextEncoding utf8) (IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> (TextEncoding -> IO ()) -> TextEncoding -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . TextEncoding -> IO () setLocaleEncoding) (\TextEncoding _ -> m r act) -- | Make standard handles safe to write anything to them. -- -- This function will for each of 'stdin', 'stdout', 'stderr' do: -- -- 1. Tweak the existing encoding so that unrepresentable characters -- will get approximated (aka transliterated) by visually similar -- ones or question marks. -- 2. Restore the original encoding when the wrapped action finishes. -- -- Use this function only if you do not want to change the program-global -- locale encoding. Otherwise prefer 'withUtf8'. withStdTerminalHandles :: (MonadIO m, MonadMask m) => m r -> m r withStdTerminalHandles :: m r -> m r withStdTerminalHandles = Handle -> m r -> m r forall (m :: * -> *) r. (MonadIO m, MonadMask m) => Handle -> m r -> m r withTerminalHandle Handle stdin (m r -> m r) -> (m r -> m r) -> m r -> m r forall b c a. (b -> c) -> (a -> b) -> a -> c . Handle -> m r -> m r forall (m :: * -> *) r. (MonadIO m, MonadMask m) => Handle -> m r -> m r withTerminalHandle Handle stdout (m r -> m r) -> (m r -> m r) -> m r -> m r forall b c a. (b -> c) -> (a -> b) -> a -> c . Handle -> m r -> m r forall (m :: * -> *) r. (MonadIO m, MonadMask m) => Handle -> m r -> m r withTerminalHandle Handle stderr