Вопрос по windows, unicode, haskell, console – Консольный ввод / вывод Unicode в Haskell на Windows

24

Кажется довольно сложным заставить консольный ввод / вывод работать с символами Юникода в Haskell под окнами. Вот история о горе:

(Preliminary.) Before you even consider doing Unicode I/O in the console under windows, you need to make sure that you're using a console font which can render the characters you want. The raster fonts (the default) have infinitely poor coverage (and don't allow copy pasting of characters they can't represent), and the truetype options MS provides (consolas, lucida console) have not-great coverage (though these will allow copy/pasting of characters they cannot represent). You might consider installing DejaVu Sans Mono (follow the instructions at the bottom here; you may have to reboot before it works). Until this is sorted, no apps will be able to do much Unicode I/O; not just Haskell. Having done this, you will notice that some apps will be able to do console I/O under windows. But getting it to work remains quite complicated. There are basically two ways to write to the console under windows. (What follows is true for any language, not just Haskell; don't worry, Haskell will enter the picture in a bit!)... Option A is to use the usual c-library style byte-based i/o functions; the hope is that the OS will interpret these bytes according to some encoding which can encode all the weird and wonderful characters you want. For instance, using the equivalent technique on Mac OS X, where the standard system encoding is usually UTF8, this works great; you send out utf8 output, you see pretty symbols. On windows, it works less well. The default encoding that windows expects will generally not be an encoding covering all the Unicode symbols. So if you want to see pretty symbols this way, one way or another, you need to change the encoding. One possibility would be for your program to use the SetConsoleCP win32 command. (So then you need to bind to the Win32 library.) Or, if you'd rather not do that, you can expect your program's user to change the code page for you (they would then have to call the chcp command before they run your program). Option B is to use the Unicode-aware win32 console API commands like WriteConsoleW. Here you send UTF16 direct to windows, which renders it happily: there's no danger of an encoding mismatch because windows always expects UTF16 with these functions.

К сожалению, ни один из этих вариантов не работает очень хорошо от Haskell. Во-первых, нет известных мне библиотек, использующих вариант B, так что это не очень легко. Это оставляет вариант A. Если вы используете библиотеку ввода-вывода Haskell (putStrLn и так далее), вот что сделает библиотека. В современных версиях Haskell он будет тщательно спрашивать у окон, что такое текущая кодовая страница, и выводить ваши строки в правильной кодировке. У этого подхода есть две проблемы:

One is not a showstopper, but is annoying. As mentioned above, the default encoding will almost never encode the characters you want: you are the user need to change to an encoding which does. Thus your user needs to chcp cp65001 before they run your program (you may find it distasteful to force your users to do this). Or you need to bind to SetConsoleCP and do the equivalent inside your program (and then use hSetEncoding so that the Haskell libraries will send output using the new encoding), which means you need to wrap the relevant part of the win32 libraries to make them Haskell-visible. Much more seriously, there is a bug in windows (resolution: won't fix) which leads to a bug in Haskell which means that if you have selected any code page like cp65001 which can cover all of Unicode, Haskell's I/O routines will malfunction and fail. So essentially, even if you (or your user) set the encoding properly to some encoding which covers all the wonderful Unicode characters, and then 'do everything right' in telling Haskell to output things using that encoding, you still lose.

Ошибка, указанная выше, все еще не устранена и указана с низким приоритетом; основной вывод заключается в том, что вариант А (в моей классификации выше) не работает, и для получения надежных результатов нужно переключиться на вариант Б. Не ясно, какие сроки будут для этого решены, так как это выглядит как значительная работа.

Вопрос в том:in the meantime, can anyone suggest a workaround to allow the use of Unicode console I/O in Haskell under windows.

Смотрите также этозапись в базе данных отслеживания ошибок Python, решая ту же проблему в Python 3 (исправление предложено, но еще не принято в кодовой базе), иэтот ответ stackoverflow, давая обходной путь для этой проблемы в Python (на основе «варианта B» в моей классификации).

Ваш Ответ

1   ответ
20

one possible ответьте следующее, что я и делаю в данный момент. Вполне возможно, что можно добиться большего успеха, поэтому я задаю вопрос! Но я подумал, что было бы целесообразно сделать следующее доступным для людей. Это в основном перевод с Python на Haskell этогообход питона для той же проблемы, Он использует «опцию B» упоминается в вопросе.

Основная идея заключается в том, что вы создаете модуль IOUtil.hs со следующим содержимым, которое вы можетеimport в ваш код:

{-# 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 [email protected](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 (f s)

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

затем вы используете содержащиеся в нем функции ввода / вывода вместо стандартных библиотечных. Они обнаружат, перенаправлен ли вывод; если нет (то есть, если мы пишем в «реальную» консоль), то мы «обойдем» обычные функции ввода-вывода Haskell и запишем напрямую в консоль win32, используяWriteConsoleW, консольная функция win32 с поддержкой Unicode. На платформах, отличных от Windows, условная компиляция означает, что функции здесь просто вызывают функции стандартной библиотеки.

Если вам нужно распечатать на stderr, вы должны использовать (например,)ePutStrLnнеhPutStrLn stderr; мы не определяемhPutStrLn, (Определение одного - упражнение для читателя!)

Что-нибудь случилось с этим?
У меня также были проблемы, связанные с этой ошибкой (мой обычный обходной путьmapM_ (\h -> do {eold <- hGetEncoding; case eold of {Nothing -> return (); Just e -> mkTextEncoding (show e ++ "//TRANSLIT") >>= hSetEncoding h}}) [stdout,stdin,stderr]))
Люди GHC были очень открыты для работы по корректировке Unicode в прошлом.
Я не уверен, что следовал всему этому, но если это правильный способ выполнения консольного ввода-вывода в Windows, как бы вы относились к составлениюlibrary proposal чтобы добавить эти функции в пакет Win32 и / или вызвать эти функции из базовой библиотекиputStrLn, так далее.?
@ циркуляр руины, я забочусь об этой проблеме. Я работаю по курсу CIS 194 на Haskell, и в одном из примеров один из типов данных имеетshow функция, которая возвращает некоторые символы Юникода (& # x2660; & # x2665; & # x2663; & # x2666;). Я только что получил & quot; hPutChar: неверный аргумент (недопустимый символ) & quot; вместо этого, что было довольно сложно, пока я не понял, что происходит. Курс CIS 194 размещен на веб-сайте haskell.org, так что, вероятно, многие новички, как и я, будут размышлять над этим вопросом.

Похожие вопросы