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

   Maintainer  :  [email protected]
   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 #-}