Haskell 读取原始键盘输入答案

【问题标题】：Haskell read raw keyboard inputHaskell 读取原始键盘输入
【发布时间】：2014-05-28 21:25:20
【问题描述】：

我正在用 Haskell 编写一个终端模式程序。我将如何阅读原始按键信息？

特别是，似乎有一些东西在 Haskell 之上提供了行编辑工具。如果我使用getLine，我似乎可以使用向上箭头来获取前几行，编辑文本，并且只有当我按下 Enter 时，文本才会对 Haskell 应用程序本身可见。

我追求的是读取单个按键的能力，因此我可以自己实现行编辑。

也许我的问题不清楚。基本上我想构建类似 Vi 或 Emacs（或Yi）的东西。我已经知道有终端绑定可以让我进行精美的控制台模式打印，因此输出端应该不是问题。我只是在寻找一种获取原始按键输入的方法，因此我可以执行以下操作（例如）在用户按下字母 K 时将 K 添加到当前文本行，或者在用户按下字母 K 时将文件保存到磁盘按 Ctrl+S。

【问题讨论】：

可能是readline 包？

标签： haskell io terminal

【解决方案1】：

这可能是最简单的解决方案，类似于其他编程语言中的典型代码：

import System.IO (stdin, hReady)

getKey :: IO [Char]
getKey = reverse <$> getKey' ""
  where getKey' chars = do
          char <- getChar
          more <- hReady stdin
          (if more then getKey' else return) (char:chars)

它的工作原理是“一次”读取多个字符。允许例如↑ 键，由三个字符 ['\ESC','[','A'] 组成，以区别于实际的 \ESC 字符输入。

用法示例：

import System.IO (stdin, hSetEcho, hSetBuffering, NoBuffering)
import Control.Monad (when)

-- Simple menu controller
main = do
  hSetBuffering stdin NoBuffering
  hSetEcho stdin False
  key <- getKey
  when (key /= "\ESC") $ do
    case key of
      "\ESC[A" -> putStr "↑"
      "\ESC[B" -> putStr "↓"
      "\ESC[C" -> putStr "→"
      "\ESC[D" -> putStr "←"
      "\n"     -> putStr "⎆"
      "\DEL"   -> putStr "⎋"
      _        -> return ()
    main

这有点骇人听闻，因为理论上，用户可以在程序到达hReady 之前输入更多键。如果终端允许粘贴，可能会发生这种情况。但在实践中，对于交互式输入，这并不是一个现实的场景。

有趣的事实：光标字符串可以是putStrd，以编程方式实际移动光标。

【讨论】：

【解决方案2】：

听起来您需要 readline 支持。有几个包可以做到这一点，但haskeline 可能是最容易与最受支持的平台一起使用的。

import Control.Monad.Trans
import System.Console.Haskeline

type Repl a = InputT IO a

process :: String -> IO ()
process = putStrLn

repl :: Repl ()
repl = do
  minput <- getInputLine "> "
  case minput of
    Nothing -> outputStrLn "Goodbye."
    Just input -> (liftIO $ process input) >> repl

main :: IO ()
main = runInputT defaultSettings repl

【讨论】：

Haskline 并不是我想要的，但看起来我可以通过阅读源代码得到我想要的......
我错误地认为 Haskell RTS 正在做一些奇怪的事情。但是，在编写了一个执行原始系统调用的 C 程序后，我得到了类似的行为。看来终端本身确实在缓冲按键，除非您将其置于正确的模式（大概是 readline 所做的）。

【解决方案3】：

不完整：

在网上冲浪几个小时后，我可以报告以下内容：

readline 有一个巨大的 界面，几乎没有任何文档。从函数名称和类型签名中，您也许可以猜测这些东西的作用……但这绝非易事。无论如何，这个库似乎提供了一个高级编辑界面——这是我自己试图实现的东西。我需要一些更底层的东西。
翻过haskeline的源代码后，似乎它有一个巨大的纠结低级代码，分别用于Win32和POSIX。如果有一种简单的方法来进行控制台 I/O，那么这个库不会演示它。该代码似乎与haskeline 紧密集成且高度特定，以至于我怀疑我可以重用其中的任何一个。但也许通过阅读它我可以学到足够的东西来写我自己的？
易是...该死的巨大。 Cabal 文件列出了超过 150 个暴露的模块。 (!!) 不过，它似乎在它下面使用了一个名为 vty 的包，该包仅适用于 POSIX。（我想知道 Yi 到底是如何在 Windows 上工作的？）vty 看起来它可能对我直接有用，无需进一步修改。（但同样，不是在 Windows 上。）
unix 有...基本上没什么有趣的。它有一堆东西可以在终端上设置东西，但绝对没有用于从终端读取的东西。（除了可能检查回显是否打开等。与按键无关。）
unix-compat 完全没有兴趣。

【讨论】：

【解决方案4】：

一种选择是使用ncurses。一个简约的例子：

import Control.Monad
import UI.NCurses

main :: IO ()
main = runCurses $ do
    w <- defaultWindow
    forever $ do
        e <- getEvent w Nothing
        updateWindow w $ do
            moveCursor 0 0
            drawString (show e)
        render

【讨论】：

【解决方案5】：

我想你正在寻找hSetBuffering。 StdIn 默认是行缓冲的，但是你想马上收到钥匙。

【讨论】：

【解决方案6】：

我认为unix 库为此提供了最轻量级的解决方案，特别是如果您对termios 有所了解，System.Posix.Terminal 模块反映了这一点。

gnu.org 上有一个很好的页面，描述了使用termios 为终端设置non-canonical input mode，您可以使用System.Posix.Terminal 进行此操作。

这是我的解决方案，它将IO 中的计算转换为使用非规范模式：

{- from unix library -}
import System.Posix.Terminal
import System.Posix.IO (fdRead, stdInput)

{- from base -}
import System.IO (hFlush, stdout)
import Control.Exception (finally, catch, IOException)

{- run an application in raw input / non-canonical mode with given
 - VMIN and VTIME settings. for a description of these, see:
 - http://www.gnu.org/software/libc/manual/html_node/Noncanonical-Input.html
 - as well as `man termios`.
 -}
withRawInput :: Int -> Int -> IO a -> IO a
withRawInput vmin vtime application = do

  {- retrieve current settings -}
  oldTermSettings <- getTerminalAttributes stdInput

  {- modify settings -}
  let newTermSettings = 
        flip withoutMode  EnableEcho   . -- don't echo keystrokes
        flip withoutMode  ProcessInput . -- turn on non-canonical mode
        flip withTime     vtime        . -- wait at most vtime decisecs per read
        flip withMinInput vmin         $ -- wait for >= vmin bytes per read
        oldTermSettings

  {- install new settings -}
  setTerminalAttributes stdInput newTermSettings Immediately

  {- restore old settings no matter what; this prevents the terminal
   - from becoming borked if the application halts with an exception
   -}
  application 
    `finally` setTerminalAttributes stdInput oldTermSettings Immediately

{- sample raw input method -}
tryGetArrow = (do
  (str, bytes) <- fdRead stdInput 3
  case str of
    "\ESC[A" -> putStrLn "\nUp"
    "\ESC[B" -> putStrLn "\nDown"
    "\ESC[C" -> putStrLn "\nRight"
    "\ESC[D" -> putStrLn "\nLeft"
    _        -> return ()
  ) `catch` (
    {- if vmin bytes have not been read by vtime, fdRead will fail
     - with an EOF exception. catch this case and do nothing. 
     - The type signature is necessary to allow other exceptions 
     - to get through.
     -}
    (const $ return ()) :: IOException -> IO ()
  ) 

{- sample application -}
loop = do
  tryGetArrow 
  putStr "." >> hFlush stdout
  loop 

{- run with:
 - VMIN  = 0 (don't wait for a fixed number of bytes)
 - VTIME = 1 (wait for at most 1/10 sec before fdRead returns)
 -}
main = withRawInput 0 1 $ loop

【讨论】：