module GHC.HandleEncoding (configureHandleEncoding) where
import Prelude
import GHC.IO.Encoding (textEncodingName)
import System.Environment
import System.IO
configureHandleEncoding :: IO ()
configureHandleEncoding :: IO ()
configureHandleEncoding = do
[(String, String)]
env <- IO [(String, String)]
getEnvironment
case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"GHC_CHARENC" [(String, String)]
env of
Just String
"UTF-8" -> do
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdout TextEncoding
utf8
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stderr TextEncoding
utf8
Maybe String
_ -> do
Handle -> IO ()
hSetTranslit Handle
stdout
Handle -> IO ()
hSetTranslit Handle
stderr
hSetTranslit :: Handle -> IO ()
hSetTranslit :: Handle -> IO ()
hSetTranslit Handle
h = do
Maybe TextEncoding
menc <- Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
h
case (TextEncoding -> String) -> Maybe TextEncoding -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoding -> String
textEncodingName Maybe TextEncoding
menc of
Just String
name | Char
'/' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
name -> do
TextEncoding
enc' <- String -> IO TextEncoding
mkTextEncoding (String -> IO TextEncoding) -> String -> IO TextEncoding
forall a b. (a -> b) -> a -> b
$ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"//TRANSLIT"
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
enc'
Maybe String
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()