A while back I talked about the idea of reinversion of control using the continuation monad to wrest control back from an interface that only wants to call you, but doesn't want you to call them back. I want to return to that problem with a slightly different solution. The idea is that we build an interpreter for an imperative language that's an embedded Haskell DSL. You arrange that the DSL does the work of waiting to be called by the interface, but from the point of view of the user of the DSL it looks like you're calling the shots. To do this I'm going to pull together a bunch of techniques I've talked about before. This approach is largely an application of what apfelmus described here.



The code

We'll start with some administrative stuff before getting down to the real code:





> {-# LANGUAGE TemplateHaskell #-}

> import Control.Lens > import Control.Monad > import Control.Monad.Loops



We'll make our DSL an imperative wrapper around Gloss:





> import Graphics.Gloss.Interface.Pure.Game



We'll define a structure that can be used to represent the abstract syntax tree (AST) of our DSL. Our DSL will support the reading of inputs, adding pictures to the current picture, and clearing the screen.



First we'll need a wrapper that allows us to represent ordinary Haskell values in our DSL:





> data Basic a = Return a



Now we want an expression that represents events given to us by Gloss. Internally we'll represent this by a function that says what our program does if it's given an event. It says what our program does by returning another AST saying what happens when the input is received. (I've previously talked about these kinds of expression trees here ).





> | Input (Event -> Basic a)



Picture

We have a command to render some graphics. It appends a newto the current picture. Again, part of the AST muct be another AST saying what happens after the picture is rendered:





> | Render Picture (Basic a)



And lastly here's the AST for a clear screen command:





> | Cls (Basic a)



Our AST will form a monad. This will allow us to build ASTs using ordinary Haskell do-notation. This technique is what I described previously here





> instance Monad Basic where > return = Return > Return a >>= f = f a > Input handler >>= f = Input (\e -> handler e >>= f) > Render p a >>= f = Render p (a >>= f) > Cls a >>= f = Cls (a >>= f)



x >>= f

x

f a

Return a

Return a >>= f

>>= f

Return a

You can think of the expressionaswith the treegrafted in to replace any occurrence ofin it. This is exactly whatdoes. But applyingto the other ASTs simply digs down "inside" the ASTs to find other occurrences of



It's convenient to uses lenses to view Gloss's game world:





> data World = World { _program :: Basic (), _picture :: Picture } > $(makeLenses ''World)



return ()

And now we have some wrappers around the interpreter's commands. Theprovides the convenient place where we can graft subtrees into our AST.





> input = Input return > render p = Render p (return ()) > cls = Cls (return ())



Now we can start coding. Here's a test to see if a Gloss event is a key down event:





> keydown (EventKey (Char key) Down _ _) = True > keydown (EventKey (SpecialKey KeySpace) Down _ _) = True > keydown _ = False



And now here's a complete program using our DSL. It's deliberately very imperative. It simply iterates over a nested pair of loops, collecting keystrokes and displaying them. It reads a lot like an ordinary program written in a language like Python or Basic:





> mainProgram = do > render (Color white $ Scale 0.2 0.2 $ Text "Type some text")

> forM_ [780, 760..] $ \ypos -> do > forM_ [0, 20..980] $ \xpos -> do

> event <- iterateUntil keydown $ input

> let key = case event of > EventKey (Char key) Down _ _ -> key > EventKey (SpecialKey KeySpace) Down _ _ -> ' '

> when (ypos == 780 && xpos == 0) $ cls > render $ Color white $ Translate (xpos-500) (ypos-400) $ Scale 0.2 0.2 $ Text $ [key]



Blank

World

Here is where we launch everything, placing our program and startingpicture into the





> main = play (InWindow "Basic" (1000, 800) (10, 10)) > black > 60 > (World mainProgram Blank) > (^. picture) > handleEvent > (const id)



So now we need just one more ingredient, an actual interpreter for our AST. It's the event handler:





> handleEvent :: Event -> World -> World



Return

Thecommand is purely a place to graft in subtrees. It should never be interpreted.





> handleEvent _ (World (Return a) _) = error "error!"



Cls

EventMotion (0,0)

After receiving some input, I want the interpreter to keep interpreting commands such asthat don't need any more input. I'm going to do this by using a null event. But when an input really is desired, I want this null event to be ignored.





> handleEvent (EventMotion (0, 0)) state@(World (Input handler) _) = state



mappend

World

We render something bying it to the current picture stored in the. But the rendering is carried out by the event handler. We update the state so that at the next event, the subtree of the AST is executed. This means that after updating the picture, the event still needs to be handed back to the event handler:





> handleEvent event state@(World (Render p cont) _) = state & (picture <>~ p) & (program .~ cont) & handleEvent event



Clearing the screen is similar:





> handleEvent event state@(World (Cls cont) _) = state & (picture .~ Blank) & (program .~ cont) & handleEvent event



And now we need to handle inputs. We do this by applying the "what happens when the input is received" function to the event. The result is put back in the state indicating that this is what we want to happen at the next event. So the interpreter doesn't stop here, waiting for the next event, the interpreter sends itself a null event.





> handleEvent event state@(World (Input handler) _) = state & (program .~ handler event) & handleEvent (EventMotion (0, 0))



And that's it!



There are many changes that can be made. We can easily add more commands and make the state more complex. But you might also notice that we create the AST only to tear it apart again in the interpreter. We can actually elide the AST creation, but that will eventually bring us back to something like what I originally posted. This shouldn't be a big surprise, I've already shown how any monad can be replaced with the continuation monad here. By the way, it's pretty easy to add a Fork command. You can replace the _program :: Basic() field with _program :: [Basic ()] and interpret this as a list of threads using a scheduler of your choice.



Acknowledgements

I was prompted to write this (a little late, I know) after reading this article and Tekmo's post on reddit. I think ultimately continuations may perform better than using ASTs. But sometimes it's nice to build an AST because they give you an object that can easily be reasoned about and manipulated by code. Much as I love trickery with continuations, I find ASTs are much easier to think about.



Postscript

My real motivation was that I was thinking about games. The rules of games are often given in imperative style: first player 1 does this. Then they do this. If this happens they do that. And then it's player two's turn. I wanted my Haskell code to reflect that style.



Update

Added 'null' event to keep interpreter going when it makes sense to do so, but there's no event pending.