Recently, for no good reason, I added an easter egg to my personal website. I love fractals and decided to add a visualization of the dragon curve. Here were the requirements:

Every 10 seconds, a new iteration of the dragon curve would be drawn.
If the user clicked anywhere within the drawing area, a new iteration would be drawn and the 10 second clock would be reset.
After the 10th iteration is drawn, the drawing should be cleared and the process should restart.

I decided to use SVG to draw the lines of the fractal. Initially, I built a solution in Elm. However, I was missing the flexibility I’d experienced with my previous back end work in PureScript and wanted to explore using it on the front end. This post walks through the process of rebuilding the solution in PureScript.

Modeling the Fractal

First, we need to model the fractal itself. Here are the relevant types:

data Dir
  = Up
  | Down
  | Left
  | Right

derive instance eqDir :: Eq Dir

derive instance genericDir :: Generic Dir _

instance showDir :: Show Dir where
  show :: Dir -> String
  show = genericShow

type Model
  = { dirs :: Array Dir
    , iteration :: Int
    }

The Dir type is a sum type representing the directions of lines in the fractal. A stroke can move up, down, left or right from the current position. Dir derives Eq and implements Show using generic programming. Both instances were required for test assertions.

Once we have Dir, our Model is quite simple. It’s a record type with two fields: dirs and iterations. The dirs field is a Array of Dirs that we’ll need to draw and the iterations field tracks the current iteration number.

Given this model, we next define a function update that, given a Model, returns the next iteration of the Model.

update :: Model -> Model
update model =
  if model.iteration > 10 then
    newModel
  else
    { dirs: unfold model.dirs
    , iteration: model.iteration + 1
    }

Our update function first checks if the iteraction field is greater than 10. If so, it returns a new model. Here’s the newModel function:

newModel :: Model
newModel = { dirs: [], iteration: 0 }

In the case where the iteration is less than or equal to 10, we increase the interation count by 1 and unfold the next iteration of directions.

The choice of the name unfold is intentional as you can think of each successive iteration of the dragon curve as “unfolding” a piece of paper. Here’s the code for unfold:

unfold :: Array Dir -> Array Dir
unfold = case _ of
  [] -> [ Down ]
  dirs -> dirs <> (rotate <$> reverse dirs)

rotate :: Dir -> Dir
rotate = case _ of
  Right -> Up
  Up -> Left
  Left -> Down
  Down -> Right

If we’re given an empty array of directions, we add a single Down stroke. In the case where have a non-empty array, we take the existing set of directions, reverse them, rotate each direction counter-clockwise 90 degrees and append this to the existing directions.

Now that we have a way to model our fractal and update it, all that’s left is to draw it on the page.

Drawing the Fractal

PureScript has several options for building UIs on the front end, the most popular being Halogen. Halogen didn’t feel appropriate to me for this project given its complexity and the small problem I was trying to solve.

At the same time, I didn’t want to simply use PureScript React Basic because I felt that too much of the react abstraction leaks through to the PureScript code.

After some research and prototyping, I ended up choosing Concur. Concur is exciting for several reasons:

It is built on react and has good interop with the existing ecosystem.
It has a small number of building blocks but they can be combined in powerful ways.
It embraces purely functional programming idioms.

Concur has two core concepts: Widgets and Signals.

A Widget is a UI component that can produce a value (or no value if it loops forever). Rather than defining new mechanisms for extracting a value from a Widget or sending values down to it, Concur uses standard purely functional idioms. To send a value to a Widget, you simple pass it as an argument to a function that produces a Widget. To receive a value that a Widget produces, you bind to it. Yep, that’s right, a Widget is a Monad.

A Signal is a simplified version of the concept from Functional Reactive Programming (FRP). You can think of it as a widget that loops forever, but can be composed with other Signals via bind and a few “looping” helpers.

I decided to implement my view using Signals. Here’s the top-level signal function:

signal :: Signal HTML Model
signal =
  loopS newModel \model -> do
    model' <- timer model
    svgLines model'

I’m using the loopS helper, which loops a provided Signal back onto itself, creating a never-ending loop. loopS is provided an initial value, our newModel, and a function that is called any time that value is updated. The body of our function consists of two Signals: timer and svgLines. The timer signal is responsible for updating our Model every 10 seconds and the svgLines Signal is responsible for rendering our lines and handling user clicks.

Note that the output of the timer signal is fed into the svgLines signal via bind. Any time an “upstream” Signal emits a new value, all “downstream” Signals will re-render. And because we’re using loopS, an update in svgLines “loops back around” to cause the timer signal to re-render.

Let’s look at timer first:

timer :: Model -> Signal HTML Model
timer init =
  loopW init \model -> do
    liftAff $ delay $ Milliseconds tickTime
    pure $ update model

Here, we use the loopW helper to that lets us create a Signal from a Widget by looping it over and over. Widgets are MonadAffs, so we can use Aff functions inside of them. Our timer simply sleeps for some amount of time specified by tickTime and then emits an updated model using the update function from above.

Next, let’s look at svgLines:

svgLines :: Model -> Signal HTML Model
svgLines init =
  loopW init \model -> do
    svg
      [ unit <$ onClick
      , width "500"
      , height "500"
      , viewBox "0 0 500 500"
      ]
      (renderLines model)
    pure $ update model

Again, we use loopW to create a Signal from a looped Widget. Here, we create an svg area, add an onClick handler to it and render our lines. If the onClick fires, we throw away the value and emit an updated model.

Next, let’s look at how we actually render our lines. Perhaps there’s a more elegant way to implement this logic, but it gets the job done.

type Coord
  = Int /\ Int

renderLines :: forall a. Model -> Array (Widget HTML a)
renderLines = snd <<< foldl renderLine (startCoord /\ []) <<< _.dirs

renderLine ::
  forall a.
  Coord /\ Array (Widget HTML a) ->
  Dir ->
  Coord /\ Array (Widget HTML a)
renderLine (coord /\ lines) dir =
  let
    newCoord = move coord dir

    newLine = makeLine coord newCoord
  in
    newCoord /\ newLine : lines

move :: Coord -> Dir -> Coord
move (x /\ y) = case _ of
  Up -> x /\ (y - stepSize)
  Down -> x /\ (y + stepSize)
  Left -> (x - stepSize) /\ y
  Right -> (x + stepSize) /\ y

makeLine :: forall a. Coord -> Coord -> Widget HTML a
makeLine (xa /\ ya) (xb /\ yb) =
  line
    [ x1 xa
    , x2 xb
    , y1 ya
    , y2 yb
    , strokeWidth 2
    , stroke "#000000"
    ]
    []

We introduce a new type, Coord, that is a tuple of two Ints to represent positions. The renderLines function folds over our Model’s dirs accumulating a tuple of the current coordinate and the list of lines to render. Finally, we extract the lines from the resulting accumulator and throw away the coordinate. The renderLine function is the workhouse of our fold.

renderLine receives the current state of our accumulator and the next direction to move. It then updates the current coordinate and appends a new line to the array of lines. The move and makeLine helper functions handle updating the coordinate and rendering the current line.

The final helper functions we need are the x1, x2, y1 and y2 properties as they’re not provided by the react bindings.

x1 :: forall a. Int -> ReactProps a
x1 = unsafeMkProp "x1" <<< show

x2 :: forall a. Int -> ReactProps a
x2 = unsafeMkProp "x2" <<< show

y1 :: forall a. Int -> ReactProps a
y1 = unsafeMkProp "y1" <<< show

y2 :: forall a. Int -> ReactProps a
y2 = unsafeMkProp "y2" <<< show

Finally, we mount our top-level signal function onto the DOM.

main :: Effect Unit
main = runWidgetInDom "main" $ dyn signal

The dyn function turns a Signal into a never-ending Widget that can be attached to the DOM.

Parting Thoughts

I very much enjoyed the exercise of building a small front end project in PureScript. I left feeling excited about the potential of the Concur framework and the PureScript ecosystem as a whole.

Modeling the Fractal#

Drawing the Fractal#

Parting Thoughts#

Modeling the Fractal

Drawing the Fractal

Parting Thoughts