2020-03-12-visual-arrow-syntax.lhs

---
title: 'Visual Arrow Syntax'
description: 'Finally, better Arrow syntax, completely free of hacks'
tags: 'haskell'
featured: true
---

_Not to be taken seriously._

Haskell is great building at DSLs -- which are perhaps the ultimate
form of slacking off at work.  Rather than actually doing the work your
manager tells you to, you can build DSLs to delegate this back to your
manager so you can focus on finally writing up that GHC proposal for
`MultilinePostfixTypeOperators` (which could have come in useful for this
blogpost).

So, we'll build a visual DSL that's so simple even your manager can use it!
[This blogpost is a literate Haskell file][lhs] so you can run it directly
in GHCi.  Note that some code is located in a [second module] because of
compilation stage restrictions.

[lhs]: https://github.com/jaspervdj/jaspervdj/blob/master/posts/2020-03-12-visual-arrow-syntax.lhs
[second module]: https://github.com/jaspervdj/jaspervdj/blob/master/files/2020-03-12-demo.hs

Let's get started.  We'll need a few language extensions -- not too much, just
enough to guarantee job security for the forseeable future.

> {-# LANGUAGE DataKinds #-}
> {-# LANGUAGE GADTs #-}
> {-# LANGUAGE KindSignatures #-}
> {-# LANGUAGE LambdaCase #-}
> {-# LANGUAGE PolyKinds #-}
> {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE TypeOperators #-}
> module Visual where

And then some imports, not much going on here.

> import qualified Codec.Picture as JP
> import qualified Codec.Picture.Types as JP
> import Control.Arrow
> import Control.Category
> import Control.Monad.ST (runST)
> import Data.Char (isUpper)
> import Data.Foldable (for_)
> import Data.List (sort, partition)
> import qualified Language.Haskell.TH as TH
> import Prelude hiding (id, (.))

All Haskell tutorials that use some form of dependent typing seem to start
with the `HList` type.  So I suppose we'll do that as well.

> data HList (things :: [*]) where
>   Nil  :: HList '[]
>   Cons :: x -> HList xs -> HList (x ': xs)

I think `HList` is short for hype list.  There's a lot of hype around this
because it allows you to put even more types in your types.

We'll require two auxiliary functions for our hype list.  Because of all the
hype, they each require a type family in order for us to even express their
types.  The first one just takes the last element from a list.

> hlast :: HList (thing ': things) -> Last (thing ': things)
> hlast (Cons x Nil)         = x
> hlast (Cons _ (Cons y zs)) = hlast (Cons y zs)

> type family Last (l :: [*]) :: * where
>   Last (x ': '[]) = x
>   Last (x ': xs)  = Last xs

Readers may wonder if this is safe, since `last` is usually a partial function.
Well, it turns out that partial functions are safe if you type them using
partial type families.  So one takeaway is that partial functions can just be
fixed by adding more partial stuff on top.  This explains things like `Prelude`.

Anyway, the second auxiliary function drops the last element from a list.

> hinit :: HList (thing ': things) -> HList (Init (thing ': things))
> hinit (Cons _ Nil)         = Nil
> hinit (Cons x (Cons y zs)) = Cons x (hinit (Cons y zs))

> type family Init (l :: [*]) :: [*] where
>   Init (_ ': '[])     = '[]
>   Init (x ': y ': zs) = x ': Init (y ': zs)

And that's enough boilerplate!  Let's get right to it.

It's always good to pretend that your DSL is built on solid foundations.  As I
alluded to in the title, we'll pick Arrows.  One reason for that is that they're
easier to explain to your manager than Applicative (stuff goes in, other stuff
comes out, see?  They're like the coffee machine in the hallway).  Secondly,
they are less powerful than Monads and we prefer to keep that good stuff to
ourselves.

Unfortunately, it seems like the Arrow module was contributed by an operator
fetishism cult, and anyone who's ever done non-trivial work with Arrows now
has a weekly therapy session to talk about how `&&&` and `***` hurt them.

This is not syntax we want anyone to use.  Instead, we'll, erm, _slightly_
bend Haskell's syntax to get something that is "much nicer" and "definitely
not an abomination".

We'll build something that appeals to both Category Theorists (for street
cred) and Corporate Managers (for our bonus).  These two groups have many
things in common.  Apart from talking a lot about abstract nonsense and
getting paid for it, both **love** drawing boxes and arrows.

![](/images/2020-03-12-industry-academia.jpg)

Yeah, so I guess we can call this visual DSL a `Diagram`.  The main drawback
of arrows is that they can only have a single input and output.  This leads to a
lot of tuple abuse.

We'll "fix" that by having extra `ins` and `outs`.  We are wrapping an arbitrary
`Arrow`, referred to as `f` in the signature:

> data Diagram (ins :: [*]) (outs :: [*]) f a b where

We can create a diagram from a normal arrow, that's easy.

>   Diagram :: f a b -> Diagram '[] '[] f a b

And we can add another normal function at the back.  No biggie.

>   Then
>     :: Diagram ins outs f a b -> f b c
>     -> Diagram ins outs f a c

Of course, we need to be able to use our extra input and outputs.  `Output`
wraps an existing `Diagram` and redirects the second element of a tuple to the
`outs`; and `Input` does it the other way around.

>   Output
>     :: Diagram ins outs f a (b, o)
>     -> Diagram ins (o ': outs) f a b

>   Input
>     :: Diagram ins outs f a b
>     -> Diagram (i ': ins) outs f a (b, i)

The hardest part is connecting two existing diagrams.  This is really where
the magic happens:

>   Below
>     :: Diagram ins1 outs1 f a b
>     -> Diagram (Init (b ': outs1)) outs2 f (Last (b ': outs1)) c
>     -> Diagram ins1 outs2 f a c

Is this correct?  What does it even mean?  The answer to both questions is: "I
don't know".  It typechecks, which is what really matters when you're doing
Haskell.  And there's something about `ins` matching `outs` in there, yeah.

Concerned readers of this blog may at this point be wondering why we used
reasonable names for the constructors of `Diagram` rather than just operators.

Well, it's only because it's a GADT which makes this impossible.  But fear
not, we can claim our operators back.  Shout out to Unicode's [Box-drawing
characters]: they provide various charaters with thick _and_ thin lines.
This lets us do an, uhm, _super intuitive syntax_ where tuples are taken apart
as extra inputs/outputs, or reified back into tuples.

> (━►)   = Then
> l ┭► r = Output l ━► r
> l ┳► r = (l ━► arr (\x -> (x, x))) ┭► r
> l ┶► r = Input l ━► r
> l ╆► r = Output (Input l ━► arr (\x -> (x, x))) ━► r
> l ┳ c  = l ┳► arr (const c)
> l ┓ r  = Below l r
> l ┧ r  = Input l ┓ r
> l ┃ r  = Input l ━► arr snd ┓ r
> infixl 5 ━►, ┳►, ┭►, ┶►, ╆►, ┳
> infixr 4 ┓, ┧, ┃

Finally, while we're at it, we'll also include an operator to clearly indicate
to our manager how our valuation will change if we adopt this DSL.

> (📈) = Diagram

This lets us do the basics.  If we start from regular Arrow syntax:

> horribleExample01 =
>   partition isUpper >>> reverse *** sort >>> uncurry mappend

We can now turn this into:

> amazingExample01 =
>  (📈) (partition isUpper)┭►reverse┓
>  (📈)                   sort      ┶►(uncurry mappend)

The trick to decrypting these diagrams is that each line in the source code
consists of an arrow where values flow from the left to the right; with possible
extra inputs and ouputs in between. These lines are then composed using a few
operators that use `Below` such as `┓` and `┧`.

To improve readability even further, it should also be possible to add
right-to-left and top-to-bottom operators.  I asked my manager if they wanted
these extra operators but they've been ignoring all my Slack messages since I
showed them my original prototype.  Probably just busy?

Anyway, there are other simple improvements we can make to the visual DSL first.
Most Haskellers prefer nicely aligning things over producing working code,
so it would be nice if we could draw longer lines like `━━━━┳━►` rather than
just `┳►`. And any Haskeller worth their salt will tell you that this is where
Template Haskell comes in.

Template Haskell gets a bad rep, but that's only because it is mostly misused.
Originally, it was designed to avoid copying and pasting a lot of code, which is
**exactly** what we'll do here.  Nothing to be grossed out about.

> extensions :: Maybe Char -> String -> Maybe Char -> [String]
> extensions mbLeft operator mbRight =
>   [operator] >>= maybe pure goR mbRight >>= maybe pure goL mbLeft
>  where
>   goL l op = [replicate n l ++ op | n <- [1 .. 19]]
>   goR r op = [init op ++ replicate n r ++ [last op] | n <- [1 .. 19]]

> industryStandardBoilerplate
>   :: Maybe Char -> TH.Name -> Maybe Char -> TH.Q [TH.Dec]
> industryStandardBoilerplate l name r = do
>   sig <- TH.reify name >>= \case
>     TH.VarI _ sig _ -> pure sig
>     _               -> fail "no info"
>   fixity <- TH.reifyFixity name >>= maybe (fail "no fixity") pure
>   pure
>     [ decl
>     | name' <- fmap TH.mkName $ extensions l (TH.nameBase name) r
>     , decl  <-
>         [ TH.SigD name' sig
>         , TH.FunD name' [TH.Clause [] (TH.NormalB (TH.VarE name)) []]
>         , TH.InfixD fixity name'
>         ]
>     ]

We can then invoke this industry standard boilerplate to extend and copy/paste
an operator like this:

`````haskell
$(industryStandardBoilerplate (Just '━') '(┭►) (Just '─'))
`````

We're now equipped to silence even the harshest syntax critics:

`````haskell
example02 =
  (📈) (partition isUpper)━┭─►(reverse)━┓
  (📈)                   (sort)─────────┶━►(uncurry mappend)
`````

Beautiful!  If you've ever wondered what people mean when they say functional
programs "compose elegantly", well, this is what they mean.

`````haskell
example03 =
  (📈) (+1)━┳━►(+1)━┓
  (📈)      (+1)━━━━╆━►add━┓
  (📈)              add────┶━►add
 where
  add = uncurry (+)
`````

Type inference is excellent and running is easy.  In GHCi:

`````
*Main> :t example03
example04 :: Diagram '[] '[] (->) Integer Integer
*Main> run example03 1
12
`````

Let's look at a more complicated example.

`````haskell
lambda =
  (📈)  (id)━┭─►(subtract 0.5)━┳━━━━━━━━►(< 0)━━━━━━━━━━┓
  (📈)    (subtract 0.5)───────╆━►(add)━►(abs)━►(< 0.1)─┶━━━━━━━►(and)━━━━━━━┓
  (📈)                      (swap)━┭─►(* pi)━━►(sin)┳()                      ┃
  (📈)                           (* 2)──────────────┶━►(sub)━►(abs)━►(< 0.2)─┧
  (📈)                                                                      (or)━►(bool bg fg)
 where
  add = uncurry (+)
  sub = uncurry (-)
  and = uncurry (&&)
  or  = uncurry (||)
  fg  = JP.PixelRGB8 69  58  98
  bg  = JP.PixelRGB8 255 255 255
`````

This renders everyone's favorite greek letter:

![](/images/2020-03-12-lambda.png){width=30%}

Amazing!  Math!

While the example diagrams in this post all use the pure function arrow `->`,
it is my duty as a Haskeller to note that it is really parametric in `f` or
something.  What this means is that thanks to this famous guy called [Kleisli],
you can immediately start using this with `IO` in production.  Thanks for
reading!

[Kleisli]: https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Arrow.html#t:Kleisli

**Update**: [CarlHedgren](https://twitter.com/CarlHedgren) pointed out to me
that a similar DSL is provided by [Control.Arrow.Needle][needle].  However, that
package uses Template Haskell to just parse the diagram.  In this blogpost, the
point of the exercise is to bend Haskell's syntax and type system to achieve
the notation.

[needle]: https://hackage.haskell.org/package/needle-0.1.0.1

Appendix 1: run implementation
------------------------------

The implementation of `run` uses a helper function that lets us convert
a diagram back to a normal `Arrow` that uses `HList` to pass extra inputs
and outputs:

> fromDiagram
>   :: Arrow f => Diagram ins outs f a b
>   -> f (a, HList ins) (b, HList outs)

We can then have a specialized version for when there's zero extra inputs
and outputs.  This great simplifies the type signatures and gives us a
"normal" `f a b`:

> run :: Arrow f => Diagram '[] '[] f a b -> f a b
> run d = id &&& (arr (const Nil)) >>> fromDiagram d >>> arr fst

The definition for `fromDiagram` is as follows:

> fromDiagram (Diagram f) = f *** arr (const Nil)
> fromDiagram (Then l r) = fromDiagram l >>> first r
> fromDiagram (Output l) =
>   fromDiagram l >>> arr (\((x, y), things) -> (x, Cons y things))
> fromDiagram (Input l) =
>   arr (\(x, Cons a things) -> ((x, things), a)) >>>
>   first (fromDiagram l) >>>
>   arr (\((y, outs), a) -> ((y, a), outs))
> fromDiagram (Below l r) =
>   fromDiagram l >>>
>   arr (\(x, outs) -> (hlast (Cons x outs), hinit (Cons x outs))) >>>
>   fromDiagram r

Appendix 2: some type signatures
--------------------------------

We wouldn't want these to get in our way in the middle of the prose, but GHC
complains if we don't put them somewhere.

> (┳►) :: Arrow f => Diagram ins outs f a b -> f b c
>      -> Diagram ins (b ': outs) f a c
> (┭►) :: Arrow f => Diagram ins outs f a (b, o) -> f b c
>      -> Diagram ins (o ': outs) f a c
> (┶►) :: Diagram ins outs f a b -> f (b, i) c
>      -> Diagram (i ': ins) outs f a c
> (╆►) :: Arrow f => Diagram ins outs f a b -> f (b, u) c
>      -> Diagram (u ': ins) ((b, u) ': outs) f a c
> (┧)  :: Diagram ins1 outs1 f a b
>      -> Diagram (Init ((b, u) ': outs1)) outs2 f (Last ((b, u) ': outs1)) c
>      -> Diagram (u ': ins1) outs2 f a c

Appendix 3: image rendering boilerplate
---------------------------------------

This uses a user-supplied `Diagram` to render an image.

> image
>   :: Int -> Int
>   -> Diagram '[] '[] (->) (Double, Double) JP.PixelRGB8
>   -> JP.Image JP.PixelRGB8
> image w h diagram = runST $ do
>   img <- JP.newMutableImage w h
>   for_ [0 .. h - 1] $ \y ->
>     for_ [0 .. w - 1] $ \x ->
>       let x' = fromIntegral x / fromIntegral (w - 1)
>           y' = fromIntegral y / fromIntegral (h - 1) in
>       JP.writePixel img x y $ run diagram (x', y')
>   JP.freezeImage img

[Box-drawing characters]: https://en.wikipedia.org/wiki/Box-drawing_character