    {-# 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 charactor 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 = do
        conCP <- 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 cp = unsafeLocalState . encodeMultiByteIO cp

    encodeMultiByteIO :: CodePage -> String -> IO String
    encodeMultiByteIO _ "" = return ""
      -- WideCharToMultiByte doesn't handle empty strings
    encodeMultiByteIO cp wstr =
      withCWStringLen wstr $ \(cwstr,len) -> do
        mbchars' <- failIfZero "WideCharToMultiByte" $ wideCharToMultiByte
                    cp
                    0
                    cwstr
                    (fromIntegral len)
                    nullPtr 0
                    nullPtr nullPtr
        -- mbchar' is the length of buffer required
        allocaArray (fromIntegral mbchars') $ \mbstr -> do
          mbchars <- failIfZero "WideCharToMultiByte" $ wideCharToMultiByte
                     cp
                     0
                     cwstr
                     (fromIntegral len)
                     mbstr mbchars'
                     nullPtr 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 cp = unsafeLocalState . decodeMultiByteIO cp

    -- | Because of `stringToUnicode` is unclear name, we use `decodeMultiByteIO`
    -- for alias of `stringToUnicode`.
    decodeMultiByteIO :: CodePage -> String -> IO String
    decodeMultiByteIO = stringToUnicode
    {-# INLINE decodeMultiByteIO #-}