# Visual Arrow Syntax

Published on March 12, 2020 under the tag haskell

*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 so you can run it directly in GHCi. Note that some code is located in a second module because of compilation stage restrictions.

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)
Cons x Nil) = x
hlast (Cons _ (Cons y zs)) = hlast (Cons y zs) hlast (
```

```
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))
Cons _ Nil) = Nil
hinit (Cons x (Cons y zs)) = Cons x (hinit (Cons y zs)) hinit (
```

```
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.

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
(━►) = 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 ╆► r = l ┳► arr (const c)
l ┳ c = Below l r
l ┓ r = Input l ┓ r
l ┧ r = Input l ━► arr snd ┓ r
l ┃ 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 isUpper >>> reverse *** sort >>> uncurry mappend partition
```

We can now turn this into:

```
=
amazingExample01 isUpper)┭►reverse┓
(📈) (partition 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 >>= maybe pure goR mbRight >>= maybe pure goL mbLeft
[operator] where
= [replicate n l ++ op | n <- [1 .. 19]]
goL l op = [init op ++ replicate n r ++ [last op] | n <- [1 .. 19]] goR r op
```

```
industryStandardBoilerplate :: Maybe Char -> TH.Name -> Maybe Char -> TH.Q [TH.Dec]
= do
industryStandardBoilerplate l name r <- TH.reify name >>= \case
sig TH.VarI _ sig _ -> pure sig
-> fail "no info"
_ <- TH.reifyFixity name >>= maybe (fail "no fixity") pure
fixity 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:

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

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

```
=
example02 isUpper)━┭─►(reverse)━┓
(📈) (partition 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.

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

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.

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

This renders everyone’s favorite greek letter:

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!

**Update**: CarlHedgren pointed out to me
that a similar DSL is provided by Control.Arrow.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.

### 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
= id &&& (arr (const Nil)) >>> fromDiagram d >>> arr fst run d
```

The definition for `fromDiagram`

is as follows:

```
Diagram f) = f *** arr (const Nil)
fromDiagram (Then l r) = fromDiagram l >>> first r
fromDiagram (Output l) =
fromDiagram (>>> arr (\((x, y), things) -> (x, Cons y things))
fromDiagram l Input l) =
fromDiagram (Cons a things) -> ((x, things), a)) >>>
arr (\(x, >>>
first (fromDiagram l) -> ((y, a), outs))
arr (\((y, outs), a) Below l r) =
fromDiagram (>>>
fromDiagram l -> (hlast (Cons x outs), hinit (Cons x outs))) >>>
arr (\(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
= runST $ do
image w h diagram <- JP.newMutableImage w h
img 0 .. h - 1] $ \y ->
for_ [0 .. w - 1] $ \x ->
for_ [let x' = fromIntegral x / fromIntegral (w - 1)
= fromIntegral y / fromIntegral (h - 1) in
y' $ run diagram (x', y')
JP.writePixel img x y JP.freezeImage img
```