{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
module System.IO.CodePage (
withCP65001
, withCP1200
, withCP1201
, withCP12000
, withCP12001
, withCP1252
, withCodePage
, withCodePageOptions
, CodePage
, cp65001
, cp1200
, cp1201
, cp12000
, cp12001
, cp1252
, Options
, defaultOptions
, chatty
, nonWindowsBehavior
, NonWindowsBehavior
, nonWindowsDoNothing
, nonWindowsFallbackCodePageEncoding
, defaultFallbackCodePageEncoding
) where
import Control.Exception (bracket_)
import Control.Monad (when)
import Data.Foldable (forM_)
import GHC.IO.Encoding (textEncodingName)
import System.IO ( TextEncoding, hGetEncoding, hPutStrLn, hSetEncoding
, stderr, stdin, stdout )
import System.IO.CodePage.Internal
#if MIN_VERSION_base(4,5,0)
import GHC.IO.Encoding (getLocaleEncoding, setLocaleEncoding)
#endif
#ifdef WINDOWS
import System.Win32.CodePage hiding (CodePage)
#endif
withCP65001 :: IO a -> IO a
withCP65001 :: IO a -> IO a
withCP65001 = CodePage -> IO a -> IO a
forall a. CodePage -> IO a -> IO a
withCodePage CodePage
cp65001
withCP1200 :: IO a -> IO a
withCP1200 :: IO a -> IO a
withCP1200 = CodePage -> IO a -> IO a
forall a. CodePage -> IO a -> IO a
withCodePage CodePage
cp1200
withCP1201 :: IO a -> IO a
withCP1201 :: IO a -> IO a
withCP1201 = CodePage -> IO a -> IO a
forall a. CodePage -> IO a -> IO a
withCodePage CodePage
cp1201
withCP12000 :: IO a -> IO a
withCP12000 :: IO a -> IO a
withCP12000 = CodePage -> IO a -> IO a
forall a. CodePage -> IO a -> IO a
withCodePage CodePage
cp12000
withCP12001 :: IO a -> IO a
withCP12001 :: IO a -> IO a
withCP12001 = CodePage -> IO a -> IO a
forall a. CodePage -> IO a -> IO a
withCodePage CodePage
cp12001
withCP1252 :: IO a -> IO a
withCP1252 :: IO a -> IO a
withCP1252 = CodePage -> IO a -> IO a
forall a. CodePage -> IO a -> IO a
withCodePage CodePage
cp1252
withCodePage :: CodePage -> IO a -> IO a
withCodePage :: CodePage -> IO a -> IO a
withCodePage = Options -> CodePage -> IO a -> IO a
forall a. Options -> CodePage -> IO a -> IO a
withCodePageOptions Options
defaultOptions
withCodePageOptions :: Options -> CodePage -> IO a -> IO a
withCodePageOptions :: Options -> CodePage -> IO a -> IO a
withCodePageOptions (Options{Bool
chatty :: Bool
chatty :: Options -> Bool
chatty, NonWindowsBehavior
nonWindowsBehavior :: NonWindowsBehavior
nonWindowsBehavior :: Options -> NonWindowsBehavior
nonWindowsBehavior}) CodePage
cp IO a
inner =
case NonWindowsBehavior
nonWindowsBehavior of
NonWindowsBehavior
NonWindowsDoNothing -> IO a
inner
NonWindowsFallbackCodePageEncoding CodePage -> TextEncoding
fallback -> do
#ifdef WINDOWS
origCPI <- getConsoleCP
origCPO <- getConsoleOutputCP
#else
let origCPI :: CodePage
origCPI = CodePage
0
origCPO :: CodePage
origCPO = CodePage
0
#endif
Maybe TextEncoding
mbOrigStdinEnc <- Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
stdin
Maybe TextEncoding
mbOrigStdoutEnc <- Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
stdout
Maybe TextEncoding
mbOrigStderrEnc <- Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
stderr
#if MIN_VERSION_base(4,5,0)
TextEncoding
origLocaleEnc <- IO TextEncoding
getLocaleEncoding
#endif
let expected :: TextEncoding
expected = (CodePage -> TextEncoding) -> CodePage -> TextEncoding
codePageEncoding' CodePage -> TextEncoding
fallback CodePage
cp
expectedName :: String
expectedName = TextEncoding -> String
textEncodingName TextEncoding
expected
warn :: String -> IO ()
warn String
typ = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
chatty (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Setting"
, String
typ
, String
" codepage to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CodePage -> String
forall a. Show a => a -> String
show CodePage
cp
, if String
expectedName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String
"CP" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CodePage -> String
forall a. Show a => a -> String
show CodePage
cp)
then String
""
else String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
expectedName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
]
#ifdef WINDOWS
setInput = origCPI /= cp
setOutput = origCPO /= cp
#else
setInput :: Bool
setInput = (TextEncoding -> String) -> Maybe TextEncoding -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoding -> String
textEncodingName Maybe TextEncoding
mbOrigStdinEnc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Maybe String
forall a. a -> Maybe a
Just String
expectedName
setOutput :: Bool
setOutput = (TextEncoding -> String) -> Maybe TextEncoding -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoding -> String
textEncodingName Maybe TextEncoding
mbOrigStdoutEnc Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Maybe String
forall a. a -> Maybe a
Just String
expectedName
#endif
#if MIN_VERSION_base(4,5,0)
setLocale :: Bool
setLocale = TextEncoding -> String
textEncodingName TextEncoding
origLocaleEnc String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
expectedName
#endif
fixInput :: IO c -> IO c
fixInput
| Bool
setInput = IO () -> IO () -> IO c -> IO c
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
(do
CodePage -> IO ()
setConsoleCP' CodePage
cp
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdin TextEncoding
expected
)
(do
CodePage -> IO ()
setConsoleCP' CodePage
origCPI
Maybe TextEncoding -> (TextEncoding -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe TextEncoding
mbOrigStdinEnc ((TextEncoding -> IO ()) -> IO ())
-> (TextEncoding -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdin
)
| Bool
otherwise = IO c -> IO c
forall a. a -> a
id
fixOutput :: IO c -> IO c
fixOutput
| Bool
setOutput = IO () -> IO () -> IO c -> IO c
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
(do
CodePage -> IO ()
setConsoleOutputCP' CodePage
cp
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdout TextEncoding
expected
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stderr TextEncoding
expected
)
(do
CodePage -> IO ()
setConsoleOutputCP' CodePage
origCPO
Maybe TextEncoding -> (TextEncoding -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe TextEncoding
mbOrigStdoutEnc ((TextEncoding -> IO ()) -> IO ())
-> (TextEncoding -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdout
Maybe TextEncoding -> (TextEncoding -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe TextEncoding
mbOrigStderrEnc ((TextEncoding -> IO ()) -> IO ())
-> (TextEncoding -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stderr
)
| Bool
otherwise = IO c -> IO c
forall a. a -> a
id
fixLocale :: IO c -> IO c
fixLocale
#if MIN_VERSION_base(4,5,0)
| Bool
setLocale
= IO () -> IO () -> IO c -> IO c
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
(do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
chatty (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
[ String
"Setting locale encoding to"
, String
expectedName
]
TextEncoding -> IO ()
setLocaleEncoding TextEncoding
expected)
(TextEncoding -> IO ()
setLocaleEncoding TextEncoding
origLocaleEnc)
| Bool
otherwise
#endif
= IO c -> IO c
forall a. a -> a
id
case (Bool
setInput, Bool
setOutput) of
(Bool
False, Bool
False) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Bool
True, Bool
True) -> String -> IO ()
warn String
""
(Bool
True, Bool
False) -> String -> IO ()
warn String
" input"
(Bool
False, Bool
True) -> String -> IO ()
warn String
" output"
IO a -> IO a
forall c. IO c -> IO c
fixInput (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ IO a -> IO a
forall c. IO c -> IO c
fixOutput (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ IO a -> IO a
forall c. IO c -> IO c
fixLocale IO a
inner
codePageEncoding' :: (CodePage -> TextEncoding) -> CodePage -> TextEncoding
#ifdef WINDOWS
codePageEncoding' _ = codePageEncoding
#else
codePageEncoding' :: (CodePage -> TextEncoding) -> CodePage -> TextEncoding
codePageEncoding' = (CodePage -> TextEncoding) -> CodePage -> TextEncoding
forall a. a -> a
id
#endif
setConsoleCP', setConsoleOutputCP' :: CodePage -> IO ()
#ifdef WINDOWS
setConsoleCP' = setConsoleCP
setConsoleOutputCP' = setConsoleOutputCP
#else
setConsoleCP' :: CodePage -> IO ()
setConsoleCP' CodePage
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
setConsoleOutputCP' :: CodePage -> IO ()
setConsoleOutputCP' CodePage
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif