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功能，Yay！

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 时退出：< del>（但它不输出任何东西）：

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不会导出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来相互沟通。这对于一个示例程序来说是过度的（我们可能在阅读时使用了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

首先，我要指向Kleisli Arrow in Netwire 5?。在尝试了解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

要实际使用quitting的信息，我们需要编写一个特殊的（但非常简单的）runWire函数，该函数运行类型为Wire s e m () Bool的连线。当线被禁止或返回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)

当然我们可以使用Arrow语法：

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