haskell - Netwire 中的控制台交互性？

Question

我正在使用 haskell 库进行测试，并使用简单的电线Netwire使其工作：time

import Control.Wire
import Prelude hiding ((.), id)

import Control.Monad.IO.Class
import Data.Functor.Identity
import System.IO

wire :: (HasTime t s) => Wire s () m a t
wire = time

run :: (HasTime t s, MonadIO m, Show b, Show e) =>
       Session m s -> Wire s e m a b -> m ()
run session wire = do
  (dt, session') <- stepSession session
  (wt', wire') <- stepWire wire dt $ Right undefined
  case wt' of
    -- | Exit
    Left _ -> return ()
    Right x -> do
      liftIO $ do
        putChar '\r'
        putStr $ either (\ex -> show ex) show wt'
        hFlush stdout
        -- Interactivity here?
        gotInput <- hReady stdin
        if gotInput then
          return ()
          else return ()
      run session' wire'

main :: IO ()
-- main = testWire clockSession_ wire
main = run clockSession_ wire

注意：run基本上是从 修改的testWire，所以我不知道它是否是形成电线网络的正确方法。部分代码来自http://todayincode.tumblr.com/post/96914679355/almost-a-netwire-5-tutorial但该教程并未提及事件。

现在我正在尝试为程序添加一些交互性。现在，当按下任意键时退出程序。我想我应该做一些事件切换。但是，我被困在这里，因为我找不到改变wire'或切换行为的方法。我试图阅读 API 文档和源代码，但我看不到如何实际“触发”事件或使用它来切换线路。

同样，由于我对 Haskell 还不是很熟悉，我可能在这里犯了一些愚蠢的错误。

更新 1/2

我通过以下代码实现了我的目标。计时器在任何按键时停止。更新 2我设法分离出pollInput另一个IO唯一的功能，耶！

import Control.Wire
import Prelude hiding ((.), id)

import Control.Monad.IO.Class
import Data.Functor.Identity
import System.IO

wire :: (HasTime t s) => Wire s () m a t
wire = time

run :: (HasTime t s, MonadIO m, Show b, Show e) =>
       Session m s -> Wire s e m a b -> m ()
run session wire = do
  -- Get input here
  input <- liftIO $ pollInput

  (dt, session') <- stepSession session
  (wt', wire') <- stepWire wire dt $ input
  case wt' of
    -- | Exit
    Left _ -> liftIO (putStrLn "") >> return ()
    Right x -> do
      liftIO $ do
        putChar '\r'
        putStr $ either (\ex -> show ex) show wt'
        hFlush stdout

      run session' wire'

pollInput :: IO (Either a b)
pollInput =  do
  gotInput <- hReady stdin
  if gotInput then
    return (Left undefined)
    else return (Right undefined)


setup :: IO ()
setup = do
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering


main :: IO ()
main = do
  setup
  run clockSession_ wire

然而，这引发了一些进一步的问题。首先，这是好的做法吗？第二，什么是类型pollInput？我试图手动输入它但没有成功。但是，自动类型推断有效。

这是我对这段代码如何工作的解释：

首先，轮询来自控制台的用户输入，经过一些逻辑后，生成到线的“输入”（名称选择不佳，但生成的输入是线输入）并沿网络传递。在这里，我简单地传递了一个抑制（Left something），并导致循环退出。当然，退出时，程序会生成一个换行符以使控制台看起来更好。

（好吧，我仍然不明白它是如何Event工作的）

更新 3/4

在阅读了@Cirdec 的答案并在我的编辑器上摆弄了很多之后，我得到了这个没有 的单线程版本IORef，也退出了按 'x' Update 4：（但它不输出任何东西）：

import Control.Wire
import Prelude hiding ((.),id)
import Control.Wire.Unsafe.Event
import System.IO
import Control.Monad.IO.Class

data InputEvent = KeyPressed Char 
                | NoKeyPressed
                deriving (Ord, Eq, Read, Show)
type OutputEvent = IO ()

--- Wires
example :: (HasTime t s, Monad m, Show t) =>
           Wire s () m (Event [InputEvent]) (Event [OutputEvent])
example = switch $
          (fmap ((:[]) . print) <$> periodic 1 . time
           &&&
           fmap (const mkEmpty) <$> filterE (any (== KeyPressed 'x'))
           )

readKeyboard :: IO (Either e (InputEvent))
readKeyboard = do
  hSetBuffering stdin NoBuffering
  gotInput <- hReady stdin
  if gotInput then do
    c <- getChar
    return $ Right $ KeyPressed c
    else return $ Right $ NoKeyPressed

output :: [OutputEvent] -> IO ()
output (x:xs) = id x >> output xs
output _ = return ()

run :: (HasTime t s, MonadIO m) =>
       Session m s -> Wire s e m (Event [InputEvent]) (Event [OutputEvent]) -> m e
run = go
  where
    go session wire = do
      -- | inputEvent :: Event InputEvent
      inputEvent <- liftIO $ readKeyboard
      (dt, session') <- stepSession session
      (wt', wire') <- stepWire wire dt (Event <$> (fmap (:[]) inputEvent))
      -- (wt', wire') <- stepWire wire dt (Right undefined)
      case wt' of
        Left a -> return a
        Right bEvent -> do
          case bEvent of
            Event b -> liftIO $ output b
            _ -> return ()
          go session' wire'

main = do
  run clockSession_ example

我认为这比我原来的要好得多，但我仍然不完全相信它是否是好的做法。

Answer 1

如果您不想阻塞输入和输出，请不要阻塞输入和输出。为了演示如何将 netwire 连接到事件，我们将制作一个用于运行电线的小框架。我们将通过IO在单独的线程中执行所有操作来避免阻塞导线的步进。

从netwire 文档Event中，如果我们正在开发一个框架，我们可以解构s。

默认情况下，Netwire 不导出该Event类型的构造函数。如果您是框架开发人员，您可以导入Control.Wire.Unsafe.Event模块来实现您自己的事件。

Event这让我们看到

data Event a = NoEvent | Event a

我们将制作一个非常简单的框架，该框架使用一个动作m输入，一个动作输出。它运行一个动作m (Either e a)来读取一个动作或禁止。它要么运行一个动作b -> m ()以输出，要么在导线禁止时停止。

import Control.Wire
import Prelude hiding ((.), id)

import Control.Wire.Unsafe.Event

run :: (HasTime t s, Monad m) =>
       m (Either e a) -> (b -> m ()) ->
       Session m s -> Wire s e m (Event a) (Event b) -> m e
run read write = go
    where
        go session wire = do
            (dt, session') <- stepSession session
            a <- read
            (wt', wire') <- stepWire wire dt (Event <$> a)
            case wt' of
                Left e -> return e
                Right bEvent -> do
                    case bEvent of
                        Event b -> write b
                        _       -> return ()
                    go session' wire'

我们将使用它来运行一个示例程序，该程序每秒输出一次时间，并在'x'按下键时停止（禁止）。

example :: (HasTime t s, Monad m, Show t) =>
           Wire s () m (Event [InputEvent]) (Event [OutputEvent])
example = switch $
            (fmap ((:[]) . print) <$> periodic 1 . time)
            &&&
            (fmap (const mkEmpty) <$> filterE (any (== KeyPressed 'x')))

输入和输出事件携带多个事件，以防在同一时间步发生多个事件。输入事件只是按下的字符键。输出事件是IO动作。

data InputEvent = KeyPressed Char 
  deriving (Ord, Eq, Read, Show)
type OutputEvent = IO ()

我们的非阻塞 IO 将运行三个线程：一个输入线程、一个输出线程和一个有线线程。IORef它们将通过原子地修改s来相互通信。这对于示例程序（我们可能hReady在阅读时使用）来说是多余的，对于生产程序来说还不够（IO线程将旋转等待字符和输出）。在实践中，事件轮询和调度输出通常由其他一些 IO 框架（OpenGL、gui 工具包、游戏引擎等）提供。

import Data.IORef

type IOQueue a = IORef [a]

newIOQueue :: IO (IOQueue a)
newIOQueue = newIORef []

readIOQueue :: IOQueue a -> IO [a]
readIOQueue = flip atomicModifyIORef (\xs -> ([], reverse xs))

appendIOQueue :: IOQueue a -> [a] -> IO ()
appendIOQueue que new = atomicModifyIORef que (\xs -> (reverse new ++ xs, ()))

主线程设置队列，生成 IO 线程，运行线路，并在程序停止时向 IO 线程发出信号。

import Control.Concurrent.MVar
import Control.Concurrent.Async

import Control.Monad.IO.Class

runKeyboard :: (HasTime t s, MonadIO m) =>
               Session m s -> Wire s e m (Event [InputEvent]) (Event [OutputEvent]) -> m e
runKeyboard session wire = do
    stopped <- liftIO newEmptyMVar 
    let continue = isEmptyMVar stopped
    inputEvents  <- liftIO newIOQueue
    outputEvents <- liftIO newIOQueue
    inputThread  <- liftIO $ async (readKeyboard continue (appendIOQueue inputEvents .    (:[])))
    outputThread <- liftIO $ async (runEvents    continue (sequence_ <$> readIOQueue outputEvents))
    let read  = liftIO $ Right <$> readIOQueue   inputEvents 
    let write = liftIO .           appendIOQueue outputEvents
    e <- run read write session wire
    liftIO $ putMVar stopped ()
    liftIO $ wait inputThread
    liftIO $ wait outputThread
    return e

输入线程等待键，当没有输入准备好时旋转。它将KeyPressed事件发送到队列。

import System.IO

readKeyboard :: IO Bool -> (InputEvent -> IO ()) -> IO ()
readKeyboard continue send = do
    hSetBuffering stdin NoBuffering
    while continue $ do
        ifM (hReady stdin) $ do
            a <- getChar
            send (KeyPressed a)

ifM :: Monad m => m Bool -> m a -> m ()
ifM check act = do
    continue <- check
    if continue then act >> return () else return ()

while :: Monad m => m Bool -> m a -> m ()
while continue act = go
    where
        go = ifM continue loop
        loop = act >> go

只要指示输出线程继续，输出线程就会运行它发送的操作（并且在发出停止信号以确保所有输出发生后再次执行）。

runEvents :: IO Bool -> (IO (IO ())) -> IO ()
runEvents continue fetch = (while continue $ fetch >>= id) >> fetch >>= id

我们可以使用runKeyboard.

main = runKeyboard clockSession_ example

Answer 2

首先，我会指向Netwire 5 中的 Kleisli Arrow 吗？. 经过很长时间试图理解 Monads 和 Arrows，我得出了这个答案。我将很快举一个使用 Kleisli Wire 的小例子。

该程序仅回显用户键入的内容，并在遇到q. 虽然没用，但它展示了使用 Netwire 5 的一个很好的实践。

mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a

这是在引用的帖子的答案中编写的 Kleisli 线构造函数。总之，这个函数将任何 Kleisli 函数提升a -> m b为Wire s e m a b. 这是我们在这个程序中所做的任何 I/O 的核心。

由于我们是作为用户类型来呼应的，hGetChar可能是最好的选择。因此，我们将其提升为电线。

inputWire :: Wire s () IO () Char
inputWire = mkKleisli $ \_ -> hGetChar stdin

同样，我们使用下面的线在屏幕上输出字符。

outputWire :: Wire s () IO Char ()
outputWire = mkKleisli $ putChar

然后为了确定我们何时需要退出，构造了一个纯线来输出True何时q是输入（注意mkSF_可以用 代替arr）。

quitWire :: (Monad m, Monoid e) => Wire s e m Char Bool
quitWire = arr $ quitNow
    where 
      quitNow c 
          | c == 'q' || c == 'Q' = True
          | otherwise = False

要真正使用退出信息，我们需要编写一个特殊（但非常简单）runWire的函数，它运行一个类型为 的连线Wire s e m () Bool。当连线被禁止或返回假时，函数结束。

runWire :: (Monad m) => Session m s -> Wire s e m () Bool -> m ()
runWire s w = do
  (ds, s') <- stepSession s
  (quitNow, w') <- stepWire w ds (Right ())
  case quitNow of
    Right False -> runWire s' w'
    _ -> return ()

现在，让我们把电线放在一起。

mainWire = inputWire >>> (quitWire &&& outputWire) >>> arr (\(q,_) -> q)

当然我们可以使用箭头语法：

mainWire = proc _ -> do 
  c <- inputWire -< ()
  q <- quitWire -< c
  outputWire -< c
  returnA -< q

不确定proc版本是否更快，但在这个简单的示例中，两者都非常易读。

我们从 获取输入inputWire，将其提供给两者quitWire，outputWire并获得一个元组(Bool, ())。然后我们将第一个作为最终输出。

最后，我们运行一切main！

main = do 
  hSetEcho stdin False 
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering 
  runWire clockSession_ mainWire

这是我使用的最终代码：

{-# LANGUAGE Arrows #-}

module Main where

import Control.Wire
import Control.Monad
import Control.Arrow
import System.IO
import Prelude hiding ((.), id)

mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a

inputWire :: Wire s () IO () Char
inputWire = mkKleisli $ \_ -> hGetChar stdin

outputWire :: Wire s () IO Char ()
outputWire = mkKleisli $ putChar

quitWire :: (Monad m, Monoid e) => Wire s e m Char Bool
quitWire = arr $ quitNow
    where 
      quitNow c 
          | c == 'q' || c == 'Q' = True
          | otherwise = False

runWire :: (Monad m) => Session m s -> Wire s e m () Bool -> m ()
runWire s w = do
  (ds, s') <- stepSession s
  (quitNow, w') <- stepWire w ds (Right ())
  case quitNow of
    Right False -> runWire s' w'
    _ -> return ()

mainWire = inputWire >>> (quitWire &&& outputWire) >>> arr (\(q,_) -> q)

main = do 
  hSetEcho stdin False 
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering 
  runWire clockSession_ mainWire