-- SPDX-FileCopyrightText: 2002 The University Court of the University of Glasgow
--
-- SPDX-License-Identifier: LicenseRef-BSD-3-Clause-GHC

module Util.IO.GHC
  ( hSetTranslit
  ) where

import GHC.IO.Encoding (textEncodingName)
import System.IO (hGetEncoding, hSetEncoding, mkTextEncoding)


-- This function was copied (with slight modifications) from
-- <https://gitlab.haskell.org/ghc/ghc/blob/7105fb66a7bacf822f7f23028136f89ff5737d0e/libraries/ghc-boot/GHC/HandleEncoding.hs>

-- | 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 h :: 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 name :: String
name | Element String
'/' Element String -> String -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> 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]
++ "//TRANSLIT"
            Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
enc'
        _ -> IO ()
forall (f :: * -> *). Applicative f => f ()
pass