タイトルは釣りです。副作用を起こしているのはHaskellから読んでいるCのライブラリです。
Win32 APIのWideCharToMultiByte、MultiByteToWideCharでUTF-16 ⇔ Shift-JIS 変換を行うには変換結果を格納するバッファを確保してそのポインタを引数に渡し、そのバッファに書き込まれた文字列を使用します。つまり、副作用によって結果を受け取っています。
Haskellで副作用が書けるのでしょうか? 普通に副作用が書けます。
ヌルポ(nullPtr)もあって、感心してしまいます。
- cstringToBSTR ではcSysAllocStringLenで確保したBSTR用のメモリの先頭アドレスをcMultiByteToWideCharに渡し、開きこまれたそのBSTR用のメモリの先頭アドレスを返しています。
- bstrToCString では mallocBytes でワイド文字列からC文字列に変換したときの長さ分の文字列領域を確保し、その先頭アドレスをcWideCharToMultiByteへ渡します。書き込まれたC文字列領域の先頭アドレスを返しています。
foreign importでCライブラリを型で安全に操作するための定義は値の内容にマッチさせます。それから、Cの関数を呼んだときに辻褄が合うように型を合わせないと fromIntegralを多用することになってしまいます。
-- ghc --make -Wall utf.hs -loleaut32 -o utf {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} module Main where import Foreign.Marshal.Alloc import Foreign.C.String import Foreign.C.Types import Foreign.Ptr #define CP_ACP 0 -- Shift-JISからUtf16への変換 shiftJisToUtf16 :: String -> IO String shiftJisToUtf16 string = do bstr <- withCString string cstringToBSTR str <- peekCWString bstr cSysFreeString bstr return str cstringToBSTR :: CString -> IO (Ptr CWchar) cstringToBSTR cstring = do -- C文字列長(1文字1バイト、2バイト混在) cstringlen <- cstrlen cstring -- UTF-16(1文字2バイト)の文字列長さを算出 out_size <- cMultiByteToWideChar CP_ACP 0 cstring cstringlen nullPtr 0 -- out_size分のメモリを確保した先頭アドレス wstr <- cSysAllocStringLen nullPtr out_size -- C文字列をUTF-16文字列に変換してwstrに書き込まれる。 _ <- cMultiByteToWideChar CP_ACP 0 cstring cstringlen wstr out_size -- 書き込まれたwstrを返す。 return wstr utf16ToShiftJis :: String -> IO String utf16ToShiftJis string = do cstring <- withCWString string bstrToCString str <- peekCString cstring free cstring return str bstrToCString :: Ptr CWchar -> IO CString bstrToCString bstr = do out_size <- cWideCharToMultiByte CP_ACP 0 bstr (-1) nullPtr 0 nullPtr nullPtr -- cstringにメモリを確保 cstring <- mallocBytes ((fromIntegral out_size) + 1):: IO (Ptr CChar) _ <- cWideCharToMultiByte CP_ACP 0 bstr (-1) cstring out_size nullPtr nullPtr -- 書き込まれたcstringを返す。 return cstring foreign import stdcall "windows.h SysFreeString" cSysFreeString :: Ptr CWchar -> IO () foreign import stdcall "windows.h SysAllocStringLen" cSysAllocStringLen :: Ptr CWchar -> CInt -> IO (Ptr CWchar) -- http://msdn.microsoft.com/ja-jp/library/cc448089.aspx foreign import stdcall "windows.h WideCharToMultiByte" cWideCharToMultiByte :: CUInt -> -- UINT CodePage, // コードページ CULong -> -- DWORD dwFlags, // 処理速度とマッピング方法を決定するフラグ Ptr CWchar -> -- LPCWSTR lpWideCharStr, // ワイド文字列のアドレス CInt -> -- int cchWideChar, // ワイド文字列の文字数 CString -> -- LPSTR lpMultiByteStr, // 新しい文字列を受け取るバッファのアドレス CInt -> -- int cchMultiByte, // 新しい文字列を受け取るバッファのサイズ CString -> -- LPCSTR lpDefaultChar, // マップできない文字の既定値のアドレス Ptr Int -> -- LPBOOL lpUsedDefaultChar //既定の文字を使ったときにセットするフラグのアドレス IO CInt -- http://msdn.microsoft.com/ja-jp/library/cc448053.aspx foreign import stdcall "windows.h MultiByteToWideChar" cMultiByteToWideChar :: CUInt -> -- UINT CodePage, // コードページ CULong -> -- DWORD dwFlags, // 文字の種類を指定するフラグ CString -> -- LPCSTR lpMultiByteStr, // マップ元文字列のアドレス CInt -> -- int cchMultiByte, // マップ元文字列のバイト数 Ptr CWchar -> -- LPWSTR lpWideCharStr, // マップ先ワイド文字列を入れるバッファのアドレス CInt -> -- int cchWideChar // バッファのサイズ IO CInt foreign import ccall "string.h strlen" cstrlen :: CString -> IO CInt foreign import ccall "stdio.h printf" cprintf :: CString -> IO () foreign import ccall "stdio.h printf" cprint2 :: CString -> CUInt -> CUInt -> IO () foreign import ccall "wchar.h wprintf" cwprintf :: CWString -> IO () foreign import ccall "wchar.h swprintf" cswprintf :: CWString -> CWString -> IO () main :: IO () main = do s <- utf16ToShiftJis "ﾏｯﾌﾟ先ワイド文字列を入れるバッファのaddress" u <- shiftJisToUtf16 s putStrLn =<< (utf16ToShiftJis u) -- PS C:\HaskellPlatform\test\utf8utf16> ./utf -- > ﾏｯﾌﾟ先ワイド文字列を入れるバッファのaddress
foreign import の ccall、stdcallは関数を呼ぶときの引数の渡し方です。これを書かなくても推測してくれないかと思いましたがリンクのときにWarningになるようです。
$ ghc --make -Wall utf.hs -loleaut32 -o utf [1 of 1] Compiling Main ( utf.hs, utf.o ) Linking utf.exe ... Warning: resolving _MultiByteToWideChar by linking to _MultiByteToWideChar@24 Use --enable-stdcall-fixup to disable these warnings Use --disable-stdcall-fixup to disable these fixups
こっちは本物の副作用です。
20131129 追記：Shift-JISをByteStringとするバージョン
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} import Foreign.Ptr import Foreign.C.String import Foreign.C.Types import Foreign.Marshal.Alloc import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString.Char8 as B data BSTR type BSTRobj = (Ptr BSTR) #define CP_ACP 0 -- ==================================================================== sjisToUtf16 :: B.ByteString -> String sjisToUtf16 = unsafePerformIO.shiftJisToUtf16' foreign import stdcall "windows.h SysAllocStringLen" cSysAllocStringLen :: BSTRobj -> CInt -> IO (Ptr CWchar) -- http://msdn.microsoft.com/ja-jp/library/cc448053.aspx foreign import stdcall "windows.h MultiByteToWideChar" cMultiByteToWideChar :: CUInt -> -- UINT CodePage, // コードページ CULong -> -- DWORD dwFlags, // 文字の種類を指定するフラグ CString -> -- LPCSTR lpMultiByteStr, // マップ元文字列のアドレス CInt -> -- int cchMultiByte, // マップ元文字列のバイト数 Ptr CWchar -> -- LPWSTR lpWideCharStr, // マップ先ワイド文字列を入れるバッファのアドレス CInt -> -- int cchWideChar // バッファのサイズ IO CInt foreign import stdcall "oleauto.h SysFreeString" cSysFreeString :: CWString -> IO () foreign import ccall "string.h strlen" cstrlen :: CString -> IO CInt -- Shift-JISからUtf16への変換 shiftJisToUtf16' :: B.ByteString -> IO String shiftJisToUtf16' byteString = do cwstring <- B.useAsCString byteString cstringToBSTR str <- peekCWString cwstring cSysFreeString cwstring return str where cstringToBSTR :: CString -> IO CWString cstringToBSTR cstring = do cstringlen <- cstrlen cstring out_size <- cMultiByteToWideChar CP_ACP 0 cstring cstringlen nullPtr 0 wstr <- cSysAllocStringLen nullPtr out_size _ <- cMultiByteToWideChar CP_ACP 0 cstring cstringlen wstr out_size return wstr utf16ToSjis :: String -> B.ByteString utf16ToSjis = unsafePerformIO.utf16ToShiftJis' utf16ToShiftJis' :: String -> IO B.ByteString utf16ToShiftJis' string = do cstring <- withCWString string bstrToCString byteS <- B.packCString cstring free cstring return byteS where bstrToCString :: Ptr CWchar -> IO CString bstrToCString bstr = do out_size <- cWideCharToMultiByte CP_ACP 0 bstr (-1) nullPtr 0 nullPtr nullPtr cstring <- mallocBytes ((fromIntegral out_size) + 1):: IO (Ptr CChar) _ <- cWideCharToMultiByte CP_ACP 0 bstr (-1) cstring out_size nullPtr nullPtr return cstring -- http://msdn.microsoft.com/ja-jp/library/cc448089.aspx foreign import stdcall "windows.h WideCharToMultiByte" cWideCharToMultiByte :: CUInt -> -- UINT CodePage, // コードページ CULong -> -- DWORD dwFlags, // 処理速度とマッピング方法を決定するフラグ Ptr CWchar -> -- LPCWSTR lpWideCharStr, // ワイド文字列のアドレス CInt -> -- int cchWideChar, // ワイド文字列の文字数 CString -> -- LPSTR lpMultiByteStr, // 新しい文字列を受け取るバッファのアドレス CInt -> -- int cchMultiByte, // 新しい文字列を受け取るバッファのサイズ CString -> -- LPCSTR lpDefaultChar, // マップできない文字の既定値のアドレス Ptr Int -> -- LPBOOL lpUsedDefaultChar //既定の文字を使ったときにセットするフラグのアドレス IO CInt main :: IO() main = do let str = "こんにちは、世界。" bsjis = utf16ToSjis str B.putStrLn bsjis -- => こんにちは、世界。 putStrLn (B.unpack bsjis) -- => こんにちは、世界。 B.putStrLn (utf16ToSjis (sjisToUtf16 bsjis)) -- => こんにちは、世界。
