Success story: novice haskeller moves console cursor with “netwire” FRP library

Hey, I’m definitely novice haskeller (just to point out: couple of weeks ago I’ve had understood State monad and monad transformers, before that I lived without state for almost 6 months), so I think it is just time to jump into FRP. Men say “FRP is cool” and “FRP is not slow” and “Conal Elliot, whah! beg beg beg”, so I, an novice hero have to tame that beast while the programming world starts to shift to Haskell!

So, what library for FRP sholud I use? Hm, lets examine Hackage…
Hackage: FRP

Ouch. Large choice make me cry ‘( Need something else.
StackOverflow: What’s the status of current Functional Reactive Programming implementations?

Okay, so reactive-banana or netwire. Seems like installing netwire will be faster, because typing cabal install netwire is faster than cabal install reactive-banana.

Installed

Me, remind myself, why do I need FRP? Oh, yes, I’ve recently done a dozen of variations of console tetris and have not forgot all the pain for dealing with timers, state, input, game loop and laziness. I am adequate and I don’t want to rewrite that fully with such a new thing for me as FRP. So let’s take a small subtask – move console cursor on screen with keyboard (discovered System.Console.ANSI recently) – and do that right way!

Let’s start with reading documentation. Hm… Sure… Wow… Ehh… Aha, here it is, an Example:

module Main where

import Control.Monad.Identity (Identity)
import Control.Wire
import Prelude hiding ((.), id)
import Text.Printf

testApp :: Wire () Identity a Time
testApp = timeFrom 10

main :: IO ()
main = loop testApp clockSession
    where
    loop w' session' = do
        (mx, w, session) <- stepSessionP w' session' ()
        case mx of
          Left ex -> putStrLn ("Inhibited: " ++ show ex)
          Right x -> putStrLn ("Produced: " ++ show x)
        loop w session

Runnig this we have:

Produced: 12.8301619000001
Produced: 12.8371623000001
Produced: 12.844162700000101
Produced: 12.849163000000102
Produced: 12.854163200000102
Produced: 12.860163600000101
Produced: 12.866163900000101
Produced: 12.871164200000102
Produced: 12.880164700000103
Produced: 12.885165000000104
Produced: 12.893165500000103
Produced: 12.900165900000104
Produced: 12.905166200000105
Produced: 12.912166600000106
Produced: 12.918166900000106
Produced: 12.924167300000105

Wow! But what changes should I do, to stop it printing after e.g. 15 seconds? Diving to hackage docs… wackelkontakt wtf?!.. Accum… Analyze… Effect… It is definitely hard to find something, for which you do not know the name… Maybe that – when? Let’s try. Other examples combine wires with composition, so do I:

testApp :: Wire () Identity a Time
testApp = when (< 15) . timeFrom 10

Produced: 14.961283800000212
Produced: 14.968284200000213
Produced: 14.974284500000213
Produced: 14.982285000000212
Produced: 14.987285300000213
Produced: 14.993285600000213
Inhibited: ()
Inhibited: ()
Inhibited: ()
Inhibited: ()
Inhibited: ()

Cool! Not what I wanted, but output changed after 15 seconds. Win.

Reality

After examining example a bit carefully, I see the global loop. Documentation says nothing about neediness of global loop in wire program, so I can only assume – it is necessary. To make things simpler, let’s abstract from it:

control whenInhibited whenProduced wire = loop wire clockSession
   where
     loop w' session' = do
         (mx, w, session) <- stepSessionP w' session' ()
         case mx of
           Left ex -> whenInhibited ex
           Right x -> whenProduced x
         loop w session

Now we can run wires like this:

main = control return (putStrLn . show) $
    when (< 15) . timeFrom 10

14.966284000000254
14.969284200000255
14.974284500000255
14.978284700000255
14.981284900000256
14.985285100000256
14.990285400000257
14.995285700000258
14.999285900000258
Interrupted.
*Main>

Do you see it? The output has stopped printing after 15 seconds gone! Great discovery, this will help me later, no doubt.

Keyboard

Dealing with console keyboard is not a hard task for a man, who wrote console tetris. Let’s reuse our keyPressed :: IO (Maybe Char)

foreign import ccall unsafe "conio.h getch" c_getch :: IO Char
foreign import ccall unsafe "conio.h kbhit" c_kbhit :: IO Bool
keyPressed = do isKey <- c_kbhit
                if isKey then Just <$> c_getch
                         else return Nothing

Now we have to create wire from that function. How? Let’s read documentation. Hm.. Hm.. Hm-hm. As I see, the only wire creators are in Control.Wire.Wire, and start with “mk“. As I see, dealing with IO effects can only be done via mkGen (but I’m not that sure)

mkGen :: (Time -> a -> m (Either e b, Wire e m a b)) -> Wire e m a bSource
Construct an effectful wire from the given function.

Ok, maybe this way?

pressedKeyMaybe = mkGen isKey
   where isKey time () = do
            ky <- keyPressed
            return (Right ky, pressedKeyMaybe) -- strange, why do I use same 
                                               -- function in the snd of the tuple?

Let’s test it:

main = control return (putStrLn . show) $
    pressedKeyMaybe

Ha-ha! It doesn’t compile. Warum?

    Couldn't match expected type `Identity' with actual type `IO'
    Expected type: Wire () Identity () b0
      Actual type: Wire () IO () (Maybe Char)
    In the second argument of `($)', namely `pressedKeyMaybe'
    In the expression:
      control return (putStrLn . show) $ pressedKeyMaybe
Failed, modules loaded: none.
Prelude>

I’m lucky and this problem went off with simple replace stepSessionP to stepSession in control function.

Nothing
Nothing
Just 'j'
Nothing
Nothing
Nothing
Nothing
Nothing
Just 'k'
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing
Nothing

Just to make it less verbose:

main = control return (putStrLn . show) $
    when (/= Nothing) . pressedKeyMaybe

*Main> main
Just 'h'
Just 'e'
Just 'l'
Just 'l'
Just 'o'
Just ' '
Just 'n'
Just 'e'
Just 't'
Just 'w'
Just 'i'
Just 'r'
Just 'e'
Interrupted.
*Main>

It’s great time I live in, excuse me for my bad English and egocentrism.

(BTW, I give thanks to netwire author for the “wackelkontakt” mention in the doc. Because it is in fact an effectfull wire, so it can be used as example implementation:

wackelkontaktM ::
    (MonadRandom m, Monoid e)
    => Double  -- ^ Occurrence probability.
    -> Event e m a
wackelkontaktM p =
    mkFixM $ \_ x -> do
        e <- getRandom
        return (if (e < p) then Right x else Left mempty)

So my key stroke wire looks like this now:

pressedKeyMaybe = 
    mkFixM $ \_ _ -> do
            ky <- keyPressed
            return (Right ky)

)

Counting keypresses

Next small subtask in my great mission is to count keystrokes. I know already that FRP is about accumulating events or smth like that, so I want to use accum wire for this task. My plan is:

countingWire = accum (+) 0 . when (/= Nothing) . pressedKeyMayb

That doesn’t work, because Maybes do not accumulate with (+). We have to convert them to integers:

toInt :: Int -> Wire m e a Int
toInt v = mkPure (\_ _ -> (Right v, toInt v))

countingWire = accum (+) 0 . toInt 1 . when (/= Nothing) . pressedKeyMaybe

main = control return (putStrLn . show) countingWire

(…pressing some keys, while running wire…)

*Main> main
0
1
2
3
4
5
6
7
8
9
Interrupted.
*Main>

Astonishing result! But we can do better, because of <|> operator. As I’ve understood, it looks like “or”, so we can have power:

countingWire = accum (+) 0 
    . (toInt (-1) . when (== Just 'h') <|> toInt 1 . when (== Just 'l'))
    . pressedKeyMaybe

But when we have power, we want more power! Let’s control two values simulationously:

cursorWire = accum (\(a,b) (c,d) -> (a+c, b+d)) (0,0)
    . (    pure ((-1),  0 ) . when (== Just 'h') 
       <|> pure (  1,   0 ) . when (== Just 'l')
       <|> pure (  0, (-1)) . when (== Just 'j')
       <|> pure (  0,   1 ) . when (== Just 'k')
       )
    . pressedKeyMaybe

(Have you noticed, how toInt was replaced with pure? That was an “Aha” moment when studying wires)

*Main> main
(0,0)
(1,0)
(2,0)
(3,0)
(3,1)
(3,0)
(3,-1)
(2,-1)
(1,-1)
(0,-1)
Interrupted.
*Main>

Result

Now I am not that novice, that I was in the beginning, I am netwire-non-novice! Creating the cursor moving wire is now easy:

moveCursor = mkFixM $ 
    \_ coords@(x,y) -> setCursorPosition y x >> return (Right coords)

And the result is:

main = control return (const (return ())) $
    moveCursor . cursorWire

(Sorry, it's hard to show how I control the cursor with 
"hjkl" keys, simply believe me or try yourself)

I am pretty pleasant, that while we work with changing values, the whole system stays composable. I don’t know how to develop large systems with FRP architecure, but this small practical exercise gave me more than blind reading tons of reddit articles.

By the way, thanks for reading!

Post Scriptum

Have you ever noticed, that Windows console sends TWO keystrokes, when pressing arrow keys? Yeap, and if you worked with it, you may think it is headache with FRP. Suprisingly, no, with netwire it is simply a couple of compositions:

. edge ((/=) 224 . fromEnum . fromMaybe ' ') .

Putting this code before pressedKeyMaybe in wire chain will filter only those intents, who had keycode 224 just a moment ago.

cursorWire = accum (\(a,b) (c,d) -> (a+c, b+d)) (0,0)
    . (    pure ((-1),  0 ) . when (== Just 'K') 
       <|> pure (  1,   0 ) . when (== Just 'M')
       <|> pure (  0, (-1)) . when (== Just 'H')
       <|> pure (  0,   1 ) . when (== Just 'P')
       )
    . edge ((/=) 224 . fromEnum . fromMaybe ' ') . pressedKeyMaybe

Whole code – Github Gist: moving console cursor

Hometask

One more thing I’ve left to readers. Limit the cursor movement to screen rectanlge. So that we will not exit the screen area.