    {-# LANGUAGE CPP #-}
    {- |
       Module      :  System.Win32.Encoding
       Copyright   :  2012 shelarcy
       License     :  BSD-style

       Maintainer  :  shelarcy@gmail.com
       Stability   :  Provisional
       Portability :  Non-portable (Win32 API)

       Enocode/Decode mutibyte character using Win32 API.
    -}

    module System.Win32.Encoding
      ( getCurrentCodePage
      , encodeMultiByte
      , encodeMultiByteIO
      , decodeMultiByte
      , decodeMultiByteIO
      , wideCharToMultiByte
      , multiByteToWideChar
      ) where

    import Foreign.C.Types        (CInt(..))
    import Foreign.C.String       (peekCAStringLen, withCWStringLen)
    import Foreign.Marshal.Array  (allocaArray)
    import Foreign.Marshal.Unsafe (unsafeLocalState)
    import System.Win32.Console
    import System.Win32.NLS
    import System.Win32.Types

    #include "windows_cconv.h"

    -- note CodePage = UInt which might not work on Win64.  But the Win32 package

    -- also has this issue.

    getCurrentCodePage :: IO DWORD
    getCurrentCodePage :: IO DWORD
    getCurrentCodePage = do
        conCP <- IO DWORD
    getConsoleCP
        if conCP > 0
            then return conCP
            else getACP

    -- | The "System.IO" output functions (e.g., `putStr`) don't

    -- automatically convert to multibyte string on Windows, so this

    -- function is provided to make the conversion from a Unicode string

    -- in the given code page to a proper multibyte string.  To get the

    -- code page for the console, use `getCurrentCodePage`.

    --

    encodeMultiByte :: CodePage -> String -> String
    encodeMultiByte :: DWORD -> String -> String
    encodeMultiByte DWORD
    cp = IO String -> String
    forall a. IO a -> a
    unsafeLocalState (IO String -> String) -> (String -> IO String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DWORD -> String -> IO String
    encodeMultiByteIO DWORD
    cp

    encodeMultiByteIO :: CodePage -> String -> IO String
    encodeMultiByteIO :: DWORD -> String -> IO String
    encodeMultiByteIO DWORD
    _ String
    "" = String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""
      -- WideCharToMultiByte doesn't handle empty strings

    encodeMultiByteIO DWORD
    cp String
    wstr =
      String -> (CWStringLen -> IO String) -> IO String
    forall a. String -> (CWStringLen -> IO a) -> IO a
    withCWStringLen String
    wstr ((CWStringLen -> IO String) -> IO String)
    -> (CWStringLen -> IO String) -> IO String
    forall a b. (a -> b) -> a -> b
    $ \(Ptr CWchar
    cwstr,Int
    len) -> do
        mbchars' <- String -> IO CInt -> IO CInt
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    failIfZero String
    "WideCharToMultiByte" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ DWORD
    -> DWORD
    -> Ptr CWchar
    -> CInt
    -> LPSTR
    -> CInt
    -> LPSTR
    -> LPBOOL
    -> IO CInt
    wideCharToMultiByte
                    DWORD
    cp
                    DWORD
    0
                    Ptr CWchar
    cwstr
                    (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len)
                    LPSTR
    forall a. Ptr a
    nullPtr CInt
    0
                    LPSTR
    forall a. Ptr a
    nullPtr LPBOOL
    forall a. Ptr a
    nullPtr
        -- mbchar' is the length of buffer required

        allocaArray (fromIntegral mbchars') $ \LPSTR
    mbstr -> do
          mbchars <- String -> IO CInt -> IO CInt
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    failIfZero String
    "WideCharToMultiByte" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ DWORD
    -> DWORD
    -> Ptr CWchar
    -> CInt
    -> LPSTR
    -> CInt
    -> LPSTR
    -> LPBOOL
    -> IO CInt
    wideCharToMultiByte
                     DWORD
    cp
                     DWORD
    0
                     Ptr CWchar
    cwstr
                     (Int -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len)
                     LPSTR
    mbstr CInt
    mbchars'
                     LPSTR
    forall a. Ptr a
    nullPtr LPBOOL
    forall a. Ptr a
    nullPtr
          peekCAStringLen (mbstr,fromIntegral mbchars)  -- converts [Char] to UTF-16

    foreign import WINDOWS_CCONV "WideCharToMultiByte"
      wideCharToMultiByte
            :: CodePage
            -> DWORD   -- dwFlags,

            -> LPCWSTR -- lpWideCharStr

            -> CInt    -- cchWideChar

            -> LPSTR   -- lpMultiByteStr

            -> CInt    -- cbMultiByte

            -> LPCSTR  -- lpMultiByteStr

            -> LPBOOL  -- lpbFlags

            -> IO CInt

    -- | The "System.IO" input functions (e.g. `getLine`) don't

    -- automatically convert to Unicode, so this function is provided to

    -- make the conversion from a multibyte string in the given code page

    -- to a proper Unicode string.  To get the code page for the console,

    -- use `getCurrentCodePage`.

    decodeMultiByte :: CodePage -> String -> String
    decodeMultiByte :: DWORD -> String -> String
    decodeMultiByte DWORD
    cp = IO String -> String
    forall a. IO a -> a
    unsafeLocalState (IO String -> String) -> (String -> IO String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DWORD -> String -> IO String
    decodeMultiByteIO DWORD
    cp

    -- | Because of `stringToUnicode` is unclear name, we use `decodeMultiByteIO`

    -- for alias of `stringToUnicode`.

    decodeMultiByteIO :: CodePage -> String -> IO String
    decodeMultiByteIO :: DWORD -> String -> IO String
    decodeMultiByteIO = DWORD -> String -> IO String
    stringToUnicode
    {-# INLINE decodeMultiByteIO #-}