{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Win32.NLS
-- Copyright   :  (c) Alastair Reid, 1997-2003
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>
-- Stability   :  provisional
-- Portability :  portable
--
-- A collection of FFI declarations for interfacing with Win32.
--
-----------------------------------------------------------------------------

module System.Win32.NLS  (
        module System.Win32.NLS,
#if MIN_VERSION_base(4,15,0)
        CodePage,
#endif

        -- defined in System.Win32.Types
        LCID, LANGID, SortID, SubLANGID, PrimaryLANGID,
        mAKELCID, lANGIDFROMLCID, sORTIDFROMLCID,
        mAKELANGID, pRIMARYLANGID, sUBLANGID
        ) where

import System.Win32.String (withTStringBufferLen)
import System.Win32.Types
import System.Win32.Utils (trySized)

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>))
#endif
import Control.Monad (when)
import Data.IORef (modifyIORef, newIORef, readIORef)
import Foreign
import Foreign.C
#if MIN_VERSION_base(4,15,0)
import GHC.IO.Encoding.CodePage (CodePage)
#endif
import Text.Printf (printf)

##include "windows_cconv.h"

-- Somewhere, WINVER and _WIN32_WINNT are being defined as less than 0x0600 -
-- that is, before Windows Vista. Support for Windows XP was dropped in
-- GHC 8.0.1 of May 2016. This forces them to be at least 0x0600.
#if WINVER < 0x0600
#undef WINVER
#define WINVER 0x0600
#endif
#if _WIN32_WINNT < 0x0600
#undef _WIN32_WINNT
#define _WIN32_WINNT 0x0600
#endif

#include <windows.h>
#include "alignment.h"
#include "errors.h"
#include "win32debug.h"
#include "winnls_compat.h"
#include "winnt_compat.h"

type NLS_FUNCTION = DWORD

#{enum LCID,
 , lOCALE_SYSTEM_DEFAULT = LOCALE_SYSTEM_DEFAULT
 , lOCALE_USER_DEFAULT   = LOCALE_USER_DEFAULT
 , lOCALE_NEUTRAL        = LOCALE_NEUTRAL
 }

foreign import WINDOWS_CCONV unsafe "windows.h ConvertDefaultLocale"
  convertDefaultLocale :: LCID -> IO LCID

-- ToDo: various enum functions.

#if !MIN_VERSION_base(4,15,0)
type CodePage = UINT
#endif

#{enum CodePage,
 , cP_ACP       = CP_ACP
 , cP_MACCP     = CP_MACCP
 , cP_OEMCP     = CP_OEMCP
 }

foreign import WINDOWS_CCONV unsafe "windows.h GetACP"
  getACP :: IO CodePage

foreign import WINDOWS_CCONV unsafe "windows.h SetThreadLocale"
  setThreadLocale :: LCID -> IO ()

type LCTYPE = UINT

-- The following locale information constants are excluded from the `enum` list
-- below, for the reason indicated:
-- LOCALE_IDIALINGCODE -- Introduced in Windows 10 but not supported. Synonym
                       -- for LOCALE_ICOUNTRY.
-- LOCALE_INEGATIVEPERCENT -- Introduced in Windows 7 but not supported.
-- LOCALE_IPOSITIVEPERCENT -- Introduced in Windows 7 but not supported.
-- LOCALE_IREADINGLAYOUT -- Introduced in Windows 7 but not supported.
-- LOCALE_SAM -- Introduced by Windows 10 but not supported. Synonyn for
              -- LOCALE_S1159.
-- LOCALE_SENGLISHDISPLAYNAME -- Introduced in Windows 7 but not supported.
-- LOCALE_SIETFLANGUAGE -- Not supported (deprecated from Windows Vista).
-- LOCALE_SNATIVEDISPLAYNAME -- Introduced in Windows 7 but not supported.
-- LOCALE_SNATIVELANGUAGENAME -- Introduced in Windows 7 but not supported.
-- LOCALE_SPERCENT -- Introduced in Windows 7 but not supported.
-- LOCALE_SPM -- Introduced in Windows 10 but not supported. Synonym for
              -- LOCALE_S2359.
-- LOCALE_SSHORTESTAM -- Not supported.
-- LOCALE_SSHORTESTPM -- Not supported.
-- LOCALE_SSHORTTIME -- Introduced in Windows 7 but not supported.

-- The following locale information constant is included in the list below, but
-- note:
-- LOCALE_IINTLCURRDIGITS -- Not supported by Windows 10, use
                          -- LOCALE_ICURRDIGITS.

#{enum LCTYPE,
 , lOCALE_FONTSIGNATURE = LOCALE_FONTSIGNATURE
 , lOCALE_ICALENDARTYPE = LOCALE_ICALENDARTYPE
 , lOCALE_ICENTURY      = LOCALE_ICENTURY
 , lOCALE_ICOUNTRY      = LOCALE_ICOUNTRY
 , lOCALE_ICURRDIGITS   = LOCALE_ICURRDIGITS
 , lOCALE_ICURRENCY     = LOCALE_ICURRENCY
 , lOCALE_IDATE         = LOCALE_IDATE
 , lOCALE_IDAYLZERO     = LOCALE_IDAYLZERO
 , lOCALE_IDEFAULTANSICODEPAGE = LOCALE_IDEFAULTANSICODEPAGE
 , lOCALE_IDEFAULTCODEPAGE = LOCALE_IDEFAULTCODEPAGE
 , lOCALE_IDEFAULTCOUNTRY = LOCALE_IDEFAULTCOUNTRY
 , lOCALE_IDEFAULTEBCDICCODEPAGE = LOCALE_IDEFAULTEBCDICCODEPAGE
 , lOCALE_IDEFAULTLANGUAGE = LOCALE_IDEFAULTLANGUAGE
 , lOCALE_IDEFAULTMACCODEPAGE = LOCALE_IDEFAULTMACCODEPAGE
 , lOCALE_IDIGITS       = LOCALE_IDIGITS
 , lOCALE_IDIGITSUBSTITUTION = LOCALE_IDIGITSUBSTITUTION
 , lOCALE_IFIRSTDAYOFWEEK = LOCALE_IFIRSTDAYOFWEEK
 , lOCALE_IFIRSTWEEKOFYEAR = LOCALE_IFIRSTWEEKOFYEAR
 , lOCALE_IGEOID        = LOCALE_IGEOID
 , lOCALE_IINTLCURRDIGITS = LOCALE_IINTLCURRDIGITS
 , lOCALE_ILANGUAGE     = LOCALE_ILANGUAGE
 , lOCALE_ILDATE        = LOCALE_ILDATE
 , lOCALE_ILZERO        = LOCALE_ILZERO
 , lOCALE_IMEASURE      = LOCALE_IMEASURE
 , lOCALE_IMONLZERO     = LOCALE_IMONLZERO
 , lOCALE_INEGCURR      = LOCALE_INEGCURR
 , lOCALE_INEGNUMBER    = LOCALE_INEGNUMBER
 , lOCALE_INEGSEPBYSPACE = LOCALE_INEGSEPBYSPACE
 , lOCALE_INEGSIGNPOSN   = LOCALE_INEGSIGNPOSN
 , lOCALE_INEGSYMPRECEDES = LOCALE_INEGSYMPRECEDES
 , lOCALE_IOPTIONALCALENDAR = LOCALE_IOPTIONALCALENDAR
 , lOCALE_PAPERSIZE     = LOCALE_IPAPERSIZE
 , lOCALE_IPOSSEPBYSPACE = LOCALE_IPOSSEPBYSPACE
 , lOCALE_IPOSSIGNPOSN  = LOCALE_IPOSSIGNPOSN
 , lOCALE_IPSSYMPRECEDES = LOCALE_IPOSSYMPRECEDES
 , lOCALE_ITIME         = LOCALE_ITIME
 , lOCALE_ITIMEMARKPOSN = LOCALE_ITIMEMARKPOSN
 , lOCALE_ITLZERO       = LOCALE_ITLZERO
 , lOCALE_RETURN_NUMBER = LOCALE_RETURN_NUMBER
 , lOCALE_S1159         = LOCALE_S1159
 , lOCALE_S2359         = LOCALE_S2359
 , lOCALE_SABBREVCTRYNAME = LOCALE_SABBREVCTRYNAME
 , lOCALE_SABBREVDAYNAME1 = LOCALE_SABBREVDAYNAME1
 , lOCALE_SABBREVDAYNAME2 = LOCALE_SABBREVDAYNAME2
 , lOCALE_SABBREVDAYNAME3 = LOCALE_SABBREVDAYNAME3
 , lOCALE_SABBREVDAYNAME4 = LOCALE_SABBREVDAYNAME4
 , lOCALE_SABBREVDAYNAME5 = LOCALE_SABBREVDAYNAME5
 , lOCALE_SABBREVDAYNAME6 = LOCALE_SABBREVDAYNAME6
 , lOCALE_SABBREVDAYNAME7 = LOCALE_SABBREVDAYNAME7
 , lOCALE_SABBREVLANGNAME = LOCALE_SABBREVLANGNAME
 , lOCALE_SABBREVMONTHNAME1 = LOCALE_SABBREVMONTHNAME1
 , lOCALE_SABBREVMONTHNAME2 = LOCALE_SABBREVMONTHNAME2
 , lOCALE_SABBREVMONTHNAME3 = LOCALE_SABBREVMONTHNAME3
 , lOCALE_SABBREVMONTHNAME4 = LOCALE_SABBREVMONTHNAME4
 , lOCALE_SABBREVMONTHNAME5 = LOCALE_SABBREVMONTHNAME5
 , lOCALE_SABBREVMONTHNAME6 = LOCALE_SABBREVMONTHNAME6
 , lOCALE_SABBREVMONTHNAME7 = LOCALE_SABBREVMONTHNAME7
 , lOCALE_SABBREVMONTHNAME8 = LOCALE_SABBREVMONTHNAME8
 , lOCALE_SABBREVMONTHNAME9 = LOCALE_SABBREVMONTHNAME9
 , lOCALE_SABBREVMONTHNAME10 = LOCALE_SABBREVMONTHNAME10
 , lOCALE_SABBREVMONTHNAME11 = LOCALE_SABBREVMONTHNAME11
 , lOCALE_SABBREVMONTHNAME12 = LOCALE_SABBREVMONTHNAME12
 , lOCALE_SABBREVMONTHNAME13 = LOCALE_SABBREVMONTHNAME13
 , lOCALE_SCONSOLEFALLBACKNAME = LOCALE_SCONSOLEFALLBACKNAME
 , lOCALE_SCURRENCY     = LOCALE_SCURRENCY
 , lOCALE_SDATE         = LOCALE_SDATE
 , lOCALE_SDAYNAME1     = LOCALE_SDAYNAME1
 , lOCALE_SDAYNAME2     = LOCALE_SDAYNAME2
 , lOCALE_SDAYNAME3     = LOCALE_SDAYNAME3
 , lOCALE_SDAYNAME4     = LOCALE_SDAYNAME4
 , lOCALE_SDAYNAME5     = LOCALE_SDAYNAME5
 , lOCALE_SDAYNAME6     = LOCALE_SDAYNAME6
 , lOCALE_SDAYNAME7     = LOCALE_SDAYNAME7
 , lOCALE_SDECIMAL      = LOCALE_SDECIMAL
 , lOCALE_SDURATION     = LOCALE_SDURATION
 , lOCALE_SENGCURRNAME  = LOCALE_SENGCURRNAME
 , lOCALE_SENGLISHCOUNTRYNAME = LOCALE_SENGLISHCOUNTRYNAME
 , lOCALE_SENGLISHLANGUAGENAME = LOCALE_SENGLISHLANGUAGENAME
 , lOCALE_SGROUPING     = LOCALE_SGROUPING
 , lOCALE_SINTLSYMBOL   = LOCALE_SINTLSYMBOL
 , lOCALE_SISO3166CTRYNAME = LOCALE_SISO3166CTRYNAME
 , lOCALE_SISO3166CTRYNAME2 = LOCALE_SISO3166CTRYNAME2
 , lOCALE_SISO639LANGNAME = LOCALE_SISO639LANGNAME
 , lOCALE_SISO639LANGNAME2 = LOCALE_SISO639LANGNAME2
 , lOCALE_SKEYBOARDSTOINSTALL = LOCALE_SKEYBOARDSTOINSTALL
 , lOCALE_SLIST         = LOCALE_SLIST
 , lOCALE_SLONGDATE     = LOCALE_SLONGDATE
 , lOCALE_SMONDECIMALSEP = LOCALE_SMONDECIMALSEP
 , lOCALE_SMONGROUPING  = LOCALE_SMONGROUPING
 , lOCALE_SMONTHNAME1   = LOCALE_SMONTHNAME1
 , lOCALE_SMONTHNAME2   = LOCALE_SMONTHNAME2
 , lOCALE_SMONTHNAME3   = LOCALE_SMONTHNAME3
 , lOCALE_SMONTHNAME4   = LOCALE_SMONTHNAME4
 , lOCALE_SMONTHNAME5   = LOCALE_SMONTHNAME5
 , lOCALE_SMONTHNAME6   = LOCALE_SMONTHNAME6
 , lOCALE_SMONTHNAME7   = LOCALE_SMONTHNAME7
 , lOCALE_SMONTHNAME8   = LOCALE_SMONTHNAME8
 , lOCALE_SMONTHNAME9   = LOCALE_SMONTHNAME9
 , lOCALE_SMONTHNAME10  = LOCALE_SMONTHNAME10
 , lOCALE_SMONTHNAME11  = LOCALE_SMONTHNAME11
 , lOCALE_SMONTHNAME12  = LOCALE_SMONTHNAME12
 , lOCALE_SMONTHNAME13  = LOCALE_SMONTHNAME13
 , lOCALE_SMONTHOUSANDSEP = LOCALE_SMONTHOUSANDSEP
 , lOCALE_SNAME         = LOCALE_SNAME
 , lOCALE_SNAN          = LOCALE_SNAN
 , lOCALE_SNATIVECOUNTRYNAME = LOCALE_SNATIVECOUNTRYNAME
 , lOCALE_SNATIVECURRNAME = LOCALE_SNATIVECURRNAME
 , lOCALE_SNATIVEDIGITS = LOCALE_SNATIVEDIGITS
 , lOCALE_SNEGATIVESIGN = LOCALE_SNEGATIVESIGN
 , lOCALE_SNEGINFINITY  = LOCALE_SNEGINFINITY
 , lOCALE_SPARENT       = LOCALE_SPARENT
 , lOCALE_SPOSINFINITY  = LOCALE_SPOSINFINITY
 , lOCALE_SPOSITIVESIGN = LOCALE_SPOSITIVESIGN
 , lOCALE_SSCRIPTS      = LOCALE_SSCRIPTS
 , lOCALE_SSHORTDATE    = LOCALE_SSHORTDATE
 , lOCALE_SSHORTESTDAYNAME1 = LOCALE_SSHORTESTDAYNAME1
 , lOCALE_SSHORTESTDAYNAME2 = LOCALE_SSHORTESTDAYNAME2
 , lOCALE_SSHORTESTDAYNAME3 = LOCALE_SSHORTESTDAYNAME3
 , lOCALE_SSHORTESTDAYNAME4 = LOCALE_SSHORTESTDAYNAME4
 , lOCALE_SSHORTESTDAYNAME5 = LOCALE_SSHORTESTDAYNAME5
 , lOCALE_SSHORTESTDAYNAME6 = LOCALE_SSHORTESTDAYNAME6
 , lOCALE_SSHORTESTDAYNAME7 = LOCALE_SSHORTESTDAYNAME7
 , lOCALE_SSORTNAME     = LOCALE_SSORTNAME
 , lOCALE_STHOUSAND     = LOCALE_STHOUSAND
 , lOCALE_STIME         = LOCALE_STIME
 , lOCALE_STIMEFORMAT   = LOCALE_STIMEFORMAT
 , lOCALE_SYEARMONTH    = LOCALE_SYEARMONTH
 }

-- |Type representing locale data
data LCData
  -- | Data in the form of a Unicode string.
  = LCTextualData !String
  -- | Data in the form of a number. See 'lOCAL_RETURN_NUMBER' and @LOCAL_I*@
  -- locate information constants.
  | LCNumericData !DWORD
  -- | Data in the fomr of a 'LOCALESIGNATURE'. See 'lOCAL_FONTSIGNATURE' locale
  -- information constant.
  | LCSignatureData !LOCALESIGNATURE
  deriving (Eq, Show)

data LOCALESIGNATURE = LOCALESIGNATURE
  { lsUsb :: !UnicodeSubsetBitfield
  , lsCsbDefault :: !DDWORD
  , lsCsbSupported :: !DDWORD
  } deriving (Eq, Show)

instance Storable LOCALESIGNATURE where
  sizeOf = const #{size LOCALESIGNATURE}
  alignment _ = #alignment LOCALESIGNATURE
  peek buf = do
    lsUsb'          <- (#peek LOCALESIGNATURE, lsUsb) buf
    lsCsbDefault'   <- (#peek LOCALESIGNATURE, lsCsbDefault) buf
    lsCsbSupported' <- (#peek LOCALESIGNATURE, lsCsbSupported) buf
    return $ LOCALESIGNATURE lsUsb' lsCsbDefault' lsCsbSupported'
  poke buf info = do
    (#poke LOCALESIGNATURE, lsUsb) buf (lsUsb info)
    (#poke LOCALESIGNATURE, lsCsbDefault) buf (lsCsbDefault info)
    (#poke LOCALESIGNATURE, lsCsbSupported) buf (lsCsbSupported info)

-- | Type representing 128-bit Unicode subset bitfields, as the @base@ package
-- does include a module exporting a 128-bit unsigned integer type.
data UnicodeSubsetBitfield = UnicodeSubsetBitfield
  { usbLow :: !DDWORD
  , usbHigh :: !DDWORD
  } deriving (Eq, Show)

instance Storable UnicodeSubsetBitfield where
  sizeOf _ = 2 * sizeOf (undefined :: DDWORD)
  alignment _ = alignment (undefined :: DWORD)
  peek buf = do
    usbLow'  <- (peekByteOff buf 0 :: IO DDWORD)
    usbHigh' <- (peekByteOff buf (sizeOf (undefined :: DDWORD)) :: IO DDWORD)
    return $ UnicodeSubsetBitfield usbLow' usbHigh'
  poke buf info = do
    pokeByteOff buf 0 (usbLow info)
    pokeByteOff buf (sizeOf (undefined :: DDWORD)) (usbHigh info)

getLocaleInfoEx :: Maybe String -> LCTYPE -> IO LCData
getLocaleInfoEx locale ty
  | ty == lOCALE_FONTSIGNATURE =
      getLocaleInfoEx' LCSignatureData localSigCharCount

  | ty .&. lOCALE_RETURN_NUMBER /= 0 =
      getLocaleInfoEx' LCNumericData dWORDCharCount

  | otherwise = maybeWith withTString locale $ \c_locale ->
      LCTextualData <$> trySized cFuncName (c_GetLocaleInfoEx c_locale ty)
 where
  cFuncName = "GetLocaleInfoEx"
  -- See https://docs.microsoft.com/en-us/windows/win32/api/winnls/nf-winnls-getlocaleinfoex
  localSigCharCount = (#size LOCALESIGNATURE) `div` (#size WCHAR)
  dWORDCharCount = (#size DWORD) `div` (#size WCHAR)

  getLocaleInfoEx' constructor bufSize = maybeWith withTString locale $
    \c_locale -> do
      value <- alloca $ \buf -> do
        _ <- failIfZero cFuncName
          $ c_GetLocaleInfoEx c_locale ty (castPtr buf) bufSize
        peek buf
      return $ constructor value

foreign import WINDOWS_CCONV unsafe "windows.h GetLocaleInfoEx"
  c_GetLocaleInfoEx :: LPCWSTR -> LCTYPE -> LPWSTR -> CInt -> IO CInt

setLocaleInfo :: LCID -> LCTYPE -> String -> IO ()
setLocaleInfo locale ty info =
  withTString info $ \ c_info ->
  failIfFalse_ "SetLocaleInfo" $ c_SetLocaleInfo locale ty c_info
foreign import WINDOWS_CCONV unsafe "windows.h SetLocaleInfoW"
  c_SetLocaleInfo :: LCID -> LCTYPE -> LPCTSTR -> IO Bool

type LCMapFlags = DWORD

#{enum LCMapFlags,
 , lCMAP_BYTEREV              = LCMAP_BYTEREV
 , lCMAP_FULLWIDTH            = LCMAP_FULLWIDTH
 , lCMAP_HALFWIDTH            = LCMAP_HALFWIDTH
 , lCMAP_HIRAGANA             = LCMAP_HIRAGANA
 , lCMAP_KATAKANA             = LCMAP_KATAKANA
 , lCMAP_LINGUISTIC_CASING    = LCMAP_LINGUISTIC_CASING
 , lCMAP_LOWERCASE            = LCMAP_LOWERCASE
 , lCMAP_SIMPLIFIED_CHINESE   = LCMAP_SIMPLIFIED_CHINESE
 , lCMAP_SORTKEY              = LCMAP_SORTKEY
 , lCMAP_TRADITIONAL_CHINESE  = LCMAP_TRADITIONAL_CHINESE
 , lCMAP_UPPERCASE            = LCMAP_UPPERCASE
 , lINGUISTIC_IGNORECASE      = LINGUISTIC_IGNORECASE
 , lINGUISTIC_IGNOREDIACRITIC = LINGUISTIC_IGNOREDIACRITIC
 , nORM_IGNORECASE            = NORM_IGNORECASE
 , nORM_IGNORENONSPACE        = NORM_IGNORENONSPACE
 , nORM_IGNOREKANATYPE        = NORM_IGNOREKANATYPE
 , nORM_IGNORESYMBOLS         = NORM_IGNORESYMBOLS
 , nORM_IGNOREWIDTH           = NORM_IGNOREWIDTH
 , nORM_LINGUISTIC_CASING     = NORM_LINGUISTIC_CASING
 , sORT_STRINGSORT            = SORT_STRINGSORT
 }

data NLSVERSIONINFOEX = NLSVERSIONINFOEX
  { dwNLSVersionInfoSize :: DWORD
  , dwNLSVersion :: DWORD
  , dwDefinedVersion :: DWORD
  , dwEffectiveId :: DWORD
  , guidCustomVersion :: GUID
  } deriving (Eq, Show)

instance Storable NLSVERSIONINFOEX where
  sizeOf = const #{size NLSVERSIONINFOEX}
  alignment _ = #alignment NLSVERSIONINFOEX
  peek buf = do
    dwNLSVersionInfoSize' <- (#peek NLSVERSIONINFOEX, dwNLSVersionInfoSize) buf
    dwNLSVersion' <- (#peek NLSVERSIONINFOEX, dwNLSVersion) buf
    dwDefinedVersion' <- (#peek NLSVERSIONINFOEX, dwDefinedVersion) buf
    dwEffectiveId' <- (#peek NLSVERSIONINFOEX, dwEffectiveId) buf
    guidCustomVersion' <- (#peek NLSVERSIONINFOEX, guidCustomVersion) buf
    return $ NLSVERSIONINFOEX dwNLSVersionInfoSize' dwNLSVersion'
               dwDefinedVersion' dwEffectiveId' guidCustomVersion'
  poke buf info = do
    (#poke NLSVERSIONINFOEX, dwNLSVersionInfoSize) buf
      (dwNLSVersionInfoSize info)
    (#poke NLSVERSIONINFOEX, dwNLSVersion) buf (dwNLSVersion info)
    (#poke NLSVERSIONINFOEX, dwDefinedVersion) buf (dwDefinedVersion info)
    (#poke NLSVERSIONINFOEX, dwEffectiveId) buf (dwEffectiveId info)
    (#poke NLSVERSIONINFOEX, guidCustomVersion) buf (guidCustomVersion info)

-- Based on the `UnpackedUUID` type of package `uuid-types`.
data GUID = GUID
  !Word32
  !Word16
  !Word16
  !Word8
  !Word8
  !Word8
  !Word8
  !Word8
  !Word8
  !Word8
  !Word8
  deriving (Eq)

instance Show GUID where
  show (GUID data1 data2 data3 b1 b2 b3 b4 b5 b6 b7 b8) =
    printf "{%.8x-%.4x-%.4x-%.2x%2x-%.2x%.2x%.2x%.2x%.2x%.2x}" data1 data2 data3 b1 b2 b3 b4 b5 b6 b7 b8

instance Storable GUID where
  sizeOf _ = 16
  alignment _ = 4
  peekByteOff p off = GUID
    <$> peekByteOff p off
    <*> peekByteOff p (off + 4)
    <*> peekByteOff p (off + 6)
    <*> peekByteOff p (off + 8)
    <*> peekByteOff p (off + 9)
    <*> peekByteOff p (off + 10)
    <*> peekByteOff p (off + 11)
    <*> peekByteOff p (off + 12)
    <*> peekByteOff p (off + 13)
    <*> peekByteOff p (off + 14)
    <*> peekByteOff p (off + 15)
  pokeByteOff p off (GUID data1 data2 data3 b1 b2 b3 b4 b5 b6 b7 b8) = do
    pokeByteOff p off data1
    pokeByteOff p (off + 4) data2
    pokeByteOff p (off + 6) data3
    pokeByteOff p (off + 8) b1
    pokeByteOff p (off + 9) b2
    pokeByteOff p (off + 10) b3
    pokeByteOff p (off + 11) b4
    pokeByteOff p (off + 12) b5
    pokeByteOff p (off + 13) b6
    pokeByteOff p (off + 14) b7
    pokeByteOff p (off + 15) b8

getNLSVersionEx :: Maybe String -> IO NLSVERSIONINFOEX
getNLSVersionEx locale = maybeWith withTString locale $ \c_locale ->
  with defaultVersionInfo $ \c_versionInfo -> do
    failIfFalse_ "GetNLSVersionEx" $
      c_GetNLSVersionEx function c_locale c_versionInfo
    peek c_versionInfo
 where
  function = #{const COMPARE_STRING}
  defaultVersionInfo = NLSVERSIONINFOEX
    { dwNLSVersionInfoSize = #{size NLSVERSIONINFOEX}
    , dwNLSVersion = 0
    , dwDefinedVersion = 0
    , dwEffectiveId = 0
    , guidCustomVersion = GUID 0 0 0 0 0 0 0 0 0 0 0
    }
foreign import WINDOWS_CCONV unsafe "windows.h GetNLSVersionEx"
  c_GetNLSVersionEx :: NLS_FUNCTION
                    -> LPCWSTR
                    -> Ptr NLSVERSIONINFOEX
                    -> IO Bool

lCMapStringEx :: Maybe String
              -> LCMapFlags
              -> String
              -> NLSVERSIONINFOEX
              -> IO String
lCMapStringEx locale flags src versionInfo =
  maybeWith withTString locale $ \c_locale ->
    withTStringLen src $ \(c_src, src_len) ->
      with versionInfo $ \c_versionInfo -> do
        let c_src_len = fromIntegral src_len
            c_func s l = c_LCMapStringEx c_locale
                                         flags
                                         c_src c_src_len
                                         s l
                                         c_versionInfo
                                         nullPtr -- Reserved, must be NULL
                                         0 -- Reserved, must be 0
        trySized "LCMapStringEx" c_func
foreign import WINDOWS_CCONV unsafe "windows.h LCMapStringEx"
  c_LCMapStringEx :: LPCWSTR
                  -> LCMapFlags
                  -> LPCWSTR
                  -> CInt
                  -> LPWSTR
                  -> CInt
                  -> Ptr NLSVERSIONINFOEX
                  -> LPVOID
                  -> LPARAM
                  -> IO CInt

lCMapString :: LCID -> LCMapFlags -> String -> Int -> IO String
lCMapString locale flags src dest_size =
  withTStringLen src $ \ (c_src, src_len) ->
  allocaArray dest_size $ \ c_dest -> do
  _ <- failIfZero "LCMapString" $
    c_LCMapString locale flags c_src src_len c_dest dest_size
  peekTString c_dest
foreign import WINDOWS_CCONV unsafe "windows.h LCMapStringW"
  c_LCMapString :: LCID -> LCMapFlags -> LPCTSTR -> Int -> LPCTSTR -> Int -> IO Int

type LocaleTestFlags = DWORD

#{enum LocaleTestFlags,
 , lCID_INSTALLED       = LCID_INSTALLED
 , lCID_SUPPORTED       = LCID_SUPPORTED
 }

isValidLocaleName :: Maybe String -> IO Bool
isValidLocaleName lpLocaleName =
  maybeWith withTString lpLocaleName c_IsValidLocaleName
foreign import WINDOWS_CCONV unsafe "windows.h IsValidLocaleName"
  c_IsValidLocaleName :: LPCWSTR -> IO Bool

foreign import WINDOWS_CCONV unsafe "windows.h IsValidLocale"
  isValidLocale :: LCID -> LocaleTestFlags -> IO Bool

type EnumLocalesFlag = DWORD

-- The following locale enumeration flag constants are excluded from the `enum`
-- list below, for the reason indicated:
-- LOCALE_NEUTRALDATA -- Introduced in Windows 7 but not supported.

#{enum EnumLocalesFlag,
 , lOCALE_ALL             = LOCALE_ALL
 , lOCALE_ALTERNATE_SORTS = LOCALE_ALTERNATE_SORTS
 , lOCALE_REPLACEMENT     = LOCALE_REPLACEMENT
 , lOCALE_SUPPLEMENTAL    = LOCALE_SUPPLEMENTAL
 , lOCALE_WINDOWS         = LOCALE_WINDOWS
 }

type LOCALE_ENUMPROCEX = LPWSTR -> EnumLocalesFlag -> LPARAM -> IO BOOL
foreign import WINDOWS_CCONV "wrapper"
  mkLOCALE_ENUMPROCEX :: LOCALE_ENUMPROCEX -> IO (FunPtr LOCALE_ENUMPROCEX)

enumSystemLocalesEx :: LOCALE_ENUMPROCEX -> EnumLocalesFlag -> LPARAM -> IO ()
enumSystemLocalesEx callback dwFlags lParam = do
  c_callback <- mkLOCALE_ENUMPROCEX callback
  failIfFalse_ "EnumSystemLocalesEx" $
    c_EnumSystemLocalesEx c_callback dwFlags lParam nullPtr
  freeHaskellFunPtr c_callback
foreign import WINDOWS_CCONV safe "windows.h EnumSystemLocalesEx"
  c_EnumSystemLocalesEx :: (FunPtr LOCALE_ENUMPROCEX)
                        -> DWORD
                        -> LPARAM
                        -> LPVOID
                        -> IO Bool

enumSystemLocalesEx' :: EnumLocalesFlag
                     -> Maybe Bool
                     -- ^ Maybe include (or exclude) replacement locales?
                     -> IO [String]
enumSystemLocalesEx' dwFlags mIsReplacement = do
  store <- newIORef []
  let localeEnumProcEx c_locale arg2 _ = do
        locale <- peekTString c_locale
        case mIsReplacement of
          Nothing -> modifyIORef store (locale:)
          Just isReplacement ->
            when (isReplacement == (arg2 .&. lOCALE_REPLACEMENT /= 0)) $
              modifyIORef store (locale:)
        return True
  enumSystemLocalesEx localeEnumProcEx dwFlags 0
  reverse <$> readIORef store

foreign import WINDOWS_CCONV unsafe "windows.h IsValidCodePage"
  isValidCodePage :: CodePage -> IO Bool

foreign import WINDOWS_CCONV unsafe "windows.h GetUserDefaultLCID"
  getUserDefaultLCID :: LCID

foreign import WINDOWS_CCONV unsafe "windows.h GetUserDefaultLangID"
  getUserDefaultLangID :: LANGID

-- #define LOCALE_NAME_INVARIANT L""
lOCALE_NAME_INVARIANT :: Maybe String
lOCALE_NAME_INVARIANT = Just ""

 -- #define LOCALE_NAME_SYSTEM_DEFAULT L"!x-sys-default-locale"
lOCALE_NAME_SYSTEM_DEFAULT :: Maybe String
lOCALE_NAME_SYSTEM_DEFAULT = Just "!x-sys-default-locale"

 -- #define LOCALE_NAME_USER_DEFAULT NULL
lOCALE_NAME_USER_DEFAULT :: Maybe String
lOCALE_NAME_USER_DEFAULT = Nothing

getUserDefaultLocaleName :: IO String
getUserDefaultLocaleName =
  getDefaultLocaleName "GetUserDefaultLocaleName" c_GetUserDefaultLocaleName
foreign import WINDOWS_CCONV unsafe "windows.h GetUserDefaultLocaleName"
  c_GetUserDefaultLocaleName :: LPWSTR -> CInt -> IO CInt

#{enum CInt,
 , lOCALE_NAME_MAX_LENGTH = LOCALE_NAME_MAX_LENGTH
 }

-- |Helper function for use with 'c_GetUserDefaultLocaleName' or
-- 'c_GetSystemDefaultLocaleName'. See 'getUserDefaultLocaleName' and
-- 'getSystemUserDefaultLocaleName'.
getDefaultLocaleName :: String -> (LPWSTR -> CInt -> IO CInt) -> IO String
getDefaultLocaleName cDefaultLocaleFuncName cDefaultLocaleFunc =
  withTStringBufferLen maxLength $ \(buf, len) -> do
    let c_len = fromIntegral len
    c_len' <- failIfZero cDefaultLocaleFuncName $
      cDefaultLocaleFunc buf c_len
    let len' = fromIntegral c_len'
    peekTStringLen (buf, len' - 1) -- Drop final null character
 where
  maxLength = fromIntegral lOCALE_NAME_MAX_LENGTH

foreign import WINDOWS_CCONV unsafe "windows.h GetThreadLocale"
  getThreadLocale :: IO LCID

foreign import WINDOWS_CCONV unsafe "windows.h GetSystemDefaultLCID"
  getSystemDefaultLCID :: LCID

foreign import WINDOWS_CCONV unsafe "windows.h GetSystemDefaultLangID"
  getSystemDefaultLangID :: LANGID

getSystemDefaultLocaleName :: IO String
getSystemDefaultLocaleName =
  getDefaultLocaleName "GetSystemDefaultLocaleName" c_GetSystemDefaultLocaleName
foreign import WINDOWS_CCONV unsafe "windows.h GetSystemDefaultLocaleName"
  c_GetSystemDefaultLocaleName :: LPWSTR -> CInt -> IO CInt

foreign import WINDOWS_CCONV unsafe "windows.h GetOEMCP"
  getOEMCP :: CodePage

#{enum PrimaryLANGID,
 , lANG_NEUTRAL         = LANG_NEUTRAL
 , lANG_BULGARIAN       = LANG_BULGARIAN
 , lANG_CHINESE         = LANG_CHINESE
 , lANG_CZECH           = LANG_CZECH
 , lANG_DANISH          = LANG_DANISH
 , lANG_GERMAN          = LANG_GERMAN
 , lANG_GREEK           = LANG_GREEK
 , lANG_ENGLISH         = LANG_ENGLISH
 , lANG_SPANISH         = LANG_SPANISH
 , lANG_FINNISH         = LANG_FINNISH
 , lANG_FRENCH          = LANG_FRENCH
 , lANG_HUNGARIAN       = LANG_HUNGARIAN
 , lANG_ICELANDIC       = LANG_ICELANDIC
 , lANG_ITALIAN         = LANG_ITALIAN
 , lANG_JAPANESE        = LANG_JAPANESE
 , lANG_KOREAN          = LANG_KOREAN
 , lANG_DUTCH           = LANG_DUTCH
 , lANG_NORWEGIAN       = LANG_NORWEGIAN
 , lANG_POLISH          = LANG_POLISH
 , lANG_PORTUGUESE      = LANG_PORTUGUESE
 , lANG_ROMANIAN        = LANG_ROMANIAN
 , lANG_RUSSIAN         = LANG_RUSSIAN
 , lANG_CROATIAN        = LANG_CROATIAN
 , lANG_SLOVAK          = LANG_SLOVAK
 , lANG_SWEDISH         = LANG_SWEDISH
 , lANG_TURKISH         = LANG_TURKISH
 , lANG_SLOVENIAN       = LANG_SLOVENIAN
 , lANG_ARABIC          = LANG_ARABIC
 , lANG_CATALAN         = LANG_CATALAN
 , lANG_HEBREW          = LANG_HEBREW
 , lANG_SERBIAN         = LANG_SERBIAN
 , lANG_ALBANIAN        = LANG_ALBANIAN
 , lANG_THAI            = LANG_THAI
 , lANG_URDU            = LANG_URDU
 , lANG_INDONESIAN      = LANG_INDONESIAN
 , lANG_BELARUSIAN      = LANG_BELARUSIAN
 , lANG_ESTONIAN        = LANG_ESTONIAN
 , lANG_LATVIAN         = LANG_LATVIAN
 , lANG_LITHUANIAN      = LANG_LITHUANIAN
 , lANG_FARSI           = LANG_FARSI
 , lANG_VIETNAMESE      = LANG_VIETNAMESE
 , lANG_ARMENIAN        = LANG_ARMENIAN
 , lANG_AZERI           = LANG_AZERI
 , lANG_BASQUE          = LANG_BASQUE
 , lANG_MACEDONIAN      = LANG_MACEDONIAN
 , lANG_AFRIKAANS       = LANG_AFRIKAANS
 , lANG_GEORGIAN        = LANG_GEORGIAN
 , lANG_FAEROESE        = LANG_FAEROESE
 , lANG_HINDI           = LANG_HINDI
 , lANG_MALAY           = LANG_MALAY
 , lANG_KAZAK           = LANG_KAZAK
 , lANG_SWAHILI         = LANG_SWAHILI
 , lANG_UZBEK           = LANG_UZBEK
 , lANG_TATAR           = LANG_TATAR
 , lANG_BENGALI         = LANG_BENGALI
 , lANG_PUNJABI         = LANG_PUNJABI
 , lANG_GUJARATI        = LANG_GUJARATI
 , lANG_ORIYA           = LANG_ORIYA
 , lANG_TAMIL           = LANG_TAMIL
 , lANG_TELUGU          = LANG_TELUGU
 , lANG_KANNADA         = LANG_KANNADA
 , lANG_MALAYALAM       = LANG_MALAYALAM
 , lANG_ASSAMESE        = LANG_ASSAMESE
 , lANG_MARATHI         = LANG_MARATHI
 , lANG_SANSKRIT        = LANG_SANSKRIT
 , lANG_KONKANI         = LANG_KONKANI
 , lANG_MANIPURI        = LANG_MANIPURI
 , lANG_SINDHI          = LANG_SINDHI
 , lANG_KASHMIRI        = LANG_KASHMIRI
 , lANG_NEPALI          = LANG_NEPALI
 }

#{enum SortID,
 , sORT_DEFAULT         = SORT_DEFAULT
 , sORT_JAPANESE_XJIS   = SORT_JAPANESE_XJIS
 , sORT_JAPANESE_UNICODE = SORT_JAPANESE_UNICODE
 , sORT_CHINESE_BIG5    = SORT_CHINESE_BIG5
 , sORT_CHINESE_UNICODE = SORT_CHINESE_UNICODE
 , sORT_KOREAN_KSC      = SORT_KOREAN_KSC
 , sORT_KOREAN_UNICODE  = SORT_KOREAN_UNICODE
 }

#{enum SubLANGID,
 , sUBLANG_NEUTRAL                      = SUBLANG_NEUTRAL
 , sUBLANG_DEFAULT                      = SUBLANG_DEFAULT
 , sUBLANG_SYS_DEFAULT                  = SUBLANG_SYS_DEFAULT
 , sUBLANG_CHINESE_TRADITIONAL          = SUBLANG_CHINESE_TRADITIONAL
 , sUBLANG_CHINESE_SIMPLIFIED           = SUBLANG_CHINESE_SIMPLIFIED
 , sUBLANG_CHINESE_HONGKONG             = SUBLANG_CHINESE_HONGKONG
 , sUBLANG_CHINESE_SINGAPORE            = SUBLANG_CHINESE_SINGAPORE
 , sUBLANG_DUTCH                        = SUBLANG_DUTCH
 , sUBLANG_DUTCH_BELGIAN                = SUBLANG_DUTCH_BELGIAN
 , sUBLANG_ENGLISH_US                   = SUBLANG_ENGLISH_US
 , sUBLANG_ENGLISH_UK                   = SUBLANG_ENGLISH_UK
 , sUBLANG_ENGLISH_AUS                  = SUBLANG_ENGLISH_AUS
 , sUBLANG_ENGLISH_CAN                  = SUBLANG_ENGLISH_CAN
 , sUBLANG_ENGLISH_NZ                   = SUBLANG_ENGLISH_NZ
 , sUBLANG_ENGLISH_EIRE                 = SUBLANG_ENGLISH_EIRE
 , sUBLANG_FRENCH                       = SUBLANG_FRENCH
 , sUBLANG_FRENCH_BELGIAN               = SUBLANG_FRENCH_BELGIAN
 , sUBLANG_FRENCH_CANADIAN              = SUBLANG_FRENCH_CANADIAN
 , sUBLANG_FRENCH_SWISS                 = SUBLANG_FRENCH_SWISS
 , sUBLANG_GERMAN                       = SUBLANG_GERMAN
 , sUBLANG_GERMAN_SWISS                 = SUBLANG_GERMAN_SWISS
 , sUBLANG_GERMAN_AUSTRIAN              = SUBLANG_GERMAN_AUSTRIAN
 , sUBLANG_ITALIAN                      = SUBLANG_ITALIAN
 , sUBLANG_ITALIAN_SWISS                = SUBLANG_ITALIAN_SWISS
 , sUBLANG_NORWEGIAN_BOKMAL             = SUBLANG_NORWEGIAN_BOKMAL
 , sUBLANG_NORWEGIAN_NYNORSK            = SUBLANG_NORWEGIAN_NYNORSK
 , sUBLANG_PORTUGUESE                   = SUBLANG_PORTUGUESE
 , sUBLANG_PORTUGUESE_BRAZILIAN         = SUBLANG_PORTUGUESE_BRAZILIAN
 , sUBLANG_SPANISH                      = SUBLANG_SPANISH
 , sUBLANG_SPANISH_MEXICAN              = SUBLANG_SPANISH_MEXICAN
 , sUBLANG_SPANISH_MODERN               = SUBLANG_SPANISH_MODERN
 , sUBLANG_ARABIC_SAUDI_ARABIA          = SUBLANG_ARABIC_SAUDI_ARABIA
 , sUBLANG_ARABIC_IRAQ                  = SUBLANG_ARABIC_IRAQ
 , sUBLANG_ARABIC_EGYPT                 = SUBLANG_ARABIC_EGYPT
 , sUBLANG_ARABIC_LIBYA                 = SUBLANG_ARABIC_LIBYA
 , sUBLANG_ARABIC_ALGERIA               = SUBLANG_ARABIC_ALGERIA
 , sUBLANG_ARABIC_MOROCCO               = SUBLANG_ARABIC_MOROCCO
 , sUBLANG_ARABIC_TUNISIA               = SUBLANG_ARABIC_TUNISIA
 , sUBLANG_ARABIC_OMAN                  = SUBLANG_ARABIC_OMAN
 , sUBLANG_ARABIC_YEMEN                 = SUBLANG_ARABIC_YEMEN
 , sUBLANG_ARABIC_SYRIA                 = SUBLANG_ARABIC_SYRIA
 , sUBLANG_ARABIC_JORDAN                = SUBLANG_ARABIC_JORDAN
 , sUBLANG_ARABIC_LEBANON               = SUBLANG_ARABIC_LEBANON
 , sUBLANG_ARABIC_KUWAIT                = SUBLANG_ARABIC_KUWAIT
 , sUBLANG_ARABIC_UAE                   = SUBLANG_ARABIC_UAE
 , sUBLANG_ARABIC_BAHRAIN               = SUBLANG_ARABIC_BAHRAIN
 , sUBLANG_ARABIC_QATAR                 = SUBLANG_ARABIC_QATAR
 , sUBLANG_AZERI_CYRILLIC               = SUBLANG_AZERI_CYRILLIC
 , sUBLANG_AZERI_LATIN                  = SUBLANG_AZERI_LATIN
 , sUBLANG_CHINESE_MACAU                = SUBLANG_CHINESE_MACAU
 , sUBLANG_ENGLISH_SOUTH_AFRICA         = SUBLANG_ENGLISH_SOUTH_AFRICA
 , sUBLANG_ENGLISH_JAMAICA              = SUBLANG_ENGLISH_JAMAICA
 , sUBLANG_ENGLISH_CARIBBEAN            = SUBLANG_ENGLISH_CARIBBEAN
 , sUBLANG_ENGLISH_BELIZE               = SUBLANG_ENGLISH_BELIZE
 , sUBLANG_ENGLISH_TRINIDAD             = SUBLANG_ENGLISH_TRINIDAD
 , sUBLANG_ENGLISH_PHILIPPINES          = SUBLANG_ENGLISH_PHILIPPINES
 , sUBLANG_ENGLISH_ZIMBABWE             = SUBLANG_ENGLISH_ZIMBABWE
 , sUBLANG_FRENCH_LUXEMBOURG            = SUBLANG_FRENCH_LUXEMBOURG
 , sUBLANG_FRENCH_MONACO                = SUBLANG_FRENCH_MONACO
 , sUBLANG_GERMAN_LUXEMBOURG            = SUBLANG_GERMAN_LUXEMBOURG
 , sUBLANG_GERMAN_LIECHTENSTEIN         = SUBLANG_GERMAN_LIECHTENSTEIN
 , sUBLANG_KASHMIRI_INDIA               = SUBLANG_KASHMIRI_INDIA
 , sUBLANG_KOREAN                       = SUBLANG_KOREAN
 , sUBLANG_LITHUANIAN                   = SUBLANG_LITHUANIAN
 , sUBLANG_MALAY_MALAYSIA               = SUBLANG_MALAY_MALAYSIA
 , sUBLANG_MALAY_BRUNEI_DARUSSALAM      = SUBLANG_MALAY_BRUNEI_DARUSSALAM
 , sUBLANG_NEPALI_INDIA                 = SUBLANG_NEPALI_INDIA
 , sUBLANG_SERBIAN_LATIN                = SUBLANG_SERBIAN_LATIN
 , sUBLANG_SERBIAN_CYRILLIC             = SUBLANG_SERBIAN_CYRILLIC
 , sUBLANG_SPANISH_GUATEMALA            = SUBLANG_SPANISH_GUATEMALA
 , sUBLANG_SPANISH_COSTA_RICA           = SUBLANG_SPANISH_COSTA_RICA
 , sUBLANG_SPANISH_PANAMA               = SUBLANG_SPANISH_PANAMA
 , sUBLANG_SPANISH_DOMINICAN_REPUBLIC   = SUBLANG_SPANISH_DOMINICAN_REPUBLIC
 , sUBLANG_SPANISH_VENEZUELA            = SUBLANG_SPANISH_VENEZUELA
 , sUBLANG_SPANISH_COLOMBIA             = SUBLANG_SPANISH_COLOMBIA
 , sUBLANG_SPANISH_PERU                 = SUBLANG_SPANISH_PERU
 , sUBLANG_SPANISH_ARGENTINA            = SUBLANG_SPANISH_ARGENTINA
 , sUBLANG_SPANISH_ECUADOR              = SUBLANG_SPANISH_ECUADOR
 , sUBLANG_SPANISH_CHILE                = SUBLANG_SPANISH_CHILE
 , sUBLANG_SPANISH_URUGUAY              = SUBLANG_SPANISH_URUGUAY
 , sUBLANG_SPANISH_PARAGUAY             = SUBLANG_SPANISH_PARAGUAY
 , sUBLANG_SPANISH_BOLIVIA              = SUBLANG_SPANISH_BOLIVIA
 , sUBLANG_SPANISH_EL_SALVADOR          = SUBLANG_SPANISH_EL_SALVADOR
 , sUBLANG_SPANISH_HONDURAS             = SUBLANG_SPANISH_HONDURAS
 , sUBLANG_SPANISH_NICARAGUA            = SUBLANG_SPANISH_NICARAGUA
 , sUBLANG_SPANISH_PUERTO_RICO          = SUBLANG_SPANISH_PUERTO_RICO
 , sUBLANG_SWEDISH                      = SUBLANG_SWEDISH
 , sUBLANG_SWEDISH_FINLAND              = SUBLANG_SWEDISH_FINLAND
 , sUBLANG_URDU_PAKISTAN                = SUBLANG_URDU_PAKISTAN
 , sUBLANG_URDU_INDIA                   = SUBLANG_URDU_INDIA
 , sUBLANG_UZBEK_LATIN                  = SUBLANG_UZBEK_LATIN
 , sUBLANG_UZBEK_CYRILLIC               = SUBLANG_UZBEK_CYRILLIC
 }

-- , SUBLANG_LITHUANIAN_CLASSIC (not in mingw-20001111)

-- ----------------------------------------------------------------------------

-- | 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 `getConsoleCP`.

stringToUnicode :: CodePage -> String -> IO String
stringToUnicode _cp "" = return ""
     -- MultiByteToWideChar doesn't handle empty strings (#1929)
stringToUnicode cp mbstr =
  withCAStringLen mbstr $ \(cstr,len) -> do
    wchars <- failIfZero "MultiByteToWideChar" $ multiByteToWideChar
                cp
                0
                cstr
                (fromIntegral len)
                nullPtr 0
    -- wchars is the length of buffer required
    allocaArray (fromIntegral wchars) $ \cwstr -> do
      wchars' <- failIfZero "MultiByteToWideChar" $ multiByteToWideChar
                cp
                0
                cstr
                (fromIntegral len)
                cwstr wchars
      peekCWStringLen (cwstr,fromIntegral wchars')  -- converts UTF-16 to [Char]

foreign import WINDOWS_CCONV unsafe "MultiByteToWideChar"
  multiByteToWideChar
        :: CodePage
        -> DWORD   -- dwFlags,
        -> LPCSTR  -- lpMultiByteStr
        -> CInt    -- cbMultiByte
        -> LPWSTR  -- lpWideCharStr
        -> CInt    -- cchWideChar
        -> IO CInt
