Netwire 中的控制台交互？
Console interactivity in Netwire?
我正在使用 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 文档和源代码，但我不知道如何实际 "fire" 事件或使用它来切换线路。
同样，由于我对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的类型是什么？我试图手动输入但没有成功。不过，自动类型推导是有效的。
这是我对这段代码如何工作的解释：
首先，轮询来自控制台的用户输入，经过一些逻辑后，生成要连线的 "input"（名称选择不当，但生成的输入是连线输入）并通过网络传递。在这里，我只是传递了一个抑制（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
我认为这比我原来的要好得多，但我仍然不完全相信这是否是好的做法。
如果您不想阻塞输入和输出，请不要阻塞输入和输出。为了演示如何将 netwire 连接到事件，我们将为 运行ning wire 制作一个小框架。我们将通过在单独的线程中执行所有 IO 来避免阻塞线的步进。
从netwire documentation开始，如果我们正在开发一个框架，我们可以解构Events。
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 中的一个动作作为输入，一个动作作为输出。它 运行 是一个动作 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 将 运行 三个线程：输入线程、输出线程和 wire 线程。他们将通过原子修改 IORefs 来相互通信。这对于示例程序来说太过分了（我们可以在阅读时使用 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
首先，我要指出。在尝试理解 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
这是post引用的答案中写的Kleisli wire constructor。总之，此函数将任何 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
然后判断我们什么时候需要退出，构造一个纯wire输出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 类型的连线。当电线被禁止或returns 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)
当然我们可以使用箭头语法：
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
我正在使用 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 文档和源代码，但我不知道如何实际 "fire" 事件或使用它来切换线路。
同样，由于我对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的类型是什么？我试图手动输入但没有成功。不过，自动类型推导是有效的。
这是我对这段代码如何工作的解释：
首先，轮询来自控制台的用户输入，经过一些逻辑后，生成要连线的 "input"（名称选择不当，但生成的输入是连线输入）并通过网络传递。在这里，我只是传递了一个抑制（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
我认为这比我原来的要好得多，但我仍然不完全相信这是否是好的做法。
如果您不想阻塞输入和输出，请不要阻塞输入和输出。为了演示如何将 netwire 连接到事件，我们将为 运行ning wire 制作一个小框架。我们将通过在单独的线程中执行所有 IO 来避免阻塞线的步进。
从netwire documentation开始，如果我们正在开发一个框架，我们可以解构Events。
Netwire does not export the constructors of the
Eventtype by default. If you are a framework developer you can import theControl.Wire.Unsafe.Eventmodule to implement your own events.
这让我们看到 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 将 运行 三个线程：输入线程、输出线程和 wire 线程。他们将通过原子修改 IORefs 来相互通信。这对于示例程序来说太过分了（我们可以在阅读时使用 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
首先，我要指出我将很快使用 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
这是post引用的答案中写的Kleisli wire constructor。总之，此函数将任何 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
然后判断我们什么时候需要退出，构造一个纯wire输出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 类型的连线。当电线被禁止或returns 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)
当然我们可以使用箭头语法：
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