base-4.15.0.0: GHC/IO/Windows/Encoding.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{- |
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 GHC.IO.Windows.Encoding
( encodeMultiByte
, encodeMultiByteIO
, encodeMultiByteRawIO
, decodeMultiByte
, decodeMultiByteIO
, wideCharToMultiByte
, multiByteToWideChar
, withGhcInternalToUTF16
, withUTF16ToGhcInternal
) where
import Data.Word (Word8, Word16)
import Foreign.C.Types (CInt(..))
import Foreign.C.String (peekCAStringLen, peekCWStringLen,
withCWStringLen, withCAStringLen, )
import Foreign.Ptr (nullPtr, Ptr ())
import Foreign.Marshal.Array (allocaArray)
import Foreign.Marshal.Unsafe (unsafeLocalState)
import GHC.Windows
import GHC.IO.Encoding.CodePage (CodePage, getCurrentCodePage)
import GHC.IO
import GHC.Base
import GHC.Real
#include "windows_cconv.h"
-- | 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
{-# INLINE encodeMultiByteIO' #-}
-- | String must not be zero length.
encodeMultiByteIO' :: CodePage -> String -> ((LPCSTR, CInt) -> IO a) -> IO a
encodeMultiByteIO' cp wstr transformer =
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
transformer (mbstr,fromIntegral mbchars)
-- converts [Char] to UTF-16
encodeMultiByteIO :: CodePage -> String -> IO String
encodeMultiByteIO _ "" = return ""
encodeMultiByteIO cp s = encodeMultiByteIO' cp s toString
where toString (st,l) = peekCAStringLen (st,fromIntegral l)
-- converts [Char] to UTF-16
encodeMultiByteRawIO :: CodePage -> String -> IO (LPCSTR, CInt)
encodeMultiByteRawIO _ "" = return (nullPtr, 0)
encodeMultiByteRawIO cp s = encodeMultiByteIO' cp s toSizedCString
where toSizedCString (st,l) = return (st, fromIntegral l)
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 `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
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 #-}
foreign import WINDOWS_CCONV unsafe "MultiByteToWideChar"
multiByteToWideChar'
:: CodePage
-> DWORD -- dwFlags,
-> Ptr Word8 -- lpMultiByteStr
-> CInt -- cbMultiByte
-> Ptr Word16 -- lpWideCharStr
-> CInt -- cchWideChar
-> IO CInt
-- TODO: GHC is internally UTF-32 which means we have re-encode for
-- Windows which is annoying. Switch to UTF-16 on IoNative
-- being default.
withGhcInternalToUTF16 :: Ptr Word8 -> Int -> ((Ptr Word16, CInt) -> IO a)
-> IO a
withGhcInternalToUTF16 ptr len fn
= do cp <- getCurrentCodePage
wchars <- failIfZero "withGhcInternalToUTF16" $
multiByteToWideChar' cp 0 ptr (fromIntegral len) nullPtr 0
-- wchars is the length of buffer required
allocaArray (fromIntegral wchars) $ \cwstr -> do
wchars' <- failIfZero "withGhcInternalToUTF16" $
multiByteToWideChar' cp 0 ptr (fromIntegral len) cwstr wchars
fn (cwstr, wchars')
foreign import WINDOWS_CCONV "WideCharToMultiByte"
wideCharToMultiByte'
:: CodePage
-> DWORD -- dwFlags,
-> Ptr Word16 -- lpWideCharStr
-> CInt -- cchWideChar
-> Ptr Word8 -- lpMultiByteStr
-> CInt -- cbMultiByte
-> LPCSTR -- lpMultiByteStr
-> LPBOOL -- lpbFlags
-> IO CInt
-- TODO: GHC is internally UTF-32 which means we have re-encode for
-- Windows which is annoying. Switch to UTF-16 on IoNative
-- being default.
-- | Decode a UTF16 buffer into the given buffer in the current code page.
-- The source UTF16 buffer is filled by the function given as argument.
withUTF16ToGhcInternal :: Ptr Word8 -- Buffer to store the encoded string in.
-> Int -- Length of the buffer
-- Function to fill source buffer.
-> ( CInt -- Size of available buffer in bytes
-> Ptr Word16 -- Temporary source buffer.
-> IO CInt -- Actual length of buffer content.
)
-> IO Int -- Returns number of bytes stored in buffer.
withUTF16ToGhcInternal ptr len fn
= do cp <- getCurrentCodePage
-- Annoyingly the IO system is very UTF-32 oriented and asks for bytes
-- as buffer reads. Problem is we don't know how many bytes we'll end up
-- having as UTF-32 MultiByte encoded UTF-16. So be conservative. We assume
-- that a single byte may expand to atmost 1 Word16. So assume that each
-- byte does and divide the requested number of bytes by two since each
-- Word16 encoded wchar may expand to only two Word8 sequences.
let reqBytes = fromIntegral (len `div` 2)
allocaArray reqBytes $ \w_ptr -> do
w_len <- fn (fromIntegral reqBytes) w_ptr
if w_len == 0
then return 0 else do
-- Get required length of encoding
mbchars' <- failIfZero "withUTF16ToGhcInternal" $
wideCharToMultiByte' cp 0 w_ptr
(fromIntegral w_len) nullPtr
0 nullPtr nullPtr
assert (mbchars' <= (fromIntegral len)) $ do
-- mbchar' is the length of buffer required
mbchars <- failIfZero "withUTF16ToGhcInternal" $
wideCharToMultiByte' cp 0 w_ptr
(fromIntegral w_len) ptr
mbchars' nullPtr nullPtr
return $ fromIntegral mbchars