A Calculator with Reflex and CodeWorld

I was interested to read a recent series of posts describing how to build a calculator using Haskell and GHCJS using the Keera Hails framework. This reminded me that I have been neglecting CodeWorld’s Reflex API for some time. I’ve now cleaned up the half-complete migration that had been around for a long time, and I think I’ll relaunch it with my own calculator.

So here it is: how to build a calculator using CodeWorld’s Reflex API. At each step of the way, I’ll link to the source code in progress, so if you want to branch off and go your own way or try something different, go for it. This ability to riff off others’ code based on their hashes is one of the coolest things about working with CodeWorld.

Step 1: An Empty Project

To start, we’ll make an empty project, just to get started.

It’s really quick and simple to start using CodeWorld. Just head over to https://code.world/haskell, and start writing code! (Please don’t try this at https://code.world, though; that URL compiles a more limited dialect of Haskell that I use to teach children.) If you’d like to save your project in CodeWorld, you can log in with a Google account by clicking Sign In at the bottom of the page. However, an account is not needed to use the page or share projects by hash.

To use Reflex, you should import both the Reflex module, which is the common FRP implementation used in lots of environments, and the CodeWorld.Reflex module, which is the glue code connecting Reflex to CodeWorld. It looks like this.

import CodeWorld.Reflex
import Reflex
main :: IO ()
main = reflexOf $ return ()

Empty Reflex/CodeWorld Application

The reflexOf function is the entry point for building Reflex apps in CodeWorld. The argument runs in a monad constrained by ReflexCodeWorld, which provides the Reflex implementation and access to inputs and outputs. In this case, though, the argument does nothing at all, and if you run it, you’ll get a blank screen. It’s a start!

Step 2: Adding a Display

CodeWorld is mainly intended as a graphics library, not a general-purpose user interface toolkit. Because of this, we’ll have to invent some UI controls.

First, we want a display at the top of the calculator. This should display some text for the user to see. The text to be displayed can change over time, and things need to happen (specifically, the screen needs updating) when it changes. Reflex uses the Dynamic type for values like this, so we’ll implement the display with this type.

display :: ReflexCodeWorld t m => Dynamic t Text -> m ()

The implementation just uses the Functor instance for Dynamic to inject the dynamic text value into a Picture, and then pass the result dynamic Picture to draw. The builtin draw function is how you’ll produce output on the screen. It looks like this:

display :: ReflexCodeWorld t m => Dynamic t Text -> m ()
display text = draw (pic <$> text)
  where
    pic text =
      translated 0 6 $
        rectangle 10 2
          <> clipped 10 2 (lettering text)

We’ll quickly change main to use this function, using constDyn to produce a value withDynamic type that doesn’t actually change. Here’s the result so far.

The Calculator Display

Step 3: Buttons

Any good calculator needs buttons. Again, since CodeWorld isn’t a general-purpose UI toolkit, we’ll need to invent our own buttons. Clicks on a button happen at discrete times, and the Reflex type that captures this is Event. Here’s the type we want:

button ::
  ReflexCodeWorld t m =>
  -- | label
  Picture ->
  -- | x position
  Double ->
  -- | y position
  Double ->
  -- | width
  Double ->
  -- | height
  Double ->
  m (Event t ())

Drawing the button is easy. Producing the button press event will require a new trick. There’s already an Event capturing mouse clicks, so we’ll filter for just the clicks that hit this button.

button label x y w h = do
  draw $ constDyn $
    translated x y (rectangle w h <> clipped w h label)
  clicks <- getPointerClick
  return (() <$ ffilter hit clicks)
  where
    hit (px, py) = abs (x - px) < w / 2 && abs (y - py) < h / 2

Filter an event can be done with ffilter. Combinators like ffilter can be found in the Reflex Quick Reference, which is an indispensable guide for Reflex programming. The hit function contains the logic to decide whether the click location is inside the button.

There’s one more detail to handle, though. The pointer click event contains the coordinates where the pointer was clicked, but our clients don’t care where on the button the click happened. So we’ll use <$ to clear out the value associated with the clicks.

Time to wire up the button to the display. Our button function produces an Event capturing the clicks. The display function takes in a Dynamic text value. If we can use that Event to build a Dynamic, then we’re done. Looking at the quick reference again, the combinator we want is foldDyn.

main = reflexOf $ do
  click <- button (lettering "Get Excited!") 0 0 6 2
  output <- foldDyn (const (<> "!")) "test" click
  display output

Each click on the button will add another exclamation point to the output. Here’s everything put together.

Button and Display Wired Together

Step 4: Better Buttons

I’m not too happy with the buttons from the previous section. Ideally, buttons would provide some kind of feedback as the user interacts with them. Common effects include highlighting the button when the mouse is over it, and offsetting it when it’s pressed. We’ll do both.

To highlight the button, we need a background color, which will lighten a bit on mouse-over. To detect mouse hover, we can check the current pointer position, and use the already-existing hit predicate to test it. It would work to do something like this:

pos <- getPointerPosition
let hover = hit <$> pos 

Here, hover is a Dynamic t Bool, telling us whether the mouse is hovering over the button. But there’s a subtle problem, here. Every time the mouse pointer moves even one pixel, pos will change, and that will trigger updates of everything downstream of it. We definitely don’t want to redraw our button every time the mouse is moved! The solution is called holdUniqDyn. This combinator takes a dynamic value, doesn’t change it, but remembers its previous value and only signals updates when it truly changes. Let’s add that to our code.

pos <- getPointerPosition
hover <- holdUniqDyn (hit <$> pos)

Now we’ll just need to make use of hover when drawing the button.

Here’s the whole button so far, with the new parts in bold:

button label x y w h = do
  pos <- getPointerPosition
  hover <- holdUniqDyn (hit <$> pos)
  draw $ pic <$> bgcolorFor <$> hover
  clicks <- getPointerClick
  return (() <$ ffilter hit clicks)
  where
    hit (px, py) = abs (x - px) < w / 2 && abs (y - py) < h / 2
    pic bgcolor =
      translated x y $
        rectangle w h <>
        clipped w h label <>
        colored bgcolor (solidRectangle w h)
    bgcolorFor True = light (light gray)
    bgcolorFor False = light gray

To create the depressed effect, we’ll need to keep track of the pressed state of the button. If you play with buttons in your favorite UI toolkit, you’ll probably discover that the behavior of buttons is more complex than you would have guessed. It turns out there are two things we care about:

1. Is the mouse currently over the button? Luckily, we already have that dynamic value defined, and call it hover.
2. Was the mouse pressed while the mouse was over the button, and is still being held down? We still need to define this, and we’ll call it anchor.

The button is rendered as depressed whenever both of the two are true. But there’s also a better meaning for clicks: a button is considered clicked not when the pointer is pressed, but when it is released while both conditions are true.

The second condition, which we’ll refer to as the button being “anchored”, is not too hard to define, but for this first time, we’ll need to dissect a Dynamic into its parts. You can think of a Dynamic as containing both a Behavior (a value that changes over time), and an Event (a sequence of discrete events — the instants at which the value changes). CodeWorld provides a Dynamic t Bool called isPointerDown. Applying updated to this gives us the specific times at which the pointer press state changes, and then attach can be used to label each with the current value of hover. From there, it’s just a foldDyn to keep track of the anchor state.

down <- isPointerDown
anchor <-
  foldDyn
    setAnchor
    False
    (attach (current hover) (updated down))
where
  setAnchor (_, False) _ = False  -- pointer released
  setAnchor (True, True) _ = True -- pointer pressed while hovering
  setAnchor _ anchor = anchor     -- none of the above

Combining the two conditions is trivial using the Applicative instance for Dynamic:

let press = (&&) <$> hover <*> anchor

The new click behavior is also not hard. To start, we want to get an Event of pointer releases, which is ffilter not (updated down). Then we want to filter those that happen while the press conditions were true. (There’s a subtlety here: when the mouse is released, anchor will always become false. Fortunately, current gives us a Behavior with the value of the Dynamic before this update. That’s exactly what we want here.)

return $ gate (current press) (() <$ ffilter not (updated down))

Putting this all together gives this final implementation of button:

button ::
  ReflexCodeWorld t m =>
  -- | label
  Picture ->
  -- | x position
  Double ->
  -- | y position
  Double ->
  -- | width
  Double ->
  -- | height
  Double ->
  m (Event t ())
button label x y w h = do
  pos <- getPointerPosition
  hover <- holdUniqDyn (hit <$> pos)
  down <- isPointerDown
  anchor <-
    foldDyn
      setAnchor
      False
      (attach (current hover) (updated down))
  let press = (&&) <$> hover <*> anchor
  draw $ pic <$> (bgcolorFor <$> hover) <*> (offsetFor <$> press)
  return $ gate (current press) (() <$ ffilter not (updated down))
  where
    hit (px, py) = abs (x - px) < w / 2 && abs (y - py) < h / 2
    setAnchor (_, False) _ = False
    setAnchor (True, True) _ = True
    setAnchor _ hover = hover
    pic bgcolor offset =
      translated (x + offset) (y - offset) $
        rectangle w h
          <> clipped w h label
          <> colored bgcolor (solidRectangle w h)
    bgcolorFor True = light (light gray)
    bgcolorFor False = light gray
    offsetFor False = 0
    offsetFor True = 0.05

This may seem like a lot, but remember that we’re doing some very complex logic here. In a traditional GUI toolkit, this would all still exist, but would be implemented by the toolkit itself.

One point worth highlighting is that in the course of all these changes, we didn’t modify the type of button at all! We’re even generating button clicks from a whole different UI event (mouse releases, instead of clicks), but the abstraction holds up, and button still produces the same Event t () type to be consumed from the outside.

Here’s the whole code so far:

Better Buttons

Step 5: Building the Calculator Layout

At this point, it’s fairly easy to build a calculator layout on the screen, using multiple buttons and wiring their functions together. Let’s go ahead and do that.

The type may look a little odd, though:

calculatorUI ::
  ReflexCodeWorld t m =>
  Event t Text ->
  m (Event t Text)

A calculator UI will let the user type expressions, and then press the “=” button, at which point it triggers the logic to decide what to do. So the event returned from this function corresponds to presses of the “=” button. But what about the one passed in? That’s the event of responses to be displayed on the calculator.

If you haven’t done FRP before, that will probably seem very strange. How could you possibly produce the responses to pass in before you find out the inputs (which are in the return value)? That’s what recursion is for. One way to think about this is that FRP is like programming outside of time, wiring up the data flow of the whole system over all of time, all at once. (Another way to look at it, which is closer to the implementation, is that the m monad in ReflexCodeWorld t m runs at the beginning of the system, setting up the data flow, and the program itself doesn’t really start until it has finished.)

The calculator layout

To build the calculator, we can start by creating all of the buttons. Tedious, but nothing exciting here.

btn0   <- button (lettering "0") (-6) (-6) 3 2
btnDot <- button (lettering ".") (-2) (-6) 3 2
btnAdd <- button (lettering "+") ( 2) (-6) 3 2
btnEq  <- button (lettering "=") ( 6) (-6) 3 2
btn1   <- button (lettering "1") (-6) (-3) 3 2
btn2   <- button (lettering "2") (-2) (-3) 3 2
btn3   <- button (lettering "3") ( 2) (-3) 3 2
btnSub <- button (lettering "-") ( 6) (-3) 3 2
btn4   <- button (lettering "4") (-6) ( 0) 3 2
btn5   <- button (lettering "5") (-2) ( 0) 3 2
btn6   <- button (lettering "6") ( 2) ( 0) 3 2
btnMul <- button (lettering "*") ( 6) ( 0) 3 2
btn7   <- button (lettering "7") (-6) ( 3) 3 2
btn8   <- button (lettering "8") (-2) ( 3) 3 2
btn9   <- button (lettering "9") ( 2) ( 3) 3 2
btnDiv <- button (lettering "/") ( 6) ( 3) 3 2

We now want to know the value that’s been typed so far. This value will be appended to when most buttons are pressed, but cleared when the “=” button is pressed. We’ll use a pretty common trick to do this: map each button event to a function that performs its operation, and then fold over them using foldDyn.

typed <- foldDyn ($) "" $ leftmost [
  const "" <$ responses,
  (<> "0") <$ btn0,
  (<> "1") <$ btn1,
  (<> "2") <$ btn2,
  (<> "3") <$ btn3,
  (<> "4") <$ btn4,
  (<> "5") <$ btn5,
  (<> "6") <$ btn6,
  (<> "7") <$ btn7,
  (<> "8") <$ btn8,
  (<> "9") <$ btn9,
  (<> ".") <$ btnDot,
  (<> "+") <$ btnAdd,
  (<> "-") <$ btnSub,
  (<> "*") <$ btnMul,
  (<> "/") <$ btnDiv
  ]

The use of leftmost is kind of arbitrary there. If two buttons are pressed at precisely the same time, it’s not clear what to do, so we’ll just take one of them. (In practice, this will never occur, since each JavaScript event will run in a new frame.)

The display is a little different from the typed value. When the calculator produces a response, we want to see that instead of the typed value. We can do that by combining the incoming responses event with the updated to typed, like this:

displayed <- holdDyn "" $ leftmost [ responses, updated typed ]
display displayed

Here, the use of leftmost is more important! If there’s a new response, we want to prefer that over showing the typed value.

It’s now not too hard to create the result Event, which fires when the “=” button is pressed.

return (tag (current typed) btnEq)

To wire this all together, we’ll need to implement the calculator logic. For now, this will do:

calculatorLogic :: Text -> Text
calculatorLogic "2+2" = "4"
calculatorLogic _ = "I don't know"

And finally, we’ll wire it all together in main.

main = reflexOf $ do
  rec typed <- calculatorUI (calculatorLogic <$> typed)
  return ()

This uses the RecursiveDo language extension, which is basically required for Reflex. The reason for the extension is that it lets us typed in its own definition, creating the feedback loop we need between typed text and responses.

You can try the completed calculator here.

The Calculator UI

Step 6: Making the Calculator Work

We’re done with the Reflex and UI code. But, of course, our calculator isn’t very useful, because it’s not very good at math. Luckily, all of this fits nicely into the pure function calculatorLogic, independent of all the GUI bits.

Also luckily, CodeWorld makes a wide variety of libraries available to us to implement this logic. Among these is megaparsec, which can be used to parse these expressions and calculate values. So we can put this together pretty quickly.

calculatorLogic :: Text -> Text
calculatorLogic input = case runParser (expr <* eof) "" input of
  Left _ -> "ERR"
  Right val ->
    toStrict (toLazyText (formatRealFloat Fixed Nothing val))
  where
    expr :: Parsec Void Text Double
    expr =
      makeExprParser
        (realToFrac <$> scientific)
        [ [InfixL ((*) <$ char '*'), InfixL ((/) <$ char '/')],
          [InfixL ((+) <$ char '+'), InfixL ((-) <$ char '-')]
        ]

And our final calculator is here.

Final Calculator

Hope you enjoyed this story.