问题
I am testing with the Netwire haskell library and made it work with a simple time wire:
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
Note: the run is basically modified from testWire, so I don't know if it is the correct way to form a network of wires. Part of the code origin from http://todayincode.tumblr.com/post/96914679355/almost-a-netwire-5-tutorial but that tutorial does not say about events.
Now I am trying to add a bit interactivity to the program. For now, quit the program when any key is pressed. I suppose I should do some event switching. However, I am stuck here because I cannot find a way to either change wire' or switch the behaviour. I tried to read the API document and the source, but I don't see how to actually "fire" an Event or using it to switch the wire.
Again, since I am not yet very familiar with Haskell, I may have made some big stupid mistakes here.
Update 1/2
I got my goal working by the following code. The timer stops on any key press. Update 2 I managed to separate out pollInput into another IO only function, 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
However, this raises some further questions. First, is this good practise? Second, what is the type of pollInput? I tried to manually type it out but without success. Automatic type deduction works, though.
This is my explanation of how this code works:
First, the user input from console is polled, and after some logic, the "input" to wire is generated (poor name choice, but that input generated is the wire input) and passed along the network. Here, I simply pass an inhibition (Left something), and will cause the loop to exit. Of course, when exiting, the program produces a newline to make console look nicer.
(Well, I still don't understand how Event works, though)
Update 3/4
After reading @Cirdec 's answer, and fiddled a lot on my editor, I get this single threaded version without IORef, also quitting on pressing 'x'Update 4: (but it does not output anything):
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
I think this is much better than my original, but I am still not completely convinced whether it is good practise or not.
回答1:
If you don't want to block on input and output, don't block on input and output. To demonstrate how to hook up netwire to events, we'll make a little framework for running wires. We'll avoid blocking the stepping of the wire by performing all IO in separate threads.
From the netwire documentation, we are allowed to deconstruct Events if we are developing a framework.
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.
This lets us see that Event is just
data Event a = NoEvent | Event a
We will make a very simple framework that uses one action in m for input and one for output. It runs an action m (Either e a) to read an action or inhibit. It either runs an action b -> m () to output or stops when the wire inhibits.
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'
We will use this to run an example program that outputs the time every second and stops (inhibits) when the 'x' key is pressed.
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')))
The input and output events carry multiple events in case more than one event takes place in the same time step. The input events are just pressed character keys. The output events are IO actions.
data InputEvent = KeyPressed Char
deriving (Ord, Eq, Read, Show)
type OutputEvent = IO ()
Our non-blocking IO will run three threads: an input thread, an output thread, and a wire thread. They will communicate with each other by atomically modifying IORefs. This is overkill for an example program (we could have just used hReady when reading) and not enough for a production program (The IO threads will spin waiting on characters and output). In practice polling for events and scheduling output will usually be provided by some other IO framework (OpenGL, a gui toolkit, a game engine, etc).
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, ()))
The main thread sets up the queues, spawns the IO threads, runs the wire, and signals the IO threads when the program has stopped.
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
The input thread waits for keys, spinning when there is no input ready. It sends KeyPressed events to the queue.
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
The output thread runs the actions it is sent as long as it is instructed to continue (and once more after it is signaled to stop to make sure all the output happens).
runEvents :: IO Bool -> (IO (IO ())) -> IO ()
runEvents continue fetch = (while continue $ fetch >>= id) >> fetch >>= id
We can run the example program with runKeyboard.
main = runKeyboard clockSession_ example
回答2:
First, I would point to Kleisli Arrow in Netwire 5?. I came up with that answer after a longggg time of trying to understand Monads and Arrows. I will put a minimal example using Kleisli Wire soon.
This program merely echos what the user types, and quits when it hits a q. Though useless, it demonstrates a probably good practice of using Netwire 5.
mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a
This is the Kleisli wire constructor written in the answer in the post referenced. In summary, this function lifts any Kleisli function a -> m b into Wire s e m a b. This is the core about any I/O we are doing in this program.
Since we are echoing as user types, hGetChar is probably the best choice. Therefore, we lift that into a wire.
inputWire :: Wire s () IO () Char
inputWire = mkKleisli $ \_ -> hGetChar stdin
Similarly, we use the following wire to output characters on screen.
outputWire :: Wire s () IO Char ()
outputWire = mkKleisli $ putChar
Then to determine when we need to quit, a pure wire is constructed to output True when q is the input (Note that mkSF_ can be used instead of 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
To actually use the information of quitting, we need to write a special (but really simple) runWire function which runs a wire of type Wire s e m () Bool. When the wire is inhibited or returns false, the function ends.
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 ()
Now, let's put wires together.
mainWire = inputWire >>> (quitWire &&& outputWire) >>> arr (\(q,_) -> q)
Of course we can use the Arrow syntax:
mainWire = proc _ -> do
c <- inputWire -< ()
q <- quitWire -< c
outputWire -< c
returnA -< q
Not sure if the proc version is faster or not, but in this simple example, both are quite readable.
We get input from inputWire, feed it to both quitWire and outputWire and get a tuple (Bool, ()). Then we take the first one as the final output.
At last, we run everything in main!
main = do
hSetEcho stdin False
hSetBuffering stdin NoBuffering
hSetBuffering stdout NoBuffering
runWire clockSession_ mainWire
Here comes the final code I used:
{-# 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
来源：https://stackoverflow.com/questions/30992299/console-interactivity-in-netwire