    {-# LANGUAGE CPP #-}
    {-# LANGUAGE NamedFieldPuns #-}

    {-|
    Module:      System.IO.CodePage
    Copyright:   (C) 2016-2017 Ryan Scott
    License:     BSD-style (see the file LICENSE)
    Maintainer:  Ryan Scott
    Stability:   Provisional
    Portability: Portable

    Exports functions which adjust code pages on Windows, and do nothing on other
    operating systems.
    -}
    module System.IO.CodePage (
          -- * Adjusting 'CodePage's
          withCP65001
        , withCP1200
        , withCP1201
        , withCP12000
        , withCP12001
        , withCP1252
        , withCodePage
        , withCodePageOptions

          -- * Notable 'CodePage's
        , CodePage
        , cp65001
        , cp1200
        , cp1201
        , cp12000
        , cp12001
        , cp1252

          -- * 'Options'
        , Options
        , defaultOptions
          -- ** Record fields of 'Options'
        , chatty
        , nonWindowsBehavior

          -- ** 'NonWindowsBehavior'
        , NonWindowsBehavior
          -- ** Constructing '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

    -- | Sets the code page for an action to UTF-8 as necessary.
    withCP65001 :: IO a -> IO a
    withCP65001 :: forall a. IO a -> IO a
    withCP65001 = CodePage -> IO a -> IO a
    forall a. CodePage -> IO a -> IO a
    withCodePage CodePage
    cp65001

    -- | Sets the code page for an action to UTF-16LE as necessary.
    withCP1200 :: IO a -> IO a
    withCP1200 :: forall a. IO a -> IO a
    withCP1200 = CodePage -> IO a -> IO a
    forall a. CodePage -> IO a -> IO a
    withCodePage CodePage
    cp1200

    -- | Sets the code page for an action to UTF-16BE as necessary.
    withCP1201 :: IO a -> IO a
    withCP1201 :: forall a. IO a -> IO a
    withCP1201 = CodePage -> IO a -> IO a
    forall a. CodePage -> IO a -> IO a
    withCodePage CodePage
    cp1201

    -- | Sets the code page for an action to UTF-32LE as necessary.
    withCP12000 :: IO a -> IO a
    withCP12000 :: forall a. IO a -> IO a
    withCP12000 = CodePage -> IO a -> IO a
    forall a. CodePage -> IO a -> IO a
    withCodePage CodePage
    cp12000

    -- | Sets the code page for an action to UTF-32BE as necessary.
    withCP12001 :: IO a -> IO a
    withCP12001 :: forall a. IO a -> IO a
    withCP12001 = CodePage -> IO a -> IO a
    forall a. CodePage -> IO a -> IO a
    withCodePage CodePage
    cp12001

    -- | Sets the code page for an action to Latin1 as necessary.
    withCP1252 :: IO a -> IO a
    withCP1252 :: forall a. IO a -> IO a
    withCP1252 = CodePage -> IO a -> IO a
    forall a. CodePage -> IO a -> IO a
    withCodePage CodePage
    cp1252

    -- | Sets the code page for an action as necessary.
    --
    -- On operating systems besides Windows, this will make an effort to change
    -- the current 'TextEncoding' to something that is equivalent to the supplied
    -- 'CodePage'. Currently, the only supported 'CodePage's on non-Windows OSes
    -- are 'cp65001', 'cp1200', 'cp1201', 'cp12000', and 'cp12001'. Supplying any
    -- other 'CodePage' will result in a runtime error on non-Windows OSes. (If you
    -- would like to configure this behavior, use 'withCodePageOptions' instead.)
    withCodePage :: CodePage -> IO a -> IO a
    withCodePage :: forall a. CodePage -> IO a -> IO a
    withCodePage = Options -> CodePage -> IO a -> IO a
    forall a. Options -> CodePage -> IO a -> IO a
    withCodePageOptions Options
    defaultOptions

    -- | Sets the code page for an action as necessary. If the 'Bool' argument is 'True',
    -- this function will emit a warning to @stderr@ indicating that the code page has
    -- been changed. ('withCodePage' sets this argument to 'False'.)

    -- Taken from the stack codebase
    -- (https://github.com/commercialhaskell/stack/blob/21e517ba88b3c6bee475fb00ad95f280e7285a54/src/main/Main.hs#L82-L123)
    -- which is under a 3-clause BSD license
    withCodePageOptions :: Options -> CodePage -> IO a -> IO a
    withCodePageOptions :: forall a. Options -> CodePage -> IO a -> IO a
    withCodePageOptions (Options{Bool
    chatty :: Options -> Bool
    chatty :: Bool
    chatty, NonWindowsBehavior
    nonWindowsBehavior :: Options -> NonWindowsBehavior
    nonWindowsBehavior :: 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
          -- These are never used on non-Windows OSes,
          -- so their values are irrelevant
          let origCPI :: CodePage
    origCPI = CodePage
    0
              origCPO :: CodePage
    origCPO = CodePage
    0
    #endif
          mbOrigStdinEnc  <- Handle -> IO (Maybe TextEncoding)
    hGetEncoding Handle
    stdin
          mbOrigStdoutEnc <- hGetEncoding stdout
          mbOrigStderrEnc <- hGetEncoding stderr
    #if MIN_VERSION_base(4,5,0)
          origLocaleEnc   <- getLocaleEncoding
    #endif

          let expected     = (CodePage -> TextEncoding) -> CodePage -> TextEncoding
    codePageEncoding' CodePage -> TextEncoding
    fallback CodePage
    cp
              expectedName = TextEncoding -> String
    textEncodingName TextEncoding
    expected
              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
              -- Crude, but the best available option
              setInput  = (TextEncoding -> String) -> Maybe TextEncoding -> Maybe String
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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 = (TextEncoding -> String) -> Maybe TextEncoding -> Maybe String
    forall a b. (a -> b) -> Maybe a -> Maybe b
    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 = TextEncoding -> String
    textEncodingName TextEncoding
    origLocaleEnc String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    expectedName
    #endif
              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
                  | 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
    #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 (setInput, setOutput) of
              (Bool
    False, Bool
    False) -> () -> IO ()
    forall a. a -> IO a
    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"

          fixInput $ fixOutput $ fixLocale 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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    setConsoleOutputCP' :: CodePage -> IO ()
    setConsoleOutputCP' CodePage
    _ = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #endif