Windows上Haskell的Unicode控制台I / O

控制台I / O在Windows下的Haskell中使用Unicode字符似乎相当困难。 这是悲惨的故事:

  1. (初步的)。在你甚至考虑在Windows下的控制台中做Unicode I / O之前,你需要确保你使用了一个可以渲染你想要的字符的控制台字体。 栅格字体(默认)的覆盖范围非常小(并且不允许复制他们无法表示的字符的粘贴),MS提供的truetype选项(consolas,lucida控制台)的覆盖率并不高复制/粘贴他们无法表示的字符)。 您可能会考虑安装DejaVu Sans Mono(请按照此处底部的说明进行操作;您可能需要重新启动才能使用)。 直到这个sorting,没有应用程序将能够做很多的Unicode I / O; 不只是Haskell。
  2. 完成这个之后,你会注意到有些应用程序将能够在Windows下执行控制台I / O。 但是让它起作用还是很复杂的。 基本上有两种方法可以在windows下写入控制台。 (接下来对于任何语言都是如此,不仅仅是Haskell,不用担心,Haskell会进入一些图片!)…
  3. 选项A是使用通常的c库风格的基于字节的I / O函数; 希望操作系统会根据一些编码来解释这些字节,这些编码可以编码你想要的所有奇怪和奇妙的字符。 例如,在Mac OS X上使用等效技术(标准系统编码通常是UTF8),效果很好; 你发出utf8输出,你看到漂亮的符号。
  4. 在Windows上,它的工作不太好。 Windows期望的默认编码通常不会是涵盖所有Unicode符号的编码。 所以如果你想以这种或那种方式看到美丽的符号,你需要改变编码。 一种可能性是您的程序使用SetConsoleCP win32命令。 (所以你需要绑定到Win32库。)或者,如果你不这样做,你可以期望你的程序的用户为你改变代码页(他们将不得不在调用之前调用chcp命令你的程序)。
  5. 选项B是使用WriteConsoleW等Unicode识别的win32控制台API命令。 在这里,您可以直接将UTF16发送到窗口,使窗口更加高兴:不存在编码不匹配的危险,因为窗口始终需要使用UTF16。

不幸的是,这些选项在Haskell中都不能很好地工作。 首先,我没有知道使用选项B的库,所以这不是很容易。 这留下了选项A.如果你使用Haskell的I / O库( putStrLn等),这是图书馆将要做的。 在Haskell的现代版本中,它会仔细询问当前代码页是什么,并以正确的编码输出你的string。 这种方法有两个问题:

  • 一个不是一个好手,但很烦人。 如上所述,默认编码几乎不会编码您想要的字符:您是用户需要更改为编码。 因此,你的用户在运行你的程序之前需要chcp cp65001 (你可能会发现强迫你的用户这样做是chcp cp65001 )。 或者你需要绑定到SetConsoleCP并且在你的程序中执行相同的操作(然后使用hSetEncoding这样Haskell库将使用新的编码发送输出),这意味着你需要包装相关部分的win32库,使它们成为Haskell -可见。
  • 更严重的是, 在windows中有一个bug (解决方法:不会修复),这导致了Haskell中的一个bug,这意味着如果你select了像cp65001这样可以覆盖所有Unicode的代码页,Haskell的I / O例程将会故障并失败。 因此, 即使您(或您的用户)正确地将编码设置为涵盖所有美妙的Unicode字符的编码,然后“尽一切努力”告诉Haskell使用该编码输出内容,您仍然会失败。

上面列出的错误仍然没有解决,列为低优先级; 基本的结论是,选项A(在我上面的分类中)是不可行的,需要切换到选项B才能获得可靠的结果。 目前还不清楚这个问题的解决时间是什么,因为这看起来像是一些相当大的工作。

问题是: 与此同时,任何人都可以提出一个解决方法,允许在windows下使用Haskell中的Unicode控制台I / O。

也可以参考这个python bug tracker数据库项目 ,解决Python 3中的同样的问题(修正了这个问题,但是还没有被接受到代码库中),而且这个stackoverflow的答案 ,在Python中给出了一个解决这个问题的方法(基于'option B'在我的分类)。

Solutions Collecting From Web of "Windows上Haskell的Unicode控制台I / O"

我想我会回答我自己的问题,并列出一个可能的答案,下面,这是我现在正在做的。 人们可以做得更好,这就是为什么我问这个问题! 但是我认为把下面的内容提供给人是有道理的。 这基本上是一个从Python到Haskell这个python解决方法的翻译。 它使用问题中提到的'选项B'。

其基本思想是创建一个模块IOUtil.hs,其中包含以下内容,您可以importimport到您的代码中:

 {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} module IOUtil ( IOUtil.interact, IOUtil.putChar, IOUtil.putStr, IOUtil.putStrLn, IOUtil.print, IOUtil.getChar, IOUtil.getLine, IOUtil.getContents, IOUtil.readIO, IOUtil.readLn, ePutChar, ePutStr, ePutStrLn, ePrint, trace, traceIO ) where #ifdef mingw32_HOST_OS import System.Win32.Types (BOOL, HANDLE, DWORD, LPDWORD, LPWSTR, LPCWSTR, LPVOID) import Foreign.C.Types (CWchar) import Foreign import Prelude hiding (getContents, putStr, putStrLn) --(IO, Read, Show, String) --import qualified System.IO import qualified System.IO (getContents) import System.IO hiding (getContents, putStr, putStrLn) import Data.Char (ord) {- <http://msdn.microsoft.com/en-us/library/ms683231(VS.85).aspx> HANDLE WINAPI GetStdHandle(DWORD nStdHandle); returns INVALID_HANDLE_VALUE, NULL, or a valid handle -} foreign import stdcall unsafe "GetStdHandle" win32GetStdHandle :: DWORD -> IO (HANDLE) std_OUTPUT_HANDLE = -11 :: DWORD -- all DWORD arithmetic is performed modulo 2^n std_ERROR_HANDLE = -12 :: DWORD {- <http://msdn.microsoft.com/en-us/library/aa364960(VS.85).aspx> DWORD WINAPI GetFileType(HANDLE hFile); -} foreign import stdcall unsafe "GetFileType" win32GetFileType :: HANDLE -> IO (DWORD) _FILE_TYPE_CHAR = 0x0002 :: DWORD _FILE_TYPE_REMOTE = 0x8000 :: DWORD {- <http://msdn.microsoft.com/en-us/library/ms683167(VS.85).aspx> BOOL WINAPI GetConsoleMode(HANDLE hConsole, LPDWORD lpMode); -} foreign import stdcall unsafe "GetConsoleMode" win32GetConsoleMode :: HANDLE -> LPDWORD -> IO (BOOL) _INVALID_HANDLE_VALUE = (intPtrToPtr $ -1) :: HANDLE is_a_console :: HANDLE -> IO (Bool) is_a_console handle = if (handle == _INVALID_HANDLE_VALUE) then return False else do ft <- win32GetFileType handle if ((ft .&. complement _FILE_TYPE_REMOTE) /= _FILE_TYPE_CHAR) then return False else do ptr <- malloc cm <- win32GetConsoleMode handle ptr free ptr return cm real_stdout :: IO (Bool) real_stdout = is_a_console =<< win32GetStdHandle std_OUTPUT_HANDLE real_stderr :: IO (Bool) real_stderr = is_a_console =<< win32GetStdHandle std_ERROR_HANDLE {- BOOL WINAPI WriteConsoleW(HANDLE hOutput, LPWSTR lpBuffer, DWORD nChars, LPDWORD lpCharsWritten, LPVOID lpReserved); -} foreign import stdcall unsafe "WriteConsoleW" win32WriteConsoleW :: HANDLE -> LPWSTR -> DWORD -> LPDWORD -> LPVOID -> IO (BOOL) data ConsoleInfo = ConsoleInfo Int (Ptr CWchar) (Ptr DWORD) HANDLE writeConsole :: ConsoleInfo -> [Char] -> IO () writeConsole (ConsoleInfo bufsize buf written handle) string = let fillbuf :: Int -> [Char] -> IO () fillbuf i [] = emptybuf buf i [] fillbuf i remain@(first:rest) | i + 1 < bufsize && ordf <= 0xffff = do pokeElemOff buf i asWord fillbuf (i+1) rest | i + 1 < bufsize && ordf > 0xffff = do pokeElemOff buf i word1 pokeElemOff buf (i+1) word2 fillbuf (i+2) rest | otherwise = emptybuf buf i remain where ordf = ord first asWord = fromInteger (toInteger ordf) :: CWchar sub = ordf - 0x10000 word1' = ((shiftR sub 10) .&. 0x3ff) + 0xD800 word2' = (sub .&. 0x3FF) + 0xDC00 word1 = fromInteger . toInteger $ word1' word2 = fromInteger . toInteger $ word2' emptybuf :: (Ptr CWchar) -> Int -> [Char] -> IO () emptybuf _ 0 [] = return () emptybuf _ 0 remain = fillbuf 0 remain emptybuf ptr nLeft remain = do let nLeft' = fromInteger . toInteger $ nLeft ret <- win32WriteConsoleW handle ptr nLeft' written nullPtr nWritten <- peek written let nWritten' = fromInteger . toInteger $ nWritten if ret && (nWritten > 0) then emptybuf (ptr `plusPtr` (nWritten' * szWChar)) (nLeft - nWritten') remain else fail "WriteConsoleW failed.\n" in fillbuf 0 string szWChar = sizeOf (0 :: CWchar) makeConsoleInfo :: DWORD -> Handle -> IO (Either ConsoleInfo Handle) makeConsoleInfo nStdHandle fallback = do handle <- win32GetStdHandle nStdHandle is_console <- is_a_console handle let bufsize = 10000 if not is_console then return $ Right fallback else do buf <- mallocBytes (szWChar * bufsize) written <- malloc return . Left $ ConsoleInfo bufsize buf written handle {-# NOINLINE stdoutConsoleInfo #-} stdoutConsoleInfo :: Either ConsoleInfo Handle stdoutConsoleInfo = unsafePerformIO $ makeConsoleInfo std_OUTPUT_HANDLE stdout {-# NOINLINE stderrConsoleInfo #-} stderrConsoleInfo :: Either ConsoleInfo Handle stderrConsoleInfo = unsafePerformIO $ makeConsoleInfo std_ERROR_HANDLE stderr interact :: (String -> String) -> IO () interact f = do s <- getContents putStr (fs) conPutChar ci = writeConsole ci . replicate 1 conPutStr = writeConsole conPutStrLn ci = writeConsole ci . ( ++ "\n") putChar :: Char -> IO () putChar = (either conPutChar hPutChar ) stdoutConsoleInfo putStr :: String -> IO () putStr = (either conPutStr hPutStr ) stdoutConsoleInfo putStrLn :: String -> IO () putStrLn = (either conPutStrLn hPutStrLn) stdoutConsoleInfo print :: Show a => a -> IO () print = putStrLn . show getChar = System.IO.getChar getLine = System.IO.getLine getContents = System.IO.getContents readIO :: Read a => String -> IO a readIO = System.IO.readIO readLn :: Read a => IO a readLn = System.IO.readLn ePutChar :: Char -> IO () ePutChar = (either conPutChar hPutChar ) stderrConsoleInfo ePutStr :: String -> IO () ePutStr = (either conPutStr hPutStr ) stderrConsoleInfo ePutStrLn :: String -> IO () ePutStrLn = (either conPutStrLn hPutStrLn) stderrConsoleInfo ePrint :: Show a => a -> IO () ePrint = ePutStrLn . show #else import qualified System.IO import Prelude (IO, Read, Show, String) interact = System.IO.interact putChar = System.IO.putChar putStr = System.IO.putStr putStrLn = System.IO.putStrLn getChar = System.IO.getChar getLine = System.IO.getLine getContents = System.IO.getContents ePutChar = System.IO.hPutChar System.IO.stderr ePutStr = System.IO.hPutStr System.IO.stderr ePutStrLn = System.IO.hPutStrLn System.IO.stderr print :: Show a => a -> IO () print = System.IO.print readIO :: Read a => String -> IO a readIO = System.IO.readIO readLn :: Read a => IO a readLn = System.IO.readLn ePrint :: Show a => a -> IO () ePrint = System.IO.hPrint System.IO.stderr #endif trace :: String -> a -> a trace string expr = unsafePerformIO $ do traceIO string return expr traceIO :: String -> IO () traceIO = ePutStrLn 

然后,使用其中包含的I / O函数而不是标准库函数。 他们会检测输出是否被重定向。 如果没有(例如,如果我们正在写一个“真正的”控制台),那么我们将绕过通常的Haskell I / O函数,并使用WriteConsoleW (一个支持unicode的win32控制台函数)直接写入win32控制台。 在非Windows平台上,条件编译意味着这里的函数只是调用标准库的函数。

如果你需要打印到stderr,你应该使用(例如) ePutStrLn ,而不是hPutStrLn stderr ; 我们没有定义hPutStrLn (定义一个是给读者的练习!)