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

Question

我正在测试 Netwire haskell 库并使其与一个简单的 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 documentation ，我们可以解构 Event如果我们正在开发一个框架。

Netwire does not export the constructors of the Event type by default. If you are a framework developer you can import the Control.Wire.Unsafe.Event module to implement your own events.

这让我们看到 Event 只是

data Event a = NoEvent | Event a

我们将制作一个非常简单的框架，它使用 m 中的一个 Action 。一个用于输入，一个用于输出。它运行一个 Action m (Either e a)读取 Action 或禁止。它要么运行一个 Action 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

输出线程运行它被发送的 Action ，只要它被指示继续(并且在它被发出停止信号以确保所有输出发生之后再一次)。

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

我们可以使用 runKeyboard 运行示例程序.

main = runKeyboard clockSession_ example