{-# 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 #-}