{-# LANGUAGE CPP #-}
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"
getCurrentCodePage :: IO DWORD
getCurrentCodePage :: IO DWORD
getCurrentCodePage = do
DWORD
conCP <- IO DWORD
getConsoleCP
if DWORD
conCP DWORD -> DWORD -> Bool
forall a. Ord a => a -> a -> Bool
> DWORD
0
then DWORD -> IO DWORD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DWORD
conCP
else IO DWORD
getACP
encodeMultiByte :: CodePage -> String -> String
encodeMultiByte :: DWORD -> String -> String
encodeMultiByte DWORD
cp = IO String -> String
forall a. IO a -> a
unsafeLocalState (IO String -> String) -> (String -> IO String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DWORD -> String -> IO String
encodeMultiByteIO DWORD
cp
encodeMultiByteIO :: CodePage -> String -> IO String
encodeMultiByteIO :: DWORD -> String -> IO String
encodeMultiByteIO DWORD
_ String
"" = String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
encodeMultiByteIO DWORD
cp String
wstr =
String -> (CWStringLen -> IO String) -> IO String
forall a. String -> (CWStringLen -> IO a) -> IO a
withCWStringLen String
wstr ((CWStringLen -> IO String) -> IO String)
-> (CWStringLen -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \(Ptr CWchar
cwstr,Int
len) -> do
CInt
mbchars' <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
failIfZero String
"WideCharToMultiByte" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ DWORD
-> DWORD
-> Ptr CWchar
-> CInt
-> LPSTR
-> CInt
-> LPSTR
-> LPBOOL
-> IO CInt
wideCharToMultiByte
DWORD
cp
DWORD
0
Ptr CWchar
cwstr
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
LPSTR
forall a. Ptr a
nullPtr CInt
0
LPSTR
forall a. Ptr a
nullPtr LPBOOL
forall a. Ptr a
nullPtr
Int -> (LPSTR -> IO String) -> IO String
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
mbchars') ((LPSTR -> IO String) -> IO String)
-> (LPSTR -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \LPSTR
mbstr -> do
CInt
mbchars <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
failIfZero String
"WideCharToMultiByte" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ DWORD
-> DWORD
-> Ptr CWchar
-> CInt
-> LPSTR
-> CInt
-> LPSTR
-> LPBOOL
-> IO CInt
wideCharToMultiByte
DWORD
cp
DWORD
0
Ptr CWchar
cwstr
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
LPSTR
mbstr CInt
mbchars'
LPSTR
forall a. Ptr a
nullPtr LPBOOL
forall a. Ptr a
nullPtr
CStringLen -> IO String
peekCAStringLen (LPSTR
mbstr,CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
mbchars)
foreign import WINDOWS_CCONV "WideCharToMultiByte"
wideCharToMultiByte
:: CodePage
-> DWORD
-> LPCWSTR
-> CInt
-> LPSTR
-> CInt
-> LPCSTR
-> LPBOOL
-> IO CInt
decodeMultiByte :: CodePage -> String -> String
decodeMultiByte :: DWORD -> String -> String
decodeMultiByte DWORD
cp = IO String -> String
forall a. IO a -> a
unsafeLocalState (IO String -> String) -> (String -> IO String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DWORD -> String -> IO String
decodeMultiByteIO DWORD
cp
decodeMultiByteIO :: CodePage -> String -> IO String
decodeMultiByteIO :: DWORD -> String -> IO String
decodeMultiByteIO = DWORD -> String -> IO String
stringToUnicode
{-# INLINE decodeMultiByteIO #-}