Console interactivity in Netwire?

前端 未结 2 1744
醉梦人生
醉梦人生 2020-12-10 19:12

I am testing with the Netwire haskell library and made it work with a simple time wire:

import Control.Wire
import Prelude hiding (         


        
2条回答
  •  攒了一身酷
    2020-12-10 19:55

    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
    

提交回复
热议问题