The Power of Tiny DSLs

I was playing around with codeworld-api recently, and found myself with a pair of interesting problems:

• Place (move and scale) a grid (represented as a CodeWorld Picture) onto the canvas; and
• When responding to mouse clicks on the grid, reverse the transformation that placed the grid, so that I can determine which grid cell was clicked.

Placing the picture is easy — codeworld-api provides two functions that do exactly what I want:

• translated :: Double -> Double -> Picture -> Picture
• scaled :: Double -> Double -> Picture -> Picture

Going the other way is more difficult. After noodling around on paper trying to compute the inverse transform, I remembered that these transformations could be represented as 3x3 matrices (Wikipedia has some examples), and that inverting a 3x3 matrix is easy (provided that the affine transformation it represents hasn’t collapsed the space).

This means I have to compute the transformation twice: once as codeworld-api calls, and once as matrices. Or do I?

A Simple DSL

Let’s invent a simple DSL instead. We’ll start by defining a type for our transformations:

data Transform
  = Scale Double Double
  | Translate Double Double

We’ll also define the fold for Transform, as this will make it much easier to implement one of our interpreters. These functions are often really handy as a compact way to do case-analysis on a value:

-- Note: transform Scale Translate = id (over Transform)
--     , just as      foldr (:) [] = id (over lists)
--     , and    maybe Nothing Just = id (over Maybe a)
transform
  :: (Double -> Double -> a) -- ^ Handle 'Scale'
  -> (Double -> Double -> a) -- ^ Handle 'Translate'
  -> Transform
  -> a
transform f _ (Scale x y) = f x y
transform _ g (Translate x y) = g x y

Now, we need to interpret some Transforms into either a matrix or a codeworld-api function. In Haskell, DSLs are often associated with free monads and effect systems, but all we want is a linear sequence of commands, so a list will do fine.

Both interpretations are essentially foldMap over different monoids:

• To construct a matrix, map each Transform into a matrix, then multiply them all together.
• To construct a function Picture -> Picture, map each Transform into such a function, then compose them all together.

Unfortunately, the Monoid instances don’t give us what we want:

• We’ll be using the matrix types and functions from Ed Kmett’s linear package, which considers matrices as vectors of vectors. The Monoid instance for vectors is elementwise append; and

• The Monoid instance for functions is instance Monoid b => Monoid (a -> b), which combines results. That’s not what we want either — we want the instance associated with the Endo a newtype.

We could stand up a newtype for matrix multiplication, but it’s a lot of syntactic noise for a single use. Having noted that these are both foldMap, let’s move along and implement them manually.

Let’s start with toMatrix :: [Transform] -> M33 Double. M33 Double is the type of a 3x3 matrix of Double (a 3-vector of (3-vectors of Double)):

-- (!*!) is matrix multiplication
toMatrix :: [Transform] -> M33 Double
toMatrix list = foldr (!*!) identity $ map toMatrix' list
  where
    toMatrix' (Translate x y) = V3
      (V3 1 0 x)
      (V3 0 1 y)
      (V3 0 0 1)

    toMatrix' (Scale x y) = V3
      (V3 x 0 0)
      (V3 0 y 0)
      (V3 0 0 1)

Simplifying the Interpreter

My friend Tony taught me (and many others) that foldr performs constructor replacement. If we write the (:) calls in prefix position, we can see that map is expressible in terms of foldr:

  map f (x1 : x2 : [])
= f x1 : f x2 : []                  -- Effect of `map`
= (:) (f x1) ((:) (f x2) [])        -- Rewrite in prefix position
= ((:) . f) x1 (((:) . f) x2 [])    -- Observing that g (f x) = (g . f) x
= foldr ((:) . f) [] (x1 : x2 : []) -- Noting that we replaced (:) with (:) . f
                                    --         and we replaced  [] with []

In our toMatrix case, we’re using map to:

• replace (:) with (:) . toMatrix'; and
• replace [] with []

We then immediately replace (:) with (!*!) and [] with identity. This suggests that we can avoid folding twice, by:

• replacing (:) with (!*!) . toMatrix'; and
• replacing [] with identity.

This works, and we can avoid explicitly naming and applying the list argument while we’re at it (a process called eta-reduction):

toMatrix :: [Transform] -> M33 Double
toMatrix = foldr ((!*!) . toMatrix') identity
  where
    toMatrix' (Translate x y) = V3
      (V3 1 0 x)
      (V3 0 1 y)
      (V3 0 0 1)

    toMatrix' (Scale x y) = V3
      (V3 x 0 0)
      (V3 0 y 0)
      (V3 0 0 1)

The interpreter for codeworld-api functions only needs a couple of changes:

• We use transform to apply the arguments from Transform’s construtors to the appropriate codeworld-api functions (giving us functions Picture -> Picture instead of matrices); and
• (.) composes all the functions into one, like how we previously used (!*!) to multiply all the matrices together.

toCodeWorld :: [Transform] -> Picture -> Picture
toCodeWorld = foldr ((.) . transform CodeWorld.translated CodeWorld.scaled) id

Finishing Up

The rest is fairly mechanical. We can now write a canonical way to compute the [Transform] that places the grid on the screen:

gridTransforms :: Grid -> [Transform]
gridTransforms g =
  [ Scale (scaleFactor g) (scaleFactor g) -- Shrink to fit viewport
  , toCenter g -- Centre it around the origin
  ]

Rendering the grid is done by interpreting the [Transform] into a Picture -> Picture and applying it to the drawn grid:

renderGrid :: Grid -> Picture
renderGrid g = toCodeWorld (gridTransforms g) (drawGrid g)

Finally, we convert screen coordinates to grid coordinates by interpreting the transforms into a matrix, inverting it, multiplying the inverse matrix with the screen coordinate (as a vector) and rounding the results:

fromPoint :: Grid -> Point -> Maybe (Int, Int)
fromPoint g (x, y)
  | x' >= 0 && x' < w && y' >= 0 && y' < h = Just (x', y')
  | otherwise = Nothing
  where
    (w, h) = (fromIntegral $ width g, fromIntegral $ height g)
    (x', y') = (round invX, round invY)

    -- inv33 inverts a 3x3 matrix, and (!*) is matrix-vector multiplication
    V3 invX invY _ = inv33 (toMatrix (gridTransforms g)) !* V3 x y 1

Even in this relatively simple example, a small DSL saved us a lot of repeated work. It’s a useful technique to keep in your back pocket.

Afterword: Free Monoids

In hindsight, we used [Transform] as an approximation to the free monoid over Transform, which we then interpreted into the two types we cared about. (Reminder: lists are not free monoids, though they’re close enough for most purposes.) If this sort of thinking interests you, Justin Le has some great blog posts about free structures and the cool payoffs you can get when using them:

• Solving a 2018 Advent of Code puzzle using free groups, and accidentally optimising the solution

• Pulling a regular expression library almost out of thin air, using the free alternative

Acknowledgements

I would like to thank the Canberra Functional Programming (CanFP) meetup group, who reviewed drafts of this post.