-- | See GHC #10762 and #15021.
module GHC.HandleEncoding (configureHandleEncoding) where

import Prelude -- See note [Why do we import Prelude here?]
import GHC.IO.Encoding (textEncodingName)
import System.Environment
import System.IO

-- | Handle GHC-specific character encoding flags, allowing us to control how
-- GHC produces output regardless of OS.
configureHandleEncoding :: IO ()
configureHandleEncoding :: IO ()
configureHandleEncoding = do
   [([Char], [Char])]
env <- IO [([Char], [Char])]
getEnvironment
   case [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
lookup [Char]
"GHC_CHARENC" [([Char], [Char])]
env of
    Just [Char]
"UTF-8" -> do
     Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdout TextEncoding
utf8
     Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stderr TextEncoding
utf8
    Maybe [Char]
_ -> do
     -- Avoid GHC erroring out when trying to display unhandled characters
     Handle -> IO ()
hSetTranslit Handle
stdout
     Handle -> IO ()
hSetTranslit Handle
stderr

-- | 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 Handle
h = do
    Maybe TextEncoding
menc <- Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
h
    case (TextEncoding -> [Char]) -> Maybe TextEncoding -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap TextEncoding -> [Char]
textEncodingName Maybe TextEncoding
menc of
        Just [Char]
name | Char
'/' Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Foldable []
`notElem` [Char]
name -> do
            TextEncoding
enc' <- [Char] -> IO TextEncoding
mkTextEncoding ([Char] -> IO TextEncoding) -> [Char] -> IO TextEncoding
forall a b. (a -> b) -> a -> b
$ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"//TRANSLIT"
            Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
enc'
        Maybe [Char]
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return ()