Before diving into what I've been changing recently, it's probably a good idea to quickly talk inside baseball about how ecstasy works. The basic idea is this, you define a "world" higher-kinded data (HKD) corresponding to the components you care about. The library instantiates your HKD world in different ways to form a *structure-of-arrays* corresponding to the high-efficiency storage of the ECS, and to form *just a structure* corresponding to an actual entity.

This machinery is built via the `Component`

type family:

```
type family Component (s :: StorageType)
(c :: ComponentType)
(a :: *) :: *
```

Using `DataKinds`

, `Component`

is parameterized by three types. `s :: StorageType`

describes how the library wants to use this component -- possibly in the "structure-of-arrays" format consumed by the library, or as an entity structure, to be used by the application programmer. `s`

is left polymorphic when defining the HKD.

The `c :: ComponentType`

parameter is used to indicate the *semantics* of the field; some options include "each entity may or may not have this field" or "at most one entity may have this field." The former might be used for something like `position`

, while the latter could be `focusedOnByTheCamera`

.

Finally, `a :: *`

is the actual type you want the field to have.

Having data is a great first step, but it's currently just an opaque blob to the library. This is where GHC.Generics comes in -- given an (auto-derivable) `Generic`

instance for our world, we can use use `GHC.Generics`

to automatically further derive more specialized machinery for ourselves.

As an example, assume our world looked like this (absent the `Component`

trickery):

```
data World f = World
{ position :: f (V2 Double)
, graphics :: f Graphics
}
```

we can use `GHC.Generics`

to automatically generate the equivalent to a function:

```
getEntity :: Int -> World Data.IntMap.IntMap -> World Maybe
getEntity ent storage =
World (Data.IntMap.lookup ent $ position storage)
(Data.IntMap.lookup ent $ graphics storage)
```

which converts from a structure-of-arrays representation to a structure-of-maybes. The actual technique behind implementing these generic functions is out of scope for today's topic, but I've written on it previously.

For its part, `ecstasy`

exposes the `SystemT`

monad, which at its heart is just a glorified `Control.Monad.Trans.State.StateT (Int, World 'Storage)`

. The `Int`

keeps track of the next ID to give out for a newly created entity.

To a rough approximation, this is all of the interesting stuff inside of `ecstasy`

. So armed with this knowledge, we're ready to tackle some of the problems that have been unearthed recently.

My original test for `ecstasy`

was a small platformer -- a genre not known for the sheer number of entities all interacting at once. As a result, `ecstasy`

performed terribly, but I didn't notice because I hadn't benchmarked it or actually stress-tested it whatsoever. But that's OK, I wrote it to scratch an itch while hanging out in a Thai airport; I've never claimed to write titanium-grade software :)

But in my RTS, the library was obvious struggling after allocating only 100 dudes. The thing was leaking memory like crazy, which was because I used lazy state and containers. Oopsie daisies! Replacing `Control.Monad.Trans.State`

and `Data.IntMap`

with their strict versions cleared it up.

Honestly I'm not sure why the lazy versions are the default, but I guess that's the world we live in. **SANDY'S HOT PRO TIPS**: don't use lazy maps or state unless you've really thought about it.

While working on my RTS, I realized that I was going to need fast spacial queries to answer questions like "is there anyone around that I should attack?" The result was some sort of Frankenstein bastard child of a quadtree and a reverse index to answer both "where am I?" and "who's nearby?"

This worked well to answer the queries I asked of it, but posed a problem; in order to maintain its indices, my datastructure needed to be the source of truth on who was where. Having a `position`

component wasn't going to cut it anymore, since the ECS was no longer responsible for this data. I briefly considered trying to write a shim to keep the two datasources in sync, but it felt simultaneously like an ad-hoc hack and a maintenance nightmare, so I gave up and removed the component.

Unfortunately, all was not well. I added some monadic getters and setters to help shuffle the position information around, but oh god this became a garbage fire. Things that were before atomic updates now had extra calls to get and set the bastard, and everything was miserable.

I realized what I really wanted was the capability for `ecstasy`

to be *aware* of components without necessarily being the *owner* of them. Which is to say, components whose reads and writes invisibly dispatched out to some other monadic system.

OK, great, I knew what I wanted. Unfortunately, the implementation was not so straightforward. The problem was the functions I wanted:

```
vget :: Ent -> m (Maybe a)
vset :: Ent -> Update a -> m ()
```

had this troublesome `m`

parameter, and there was no clear place to put it. The monad to dispatch virtual calls to is a property of the interpretation of the data (actually running the sucker), not the data itself.

As a result, it wasn't clear where to actually keep the `m`

type parameter. For example, assuming we want `position`

to be virtual in our world:

```
data World s = World
{ position :: Component s 'Virtual (V2 Double)
}
```

Somehow, after unifying `s ~ 'Storage`

, we want this to come out as:

```
data World 'Storage = World
{ position :: ( Ent -> m (Maybe (V2 Double) -- vget
, Ent -> Update (V2 Double) -> m () -- vset
)
}
```

But where do we get the `m`

from? There's no obvious place.

We could add it as a mandatory parameter on `World`

, but that forces an implementation detail on people who don't need any virtual fields.

We *could* existentialize it, and then `unsafeCoerce`

it back, but... well, I stopped following that line of thought pretty quickly.

My first solution to this problem was to add a `Symbol`

to the `Virtual`

component-type token, indicating the "name" of this component, and then using a typeclass instance to actually connect the two:

```
data World s = World
{ position :: Component s ('Virtual "position") (V2 Double)
}
-- we put the monad here: `m`
instance VirtualAccess "position" m (V2 Double) where
vget = ...
vset = ...
```

While it *worked*, this was obviously a hack and my inner muse of library design was so offended that I spent another few days looking for a better solution. Thankfully, I came up with one.

The solution is one I had already skirted around, but failed to notice. This monad is a property only of the interpretation of the data, which is to say it really only matters when we're building the world *storage*. Which means we can do some janky dependency-injection stuff and hide it inside of the storage-type token.

Which is to say, that given a world of the form:

```
data World s = World
{ position :: Component s 'Virtual (V2 Double)
}
```

we could just pass in the appropriate monad when instantiating the world for its storage. Pseudocode:

```
data World (Storage m) = World
{ position :: Component (Storage m) 'Virtual (V2 Double)
}
```

All of a sudden, the `Component`

type family now has access to `m`

, and so it can expand into the `vget`

/`vset`

pair in a type-safe way. And the best part is that this is completely invisible to the user who never needs to care about our clever implementation details.

Spectacular! I updated all of the code generated via `GHC.Generics`

to run in `m`

so it could take advantage of this virtual dispatch, and shipped a new version of `ecstasy`

.

While all of this virtual stuff worked, it didn't work particularly quickly. I noticed some significant regressions in performance in my RTS upon upgrading to the new version. What was up? I dug in with the profiler and saw that my `GHC.Generics`

-derived code was no longer being inlined. HKD was performing more terribly than I thought!

All of my `INLINE`

pragmas were still intact, so I wasn't super sure what was going on. I canvassed #ghc on freenode, and the ever-helpful glguy had this to say:

generics can't optimize away when that optimization relies on GHC applying Monad laws to do it

Oh. Lame. That's why my performance had gone to shit!

I'm not sure if this is true, but my understanding is that the problem is that my monad was polymorphic, and thus the inliner wasn't getting a chance to fire. glguy pointed me towards the aptly-named confusing lens combinator, whose documentation reads:

Fuse a

`Traversal`

by reassociating all of the`<*>`

operations to the left and fusing all of the`fmap`

calls into one. This is particularly useful when constructing a`Traversal`

using operations from`GHC.Generics`

...

`confusing`

exploits the Yoneda lemma to merge their separate uses of`fmap`

into a single`fmap`

and it further exploits an interesting property of the right Kan lift (or Curried) to left associate all of the uses of`<*>`

to make it possible to fuse together more`fmap`

s.This is particularly effective when the choice of functor

`f`

is unknown at compile time or when the`Traversal`

in the above description is recursive or complex enough to prevent inlining.

That sounds *exactly* like the problem I was having, doesn't it? The actual `confusing`

combinator itself was no help in this situation, so I dug in and looked at its implementation. It essentially lifts your `m`

-specific actions into `Curried (Yoneda m) (Yoneda m)`

(don't ask me!), and then lowers it at the very end. My (shaky) understanding is this:

`Yoneda f`

is a functor even when `f`

itself is not, which means we have a free functor instance, which itself means that `fmap`

on `Yoneda f`

can't just lift `fmap`

from `f`

. This is cool if `fmap`

ing over `f`

is expensive -- `Yoneda`

just fuses all `fmap`

s into a single one that gets performed when you lower yourself out of it. Essentially it's an encoding that reduces an *O*(*n*) cost of doing *n* `fmap`

s down to *O*(1).

`Curried f f`

similarly has a free `Applicative`

instance, which, he says waving his hands furiously, is where the `<*>`

improvements come from.

So I did a small amount of work to run all of my `GHC.Generics`

code in `Curried (Yoneda m) (Yoneda m)`

rather than in `m`

directly, and looked at my perf graphs. While I was successful in optimizing away my `GHC.Generics`

code, I was also successful in merely pushing all of the time and allocations out of it and into `Yoneda.fmap`

. Curiously, this function isn't marked as `INLINE`

which I suspect is why the inliner is giving up (the isomorphic `Functor`

instance for `Codensity`

*is* marked as `INLINE`

, so I am *very hesitantly* rallying the hubris to suggest this is a bug in an Ed Kmett library.)

Despite the fact that I've been saying "we want to run virtual monadic actions," throughout this post, I've really meant "we want to run virtual applicative actions." Which is why I thought I could get away with using `Curried (Yoneda m) (Yoneda m)`

to solve my optimization problems for me.

So instead I turned to `Codensity`

, which legend tells can significantly improve the performance of free *monads* by way of the same mystical category-theoretical encodings. Lo and behold, moving all of my monadic actions into `Codensity m`

was in fact enough to get the inliner running again, and as a result, getting our HKD once more to be less terrible.

If you're curious in how `Codensity`

and friends work their magic, glguy pointed me to a tutorial he wrote explaining the technique. Go give it a read if you're feeling plucky and adventurous.

Your scientists were so preoccupied with whether or not they could, they didn't stop to think if they should.

Ian, Jurassic Park

Designing an abstraction or library often feels wonderfully unconstrained; it is the task of the engineer (or logician) to create something from nothing. With experience and training, we begin to be able to consider and make trade-offs: efficiency vs simplicity-of-implementation vs ease-of-use vs preventing our users from doing the wrong thing, among many other considerations. Undeniably, however, there seems to be a strong element of "taste" that goes into design as well; two engineers with the same background, task, and sensibilities will still come up with two different interfaces to the same abstraction.

The tool of denotational design aims to help us nail down exactly what is this "taste" thing. Denotational design gives us the ability to look at designs and ask ourselves whether or not they are *correct.*

However, it's important to recognize that having a tool to help us design doesn't need to take the *fun* out of the endeavor. Like any instrument, it's up to the craftsman to know when and how to apply it.

This essay closely works through Conal Elliott's fantastic paper Denotational design with type class morphisms.

Consider the example of `Data.Map.Map`

. At it's essence, the interface is given by the following "core" pieces of functionality:

```
empty :: Map k v
insert :: k -> v -> Map k v -> Map k v
lookup :: k -> Map k v -> Maybe v
union :: Map k v -> Map k v -> Map k v
```

With the laws:

```
-- get back what you put in
lookup k (insert k v m) = Just v
-- keys replace one another
insert k b (insert k a m) = insert k b m
-- empty is an identity for union
union empty m = m
union m empty = m
-- union is just repeated inserts
insert k v m = union (insert k v empty) m
```

These laws correspond with our intuitions behind what a `Map`

is, and furthermore, capture exactly the semantics we'd like. Although it might seem silly to explicitly write out such "obvious" laws, it is the laws that give your abstraction meaning.

Consider instead the example:

```
empathy :: r -> f -> X r f -> X r f
fear :: e -> X e m -> Either () m
taste :: X o i -> X o i -> X o i
zoo :: X z x
```

It might take you some time to notice that this `X`

thing is just the result of me randomly renaming identifiers in `Map`

. The names are valuable to us only because they suggest meanings to us. Despite this, performing the same substitutions on the `Map`

laws would still capture the semantics we want. The implication is clear: names are helpful, but laws are invaluable.

Our quick investigation into the value of laws has shown us one example of how to assert meaning on our abstractions. We will now take a more in-depth look at another way of doing so.

Let us consider the concept of a "meaning functor." We can think of the term `μ(Map k v)`

as "the meaning of `Map k v`

." `μ(Map k v)`

asks not how is `Map k v`

implemented, but instead, how should we think about it? What metaphor should we use to think about a `Map`

? The *μ*(⋅) operator, like any functor, will map types to types, and functions to functions.

We can encode this mapping as a function, and the partiality with `Maybe`

:

`μ(Map k v) = k -> Maybe v`

With the meaning of our type nailed down, we can now also provide meanings for our primitive operations on `Map`

s:

` μ(empty) = \k -> Nothing`

An empty map is one which assigns `Nothing`

to everything.

` μ(lookup k m) = μ(m) k`

Looking up a key in the map is just giving back the value at that key.

```
μ(insert k' v m) = \k ->
if k == k'
then Just v
else μ(m) k
```

If the key we ask for is the one we inserted, give back the value associated with it.

```
μ(union m1 m2) = \k ->
case μ(m1) k of
Just v -> Just v
Nothing -> μ(m2) k
```

Attempt a lookup in a union by looking in the left map first.

Looking at these definitions of meaning, it's clear to see that they capture an intuitive (if perhaps, naive) meaning and implementation of a `Map`

. Regardless of our eventual implementation of `Map`

, *μ*(⋅) is a functor that transforms it into the same "structure" (whatever that means) over *functions.*

Herein lies the core principle of denotational design: for any type `X`

designed in this way, `X`

*must be isomorphic* to `μ(X)`

; literally no observational (ie. you're not allowed to run a profiler on the executed code) test should be able to differentiate one from the other.

This is not to say that it's necessary that `X = μ(X)`

. Performance or other engineering concerns may dissuade us from equating the two -- after all, it would be insane if `Map`

were actually implemented as a big chain of nested if-blocks. All we're saying is that nothing in the implementation is allowed to break our suspension of believe that we are actually working with `μ(Map)`

. Believe it or not, this is a desirable property; we all have a lot more familiarity with functions and other fundamental types than we do with the rest of the (possibly weird corners of) ecosystem.

The condition that `X`

≅ `μ(X)`

is much more constraining than it might seem at first glance. For example, it means that all instances of our type-classes must agree between `X`

and `μ(X)`

-- otherwise we'd be able to differentiate the two.

Our `Map`

has some obvious primitives for building a `Monoid`

, so let's do that:

```
instance Monoid (Map k v) where
mempty = empty
mappend = union
```

While this is indeed a `Monoid`

, it looks like we're already in trouble. The `Monoid`

instance definition for `μ(Map)`

, after specializing to our types, instead looks like this:

`instance Monoid v => Monoid (k -> Maybe v) where`

There's absolutely no way that these two instances could be the same. Darn. Something's gone wrong along the way; suggesting that `μ(Map)`

isn't in fact a denotation of `Map`

. Don't panic; this kind of thing happens. We're left with an intriguing question; is it our meaning functor that's wrong, or the original API itself?

Our instances of `Monoid Map`

and `Monoid μ(Map)`

do not agree, leading us to the conclusion that `μ(Map)`

*cannot be* the denotation for `Map`

. We are left with the uneasy knowledge that at least one of them is incorrect, but without further information, we are unable to do better.

A property of denotations is that their instances of typeclasses are always homomorphisms, which is to say that they are *structure preserving.* Even if you are not necessarily familiar with the word, you will recognize the concept when you see it. It's a pattern that often comes up when writing instances over polymorphic datastructures.

For example, let's look at the `Functor`

instance for a pair of type `(a, b)`

:

```
instance Functor ((,) a) where
fmap f (a, b) = (a, f b)
```

This is a common pattern; unwrap your datatype, apply what you've got anywhere you can, and package it all up again in the same shape. It's this "same shape" part that makes the thing structure preserving.

The principle to which we must adhere can be expressed with a pithy phrase: *the meaning of the instance is the instance of the meaning.* This is true for any meaning functor which is truly a denotation. What this means, for our hypothetical type `μ(X)`

, is that all of our instances must be of this form:

```
instance Functor μ(X) where
μ(fmap f x) = fmap f μ(x)
instance Applicative μ(X) where
μ(pure x) = pure x
μ(f <*> x) = μ(f) <*> μ(x)
```

and so on.

Having such a principle gives us an easy test for whether or not our meaning functor is correct; if any of our instances do not reduce down to this form, we know our meaning must be incorrect. Let's take a look at our implementation of `mempty`

:

```
μ(mempty) = \k -> Nothing
= \k -> mempty
= const mempty
= mempty -- (1)
```

At (1), we can collapse our `const mempty`

with `mempty`

because that is the definition of the `Monoid ((->) a)`

instance. So far, our meaning is looking like a true denotation. Let's also look at `mappend`

:

```
μ(mappend m1 m2) = \k ->
case μ(m1) k of
Just v -> Just v
Nothing -> μ(m2) k
```

It's not immediately clear how to wrestle this into a homomorphism, so let's work backwards and see if we can go backwards:

```
mappend μ(m1) μ(m2)
= mappend (\k -> v1) (\k -> v2)
= \k -> mappend v1 v2
= \k ->
case v1 of -- (2)
z@(Just a) ->
case v2 of
Just b -> Just $ mappend a b
Nothing -> z
Nothing -> v2
```

At (2) we inline the definition of `mappend`

for `Maybe`

.

That's as far as we can go, and, thankfully, that's far enough to see that our instances do not line up. While `mappend`

for `μ(Map)`

is left-biased, the one for our denotation may not be.

We're left with the conclusion that our meaning functor *μ*(⋅) must be wrong; either the representation of `μ(Map)`

is incorrect, or our meaning `μ(mappend)`

is. Fortunately, we are free to change either in order to make them agree. Because we're sure that the left-bias in `mappend`

is indeed the semantics we want, we must change the representation.

Fortunately, this is an easy fix; `Data.Monoid`

provides the `First`

newtype wrapper, which provides the left-biased monoid instance we want. Substituting it in gives us:

`μ(Map k v) = k -> First v`

Subsequent analysis of this revised definition of `μ(Map)`

reveals that indeed it satisfies the homomorphism requirement. This is left as an exercise to the reader.

We have now derived a denotation behind `Map`

, one with a sensible `Monoid`

instance. This gives rise to a further question---which other instances should we provide for `Map`

?

`Map`

is obviously a `Functor`

, but is it an `Applicative`

? There are certainly *implementations* for `Applicative (Map k)`

, but it's unclear which is the one we should provide. To make the discussion concrete, what should be the semantics behind `pure 17`

? Your intuition probably suggests we should get a singleton `Map`

with a value of 17, but what should it's key be? There's no obvious choice, unless we ensure `k`

is a `Monoid`

.

Another alternative is that we return a `Map`

in which *every* key maps to 17. This is implementation suggested by the `Applicative`

homomorphism of `μ(Map)`

, but it doesn't agree with our intuition. Alternatively, we could follow in the footsteps of `Data.Map.Map`

, whose solution to this predicament is to sit on the fence, and not provide any `Applicative`

instance whatsoever.

Sitting on the fence is not a very satisfying solution, however. `Applicative`

is a particularly useful class, and having access to it would greatly leverage the Haskell ecosystem in terms of what we can do with our `Map`

. As a general rule of thumb, any type which *can* be an instance of the standard classes *should* be, even if it requires a little finagling in order to make happen.

We find ourselves at an impasse, and so we can instead turn to other tweaks in our meaning functor, crossing our fingers that they will elicit inspiration.

Given the `Compose`

type from `Data.Functor.Compose`

, we can re-evaluate our choices once more (as we will see, this is a common theme in denotational design.)

```
data Compose f g a = Compose
{ getCompose :: f (g a)
}
```

`Compose`

is a fantastic tool when building new types that are composites of others. For example, consider the meaning of `μ(Map k v) = \k -> First v`

. If we'd like to `fmap`

over the `v`

here, we'll need to perform two of them:

```
f :: v -> w
fmap (fmap f) :: μ(Map k v) -> μ(Map k w)
```

Although it seems minor, this is in fact quite a large inconvenience. Not only does it require us two `fmap`

through two layers of functors, more egregiously, it allows us to use a *single* `fmap`

to break the abstraction. Consider the case of `fmap (const 5)`

-- this will transform a `μ(Map k v)`

into a `k -> 5`

, which is obviously *not* a functor. Yikes.

We instead can re-redefine `μ(Map k v)`

:

``μ(Map k v) = Compose ((->) k) First v``

Presented in this form, we are exposed to another interpretation of what our type means. `μ(Map)`

is a composition of some sort of *mapping-ness* `((->) k)`

and of *partiality* (`First`

). The mapping-ness is obviously crucial to the underlying concept, but it's harder to justify the partiality. One interpretation is that we use the `Nothing`

value to indicate there was no corresponding key, but another is that we use `Nothing`

as a *default value*.

When viewed as a default, a few minutes' pondering on this thought reveals that a partial map (`k -> Maybe v`

) is just a special case of a total map (`k -> v`

) where the value itself is partial. Maybe---if you'll excuse the pun---partiality is completely orthogonal to the semantics we want to express.

As our final (and ultimately correct) attempt, we define

`μ(Map k v) = \k -> v`

From here, the problem of "what typeclasses should this thing have" becomes quite trivial---we should provide equivalent instances for all of those of `k -> v`

. The question about what should our `Applicative`

instance do is resolved: the same thing arrows do.

A point worth stressing here is that just because the *meaning* of `Map k v`

is `k -> v`

, it doesn't mean our *representation* must be. For example, we could conceive implementing `Map`

as the following:

```
data Map k v = Map
{ mapDefVal :: v
, mapTree :: BalancedTree k v
}
lookup :: Ord k => Map k v -> k -> v
lookup m = fromMaybe (mapDefVal m) . treeLookup (mapTree m)
```

Such an implementation gives us all of the asymptotics of a tree-based map, but the denotations of (and therefore the *intuitions* behind) functions.

Hopefully this worked example has given you some insight into how the process of denotational design works. Guess at a denotation and then ruthlessly refine it until you get something that captures the real essence of what you're trying to model. It's an spectacularly rewarding experience to find an elegant solution to a half-baked idea, and your users will thank you to boot.

]]>As of yesterday, I have typeclass resolution working. The algorithm to desugar constraints into dictionaries hasn't been discussed much. Since it's rather involved, and quite interesting, I thought it might make a good topic for a blog post.

Our journey begins having just implemented Algorithm W aka Hindley-Milner. This is pretty well described in the literature, and there exist several implementations of it in Haskell, so we will not dally here. Algorithm W cashes out in a function of the type:

`infer :: SymTable VName Type -> Exp VName -> TI Type`

where `SymTable VName`

is a mapping from identifiers in scope to their types, `Exp VName`

is an expression we want to infer, and `TI`

is our type-inference monad. As a monad, `TI`

gives us the ability to generate fresh type variables, and to unify types as we go. `Type`

represents an unqualified type, which is to say it can be used to describe the types `a`

, and `Int`

, but not `Eq a => a`

. We will be implementing qualified types in this blog post.

`infer`

is implemented as a catamorphism, which generates a fresh type variable for every node in the expression tree, looks up free variables in the `SymTable`

and attempts to unify as it goes.

The most obvious thing we need to do in order to introduce constraints to our typechecker is to be able to represent them, so we two types:

```
infixr 0 :=>
data Qual t = (:=>)
{ qualPreds :: [Pred]
, unqualType :: t
} deriving (Eq, Ord, Functor, Traversable, Foldable)
data Pred = IsInst
{ predCName :: TName
, predInst :: Type
} deriving (Eq, Ord)
```

Cool. A `Qual Type`

is now a qualified type, and we can represent `Eq a => a`

via `[IsInst "Eq" "a"] :=> "a"`

(assuming `OverloadedStrings`

is turned on.) With this out of the way, we'll update the type of `infer`

so its symbol table is over `Qual Types`

, and make it return a list of `Pred`

s:

`infer :: SymTable VName (Qual Type) -> Exp VName -> TI ([Pred], Type)`

We update the algebra behind our `infer`

catamorphism so that adds any `Pred`

s necessary when instantiating types:

```
infer sym (V a) =
case lookupSym a sym of
Nothing -> throwE $ "unbound variable: '" <> show a <> "'"
Just sigma -> do
(ps :=> t) <- instantiate a sigma
pure (ps, t)
```

and can patch any other cases which might generate `Pred`

s. At the end of our cata, we'll have a big list of constraints necessary for the expression to typecheck.

As a first step, we'll just write the type-checking part necessary to implement this feature. Which is to say, we'll need a system for discharging constraints at the type-level, without necessarily doing any work towards code generation.

Without the discharging step, for example, our algorithm will typecheck `(==) (1 :: Int)`

as `Eq Int => Int -> Bool`

, rather than `Int -> Bool`

(since it knows `Eq Int`

.)

Discharging is a pretty easy algorithm. For each `Pred`

, see if it matches the instance head of any instances you have in scope; if so, recursively discharge all of the instance's context. If you are unable to find any matching instances, just keep the `Pred`

. For example, given the instances:

```
instance Eq Int
instance (Eq a, Eq b) => Eq (a, b)
```

and a `IsInst "Eq" ("Int", "c")`

, our discharge algorithm will look like this:

```
discharging: Eq (Int, c)
try: Eq Int --> does not match
try: Eq (a, b) --> matches
remove `Eq (Int, c)` pred
match types:
a ~ c
b ~ Int
discharge: Eq Int
discharge: Eq c
discharging: Eq Int
try: Eq Int --> matches
remove `Eq Int` pred
discharging: Eq c
try: Eq Int --> does not match
try: Eq (a, b) --> does not match
keep `Eq c` pred
```

We can implement this in Haskell as:

```
match :: Pred -> Pred -> TI (Maybe Subst)
getInsts :: ClassEnv -> [Qual Pred]
discharge :: ClassEnv -> Pred -> TI (Subst, [Pred])
discharge cenv p = do
-- find matching instances and return their contexts
matchingInstances <-
for (getInsts cenv) $ \(qs :=> t) -> do
-- the alternative here is to prevent emitting kind
-- errors if we compare this 'Pred' against a
-- differently-kinded instance.
res <- (fmap (qs,) <$> match t p) <|> pure Nothing
pure $ First res
case getFirst $ mconcat matchingInstances of
Just (qs, subst) ->
-- match types in context
let qs' = sub subst qs
-- discharge context
fmap mconcat $ traverse (discharge cenv) qs'
Nothing ->
-- unable to discharge
pure (mempty, pure p)
```

Great! This works as expected, and if we want to only write a type-checker, this is sufficient. However, we don't want to only write a type-checker, we also want to generate code capable of using these instances too!

We can start by walking through the transformation in Haskell, and then generalizing from there into an actual algorithm. Starting from a class definition:

```
class Functor f where
fmap :: (a -> b) -> f a -> f b
```

we will generate a dictionary type for this class:

```
data @Functor f = @Functor
{ @fmap :: (a -> b) -> f a -> f b
}
```

(I'm using the `@`

signs here because these things are essentially type applications. That being said, there will be no type applications in this post, so the `@`

should always be understood to be machinery generated by the compiler for dictionary support.)

Such a definition will give us the following terms:

```
@Functor :: ((a -> b) -> f a -> f b) -> @Functor f
@fmap :: @Functor f -> (a -> b) -> f a -> f b
```

Notice that `@fmap`

is just `fmap`

but with an explicit dictionary (`@Functor f`

) being passed in place of the `Functor f`

constraint.

From here, in order to actually construct one of these dictionaries, we can simply inline an instances method:

```
instance Functor Maybe where
fmap = \f m -> case m of { Just x -> Just (f x); Nothing -> Nothing }
-- becomes
@Functor@Maybe :: @Functor Maybe
@Functor@Maybe =
@Functor
{ @fmap = \f m -> case m of { Just x -> Just (f x); Nothing -> Nothing }
}
```

Now we need to look at how these dictionaries actually get used. It's clear that every `fmap`

in our expression tree should be replaced with `@fmap d`

for some `d`

. If the type of `d`

is monomorphic, we can simply substitute the dictionary we have:

```
x :: Maybe Int
x = fmap (+5) (Just 10)
-- becomes
x :: Maybe Int
x = @fmap @Functor@Maybe (+5) (Just 10)
```

but what happens if the type `f`

is polymorphic? There's no dictionary we can reference statically, so we'll need to take it as a parameter:

```
y :: Functor f => f Int -> f Int
y = \z -> fmap (+5) z
-- becomes
y :: @Functor f -> f Int -> f Int
y = \d -> \z -> @fmap d (+5) z
```

A reasonable question is when should we insert these lambdas to bind the dictionaries? This stumped me for a while, but the answer is whenever you get to a binding group; which is to say whenever your expression is bound by a `let`

, or whenever you finish processing a top-level definition.

One potential gotcha is what should happen in the case of instances with their own contexts? For example, `instance (Eq a, Eq b) => Eq (a, b)`

? Well, the same rules apply; since `a`

and `b`

are polymorphic constraints, we'll need to parameterize our `@Eq@(,)`

dictionary by the dictionaries witnessing `Eq a`

and `Eq b`

:

```
instance (Eq a, Eq b) => Eq (a, b) where
(==) = \ab1 ab2 -> (==) (fst ab1) (fst ab2)
&& (==) (snd ab1) (snd ab2)
-- becomes
@Eq@(,) :: @Eq a -> @Eq b -> @Eq (a, b)
@Eq@(,) = \d1 -> \d2 ->
@Eq
{ (@==) = \ab1 ab2 -> (@==) d1 (fst ab1) (fst ab2)
&& (@==) d2 (snd ab1) (snd ab2)
}
```

Super-class constraints behave similarly.

So with all of the theory under our belts, how do we actually go about implementing this? The path forward isn't as straight-forward as we might like; while we're type-checking we need to desugar terms with constraints on them, but the result of that desugaring depends on the eventual type these terms receive.

For example, if we see `(==)`

in our expression tree, we want to replace it with `(@==) d`

where `d`

might be `@Eq@Int`

, or it might be `@Eq@(,) d1 d2`

, or it might just stay as `d`

! And the only way we'll know what's what is *after* we've performed the dischargement of our constraints.

As usual, the solution is to slap more monads into the mix:

```
infer
:: SymTable VName (Qual Type)
-> Exp VName
-> TI ( [Pred]
, Type
, Reader (Pred -> Exp VName)
(Exp VName)
)
```

Our `infer`

catamorphism now returns an additional `Reader (Pred -> Exp VName) (Exp VName)`

, which is to say an expression that has access to which expressions it should substitute for each of its `Pred`

s. We will use this mapping to assign dictionaries to `Pred`

s, allowing us to fill in the dictionary terms once we've figured them out.

We're in the home stretch; now all we need to do is to have `discharge`

build that map from `Pred`

s into their dictionaries and we're good to go.

```
getDictTerm :: Pred -> Exp VName
getDictTypeForPred :: Pred -> Type
-- DSL-level function application
(:@) :: Exp VName -> Exp VName -> Exp VName
discharge
:: ClassEnv
-> Pred
-> TI ( Subst
, [Pred]
, Map Pred (Exp VName)
, [Assump Type]
, [Exp VName]
)
discharge cenv p = do
matchingInstances <-
for (getInsts cenv) $ \(qs :=> t) -> do
res <- (fmap (qs, t, ) <$> match t p) <|> pure Nothing
pure $ First res
case getFirst $ mconcat matchingInstances of
Just (qs, t, subst) ->
-- discharge all constraints on this instance
(subst', qs', mapPreds, assumps, subDicts)
<- fmap mconcat
. traverse (discharge cenv)
$ sub subst qs
let dictTerm = getDictTerm t
myDict = foldl (:@) dictTerm subDicts
pure ( subst'
, qs'
, mapPreds <> M.singleton p myDict
, assumps
-- this is just in a list so we can use 'mconcat' to
-- collapse our traversal
, [myDict]
)
Nothing ->
-- unable to discharge, so assume the existence of a new
-- variable with the correct type
param <- newVName "d"
pure ( mempty
, [p]
, M.singleton p param
, [MkAssump param $ getDictTypeForPred p]
, [param]
)
```

The logic of `discharge`

is largely the same, except we have a little more logic being driven by its new type. We now, in addition to our previous substitution and new predicates, also return a map expanding dictionaries, a list of `Assump`

s (more on this in a second), and the resulting dictionary witnessing this discharged `Pred`

.

If we were successful in finding a matching instance, we discharge each of its constraints, and fold the resulting dictionaries into ours. The more interesting logic is what happens if we are unable to discharge a constraint. In that case, we create a new variable of the necessary type, give that as our resulting dictionary, and emit it as an `Assump`

. `Assump`

s are used to denote the creation of a new variable in scope (they are also used for binding pattern matches).

The result of our new `discharge`

function is that we have a map from every `Pred`

we saw to the resulting dictionary for that instance, along with a list of generated variables. We can build our final expression tree via running the `Reader (Pred -> Exp VName)`

by looking up the `Pred`

s in our dictionary map. Finally, for every assumption we were left with, we fold our resulting term in a lambda which binds that assumption.

Very cool! If you're interested in more of the nitty-gritty details behind compiling Haskell98, feel free to SMASH THAT STAR BUTTON on Github.

]]>One of the biggest concerns over the HKD technique was that it breaks automated deriving of instances. This is not entirely true, it just requires turning on `{-# LANGUAGE StandaloneDeriving #-}`

and then using one of two approaches.

The simplest method is that we can simply derive all of our instances only for the types we expect to use:

```
deriving instance Eq (Person' Identity)
deriving instance Eq (Person' Maybe)
deriving instance Ord (Person' Identity)
deriving instance Ord (Person' Maybe)
```

Admittedly it's kind of a shit solution, but technically it does work.

An alternative approach is to automatically lift these instances from `f a`

over the `HKD f a`

type family. The construction is a little more involved than I want to get into today, but thankfully it's available as library code from the spiffy `one-liner`

package.

After adding `one-liner`

as a dependency, we can lift our instances over a polymorphic `f`

using the `Constraints`

type-synonym:

`deriving instance (Constraints (Person' f) Eq) => Eq (Person' f)`

Easy!

The other big concern was over whether we pay performance costs for getting so many cool things for free.

For the most part, if you mark all of your generic type-class methods as `INLINE`

and turn on `-O2`

, most of the time you're not going to pay any runtime cost for using the HKD technique.

Don't believe me? I can prove it, at least for our free lenses.

Let's fire up the `inspection-testing`

package, which allows us to write core-level equalities that we'd like the compiler to prove for us. The equality we want to show is that the core generated for using our free lenses is exactly what would be generated by using hand-written lenses.

We can do this by adding some front-matter to our module:

```
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-}
import Test.Inspection
```

This installs the `inspection-testing`

compiler plugin, which is responsible for doing the work for us. Next, we'll define our lenses:

```
freeName :: Lens' (Person' Identity) String
Person (LensFor freeName) _ = getLenses
handName :: Lens' (Person' Identity) String
handName a2fb s = a2fb (pName s) <&> \b -> s { pName = b }
```

and finally, we can write the equalities we'd like GHC to prove for us. This is done in two steps -- writing top-level left- and right- handed sides of the equality, and then writing a TemplateHaskell splice to generate the proof.

```
viewLhs, viewRhs :: Person' Identity -> String
viewLhs = view freeName
viewRhs = view handName
inspect $ 'viewLhs === 'viewRhs
```

Compiling this dumps some new information into our terminal:

```
src/Main.hs:34:1: viewLhs === viewRhs passed.
inspection testing successful
expected successes: 1
```

We can write an analogy equality to ensure that the generated setter code is equivalent:

```
setLhs, setRhs :: String -> Person' Identity -> Person' Identity
setLhs y = freeName .~ y
setRhs y = handName .~ y
inspect $ 'setLhs === 'setRhs
```

And upon compiling this:

```
src/Main.hs:34:1: viewLhs === viewRhs passed.
src/Main.hs:35:1: setLhs === setRhs passed.
inspection testing successful
expected successes: 2
```

Cool! Just to satisfy your curiosity, the actual lenses themselves aren't equivalent:

`inspect $ 'freeName === 'handName`

results in a big core dump showing that `freeName`

is a gross disgusting chain of `fmap`

s and that `handName`

is pretty and elegant. And the module fails to compile, which is neat -- it means we can write these proofs inline and the compiler will keep us honest if we ever break them.

But what's cool here is that even though our lenses do *not* result in equivalent code, actually using them does -- which means that under most circumstances, we won't be paying to use them.

`* -> *`

, and subsequently wrapping each of its fields by this parameter. The example we used previously was transforming this type:
```
data Person = Person
{ pName :: String
, pAge :: Int
} deriving (Generic)
```

into its HKD representation:

```
data Person' f = Person
{ pName :: HKD f String
, pAge :: HKD f Int
} deriving (Generic)
```

Recall that `HKD`

is a type family given by

```
type family HKD f a where
HKD Identity a = a
HKD f a = f a
```

which is responsible for stripping out an `Identity`

wrapper. This means we can recreate our original `Person`

type via `type Person = Person' Identity`

, and use it in all the same places we used to be able to.

Our previous exploration of the topic unearthed some rather trivial applications of this approach; we generated a function `validate :: f Maybe -> Maybe (f Identity)`

which can roughly be described as a "type-level `sequence`

." In fact, in the comments, Syrak pointed out we can implement this function in a less-round-about way via `gtraverse id`

.

So, how about we do something a little more interesting today? Let's generate lenses for arbitrary product types.

In my opinion, one of the biggest advantages of the HKD approach is it answers the question "where can we put this stuff we've generated?" Generating lenses generically is pretty trivial (once you have wrapped your head around the mind-boggling types), but the harder part is where to put it. The `lens`

package uses TemplateHaskell to generate new top-level bindings so it has somewhere to put the lenses. But we have HKD.

Recall, our `Person'`

type:

```
data Person' f = Person
{ pName :: HKD f String
, pAge :: HKD f Int
} deriving (Generic)
```

By substituting `f ~ Lens' (Person' Identity)`

, we'll have `pName :: Lens' (Person' Identity) String`

, which is exactly the type we need. All of a sudden it looks like we have an answer to "where should we put it": inside our original structure itself. If we can generate a record of type `Person' (Lens' (Person' Identity)`

, destructuring such a thing will give us the lenses we want, allowing us to name them when we do the destructuring. Cool!

Unfortunately, we're unable to partially apply type-synonyms, so we'll need to introduce a new type constructor that we *can* partially apply. Enter `LensesFor`

:

```
data LensFor s a = LensFor
{ getLensFor :: Lens' s a
}
```

The next step is to *think really hard* about what our lens-providing type-class should look like. At the risk of sounding like a scratched CD in a walkman, I consider the design of the typeclass to be by far the hardest part of this approach. So we'll work through the derivation together:

I always begin with my "template" generic-deriving class:

```
class GLenses i o where
glenses :: i p -> o p
```

where `p`

is a mysterious existentialized type parameter "reserved for future use" by the `GHC.Generics`

interface. Recall that `i`

is the incoming type for the transformation (*not* the original `Person'`

type), and `o`

is correspondingly the output type of the transformation.

Since lenses don't depend on a particular "input" record -- they should be able to be generated *ex nihilo* -- we can drop the `i p`

parameter from `glenses`

. Furthermore, since eventually our lenses are going to depend on our "original" type (the `Person'`

in our desired `LensesFor (Person' Identity)`

), we'll need another parameter in our typeclass to track that. Let's call it `z`

.

```
class GLenses z i o where
glenses :: o p
```

As far as methods go, `glenses`

is pretty unsatisfactory right now; it leaves most of its type parameters ambiguous. No good. We can resolve this issue by realizing that we're going to need to actually provide lenses at the end of the day, and because `GHC.Generics`

doesn't give us any such functionality, we'll need to write it ourselves. Which implies we're going to need to do structural induction as we traverse our generic `Rep`

resentation.

The trick here is that in order to provide a lens, we're going to need to have a lens to give. So we'll add a `Lens'`

to our `glenses`

signature -- but what type should it have? At the end of the day, we want to provide a `Lens' (z Identity) a`

where `a`

is the type of the field we're trying to get. Since we always want a lens starting from `z Identity`

, that pins down one side of our lens parameter.

```
class GLenses z i o where
glenses :: Lens' (z Identity) _ -> o p
```

We still have the notion of an `i`

nput to our `glenses`

, which we want to transform into our `o`

utput. And that's what tears it; if we have a lens from our original type where we currently are in our Generic traversal, we can transform that into a Generic structure which contains the lenses we want.

```
class GLenses z i o where
glenses :: Lens' (z Identity) (i p) -> o p
```

Don't worry if you're not entirely sure about the reasoning here; I wasn't either until I worked through the actual implementation. It took a few iterations to get right. Like I said, figuring out what this method should look like is by far the hardest part. Hopefully going through the rest of the exercise will help convince us that we got our interface correct.

With our typeclass pinned down, we're ready to begin our implementation. We start, as always, with the base case, which here is "what should happen if we have a `K1`

type?" Recall a `K1`

corresponds to the end of our generic structural induction, which is to say, this is a type that isn't ours. It's the `HKD f String`

in `pName :: HKD f String`

from our example.

So, if we have an `a`

wrapped in a `K1`

, we want to instead produce a `LensFor (z Identity) a`

wrapped in the same.

```
instance GLenses z (K1 _x a)
(K1 _x (LensFor (z Identity) a)) where
glenses l = K1 -- [3]
$ LensFor -- [2]
$ \f -> l $ fmap K1 . f . unK1 -- [1]
{-# INLINE glenses #-}
```

Egads there's a lot going on here. Let's work through it together. In [1], we transform the lens we were given (`l`

) so that it will burrow through a `K1`

constructor -- essentially turning it from a `Lens' (z Identity) (K1 _x a)`

into a `Lens' (z Identity) a`

. At [2], we wrap our generated lens in the `LensFor`

constructor, and then in [3] we wrap our generated lens back in the `GHC.Generics`

machinery so we can transform it back into our HKD representation later.

And now for our induction. The general idea here is that we're going to need to transform the lens we got into a new lens that focuses down through our generic structure as we traverse it. We can look at the `M1`

case because it's babby's first instance when compared to `K1`

:

```
instance (GLenses z i o)
=> GLenses z (M1 _a _b i) (M1 _a _b o) where
glenses l = M1 $ glenses $ \f -> l $ fmap M1 . f . unM1
{-# INLINE glenses #-}
```

Here we're saying we can lift a `GLenses z i o`

over an `M1`

constructor by calling `glenses`

with an updated lens that will burrow through the `M1`

-ness. This transformation is completely analogous to the one we did for `K1`

. Once we have our generated lenses, we need to re-wrap the structure in an `M1`

constructor so we can transform it back into our HKD representation.

The product case looks a little trickier, but it's only because `GHC.Generics`

doesn't provide us with any useful un/wrapping combinators for the `(:*:)`

constructor.

```
instance (GLenses z i o, GLenses z i' o')
=> GLenses z (i :*: i') (o :*: o') where
glenses l = glenses (\f -> l (\(a :*: b) -> fmap (:*: b) $ f a))
:*: glenses (\f -> l (\(a :*: b) -> fmap (a :*:) $ f b))
{-# INLINE glenses #-}
```

We finish it off with the trivial instances for `V1`

and `U1`

:

```
instance GLenses z V1 V1 where
glenses l = undefined
instance GLenses z U1 U1 where
glenses l = U1
```

And voila! Our induction is complete. Notice that we *did not* write an instance for `(:+:)`

(coproducts), because lenses are not defined for coproduct types. This is fine for our `Person'`

case, which has no coproducts, but types that do will simply be unable to find a `GLenses`

instance, and will fail to compile. No harm, no foul.

With this out of the way, we need to write our final interface that will use all of the generic machinery and provide nice access to all of this machinery. We're going to need to call `glenses`

(obviously), and pass in a `Lens' (z Identity) (Rep (z Identity))`

in order to get the whole thing running. Then, once everything is build, we'll need to call `to`

to turn our generic representation back into the HKD representation.

But how can we get a `Lens'(z Identity) (Rep (z Identity))`

? Well, we know that `GHC.Generics`

gives us an isomorphism between a type and its `Rep`

, as witnessed by `to`

and `from`

. We further know that every `Iso`

is indeed a `Lens`

, and so the lens we want is just `iso from to`

. Our function, then, is "simply":

```
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
getLenses
:: forall z
. ( Generic (z Identity)
, Generic (z (LensFor (z Identity)))
, GLenses z (Rep (z Identity))
(Rep (z (LensFor (z Identity))))
)
=> z (LensFor (z Identity))
getLenses = to $ glenses @z $ iso from to
```

where I just wrote the `z (LensFor (z Identity))`

part of the type signature, and copy-pasted constraints from the error messages until the compiler was happy.

OK, so let's take it for a spin, shall we? We can get our lenses thusly:

`Person (LensFor lName) (LensFor lAge) = getLenses`

Yay! Finally we can ask GHCi for their types, which is a surprisingly satisfying experience:

```
> :t lName
lName :: Lens' (Person' Identity) String
```

Pretty sweet, ne? Now that `getLenses`

has been implemented generically, it can become library code that will work for any product-type we can throw at it. Which means free lenses without TemplateHaskell for any types we define in the HKD form.

This HKD pattern is useful enough that I've begun implement literally all of my "data" (as opposed to "control") types as higher-kinded data. With an extra type synonym `type X = X' Identity`

, and `{-# LANGUAGE TypeSynonymInstances #-}`

, nobody will ever know the difference, except that it affords me the ability to use all of this stuff in the future should I want to.

As Conal says, all of this stuff might not necessarily be "for free" but at the very least, it's "already paid for."

More shoutouts to Travis Athougies, whose sweet library beam uses this approach to generate lenses for working with SQL tables. I consulted the beam source more than a couple times in writing this post. Thanks again, Travis!

]]>`sequence`

over data-types; and automatically track dependencies for usages of record fields.
As for this post, we'll look at how to build type-level sequencing, and investigate some other uses in subsequent ones. For our examples, let's define the following (completely arbitrary) data-type:

```
data Person = Person
{ pName :: String
, pAge :: Int
} deriving (Generic)
```

That's cool and all, I guess. For purposes of discussion, let's imagine that we want to let the user fill in a `Person`

via a web-form or something. Which is to say, it's possible they'll screw up filling in some piece of information without necessarily invalidating the rest of the datastructure. If they successfully filled in the entire structure, we'd like to get a `Person`

out.

One way of modeling this would be with a second datatype:

```
data MaybePerson = MaybePerson
{ mpName :: Maybe String
, mpAge :: Maybe Int
} deriving (Generic)
```

and a function:

```
validate :: MaybePerson -> Maybe Person
validate (MaybePerson name age) =
Person <$> name <*> age
```

This works, but it's annoying to write by hand, since it's completely mechanical. Furthermore, having duplicated this effort means we'll need to use our brains in the future to make sure all three definitions stay in sync. Wouldn't it be cool if the compiler could help with this?

SURPRISE! IT CAN! And that's what I want to talk about today.

Notice that we can describe both `Person`

and `MaybePerson`

with the following higher-kinded data (henceforth "**HKD**") definition:

```
data Person' f = Person
{ pName :: f String
, pAge :: f Int
} deriving (Generic)
```

Here we've parameterized `Person'`

over something `f`

(of kind `* -> *`

), which allows us to do the following in order to get our original types back:

```
type Person = Person' Identity
type MaybePerson = Person' Maybe
```

While this works, it's kind of annoying in the `Person`

case, since now all of our data is wrapped up inside of an `Identity`

:

```
> :t pName @Identity
pName :: Person -> Identity String
> :t runIdentity . pName
runIdentity . pName :: Person -> String
```

We can fix this annoyance trivially, after which we will look at why defining `Person'`

as such is actually useful. To get rid of the `Identity`

s, we can use a type family (a function at the type-level) that erases them:

```
{-# LANGUAGE TypeFamilies #-}
-- "Higher-Kinded Data"
type family HKD f a where
HKD Identity a = a
HKD f a = f a
data Person' f = Person
{ pName :: HKD f String
, pAge :: HKD f Int
} deriving (Generic)
```

Using the `HKD`

type family means that GHC will automatically erase any `Identity`

wrappers in our representations:

```
> :t pName @Identity
pName :: Person -> String
> :t pName @Maybe
pName :: Person -> Maybe String
```

and with that, the higher-kinded version of `Person`

can be used as a drop-in replacement for our original one. The obvious question is what have we bought ourselves with all of this work. Let's look back at `validate`

to help us answer this question. Compare our old implementation:

```
validate :: MaybePerson -> Maybe Person
validate (MaybePerson name age) =
Person <$> name <*> age
```

with how we can now rewrite it with our new machinery:

```
validate :: Person' Maybe -> Maybe Person
validate (Person name age) =
Person <$> name <*> age
```

Not a very interesting change is it? But the intrigue lies in how little needed to change. As you can see, only our type and pattern match needed to change from our original implementation. What's neat here is that we have now consolidated `Person`

and `MaybePerson`

into the same representation, and therefore they are no longer related only in a nominal sense.

We can write a version of `validate`

that will work for any higher-kinded datatype.

The secret is to turn to `GHC.Generics`

. If you're unfamiliar with them, they provide an isomorphism from a regular Haskell datatype to a generic representation that can be structurally manipulated by a clever programmer (ie: us.) By providing code for what to do for constant types, products and coproducts, we can get GHC to write type-independent code for us. It's a really neat technique that will tickle your toes if you haven't seen it before.

To start with, we need to define a typeclass that will be the workhorse of our transformation. In my experience, this is always the hardest part -- the types of these generic-transforming functions are exceptionally abstract and in my opinion, very hard to reason about. I came up with this:

```
{-# LANGUAGE MultiParamTypeClasses #-}
class GValidate i o where
gvalidate :: i p -> Maybe (o p)
```

I only have "soft-and-slow" rules for reasoning about what your typeclass should look like, but in general you're going to need both an `i`

nput and an `o`

utput parameter. They both need to be of kind `* -> *`

and then be passed this existentialized `p`

, for dark, unholy reasons known not by humankind. I then have a little checklist I walk through to help me wrap my head around this nightmarish hellscape that we'll walk through in a later installment of the series.

Anyway, with our typeclass in hand, it's now just a matter of writing out instances of our typeclass for the various GHC.Generic types. We can start with the base case, which is we should be able to validate a `Maybe k`

:

```
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
instance GValidate (K1 a (Maybe k)) (K1 a k) where
-- gvalidate :: K1 a (Maybe k) -> Maybe (K1 a k)
gvalidate (K1 k) = K1 <$> k
{-# INLINE gvalidate #-}
```

`K1`

represents a "constant type", which is to say that it's where our structural recursion conks out. In our `Person'`

example, it's the `pName :: HKD f String`

bit.

Most of the time, once you have the base case in place, the rest is to just mechanically provide instances for the other types. Unless you need to access metadata about the original type anywhere, these instances will almost always be trivial homomorphisms.

We can start with products -- if we have `GValidate i o`

and `GValidate i' o'`

, we should be able to run them in parallel:

```
instance (GValidate i o, GValidate i' o')
=> GValidate (i :*: i') (o :*: o') where
gvalidate (l :*: r) = (:*:)
<$> gvalidate l
<*> gvalidate r
{-# INLINE gvalidate #-}
```

If `K1`

referred directly to the selectors of our `Person'`

, `(:*:)`

corresponds roughly to the `,`

piece of syntax we separate our record fields with.

We can define a similar instance of `GValidate`

for coproducts (corresponding to a `|`

in a data definition):

```
instance (GValidate i o, GValidate i' o')
=> GValidate (i :+: i') (o :+: o') where
gvalidate (L1 l) = L1 <$> gvalidate l
gvalidate (R1 r) = R1 <$> gvalidate r
{-# INLINE gvalidate #-}
```

Furthermore, if we don't care about looking at metadata, we can simply lift a `GValidate i o`

over the metadata constructor:

```
instance GValidate i o
=> GValidate (M1 _a _b i) (M1 _a' _b' o) where
gvalidate (M1 x) = M1 <$> gvalidate x
{-# INLINE gvalidate #-}
```

Just for kicks, we can provide the following trivial instances, for uninhabited types (`V1`

) and for constructors without any parameters (`U1`

):

```
instance GValidate V1 V1 where
gvalidate = undefined
{-# INLINE gvalidate #-}
instance GValidate U1 U1 where
gvalidate U1 = Just U1
{-# INLINE gvalidate #-}
```

The use of `undefined`

here is safe, since it can only be called with a value of `V1`

. Fortunately for us, `V1`

is uninhabited, so this can never happen, and thus we're morally correct in our usage of `undefined`

.

Without further ado, now that we have all of this machinery out of the way, we can finally write a non-generic version of `validate`

:

```
{-# LANGUAGE FlexibleContexts #-}
validate
:: ( Generic (f Maybe)
, Generic (f Identity)
, GValidate (Rep (f Maybe))
(Rep (f Identity))
)
=> f Maybe
-> Maybe (f Identity)
validate = fmap to . gvalidate . from
```

I always get a goofy smile when the signature for my function is longer than the actual implementation; it means we've hired the compiler to write code for us. What's neat about `validate`

here is that it doesn't have any mention of `Person'`

; this function will work for *any* type defined as higher-kinded data. Spiffy.

That's all for today, folks. We've been introduced to the idea of higher-kinded data, seen how it's completely equivalent with a datatype defined in a more traditional fashion, and also caught a glimmer of what kind of things are possible with this approach. This is where we stop for today, but in the next post we'll look at how we can use the HKD approach to generate lenses without resorting to TemplateHaskell.

Happy higher-kinding!

Big shoutouts to Travis Athougies from whom I originally learned this technique, and to Ariel Weingarten and Fintan Halpenny for proofreading earlier versions of this post.

]]>The first thing we need to do is indicate to the game which parts of the background should be walkable. Like we did for marking hotspots, we'll use an image mask. Since we have way more density in an image than we'll need for this, we'll overlay it on the hotspot mask.

Again, if the room looks like this:

Our mask image would look like this:

Here, the walkable section of the image is colored in blue. You'll notice there's a hole in the walk mask corresponding to the table in the room; we wouldn't want our avatar to find a path that causes him to walk through the table.

However there is something important to pay attention to here; namely that we're making an adventure game. Which is to say that our navigation system doesn't need to be all that good; progress in the game is blocked more by storytelling and puzzles than it is by the physical location of the player (unlike, for example, in a platformer game.) If the avatar does some unnatural movement as he navigates, it might be *immersion-breaking*, but it's not going to be *game-breaking*.

Which means we can half ass it, if we need to. But I'm getting ahead of myself.

The first thing we're going to need is a function which samples our image mask and determines if a given position is walkable.

```
canWalkOn :: Image PixelRGBA8 -> V2 Int -> Bool
canWalkOn img (V2 x y)
= flip testBit walkableBit
. getWalkableByte
$ pixelAt img x y
where
getWalkableByte (PixelRGBA8 _ _ b _) = b
walkableBit = 7
```

Currying this function against our image mask gives us a plain ol' function which we can use to query walk-space.

In a 3D game, you'd use an actual mesh to mark the walkable regions, rather than using this mask thing. For that purpose, from here on out we'll call this thing a navmesh, even though it isn't strictly an appropriate name in our case.

Because pathfinding algorithms are defined in terms of graphs, the next step is to convert our navmesh into a graph. There are lots of clever ways to do this, but remember, we're half-assing it. So instead we're going to do something stupid and construct a square graph by sampling every *n* pixels, and connecting it to its orthogonal neighbors if both the sample point and its neighbor are walkable.

It looks like this:

Given the navmesh, we sample every *n* points, and determine whether or not to put a graph vertex there (white squares are vertices, the black squares are just places we sampled.) Then, we put an edge between every neighboring vertex (the white lines.)

We're going to want to run A* over this graph eventually, which is implemented in Haskell via `Data.Graph.AStar.aStar`

. This package uses an implicit representation of this graph rather than taking in a graph data structure, so we'll construct our graph in a manner suitable for `aStar`

.

But first, let's write some helper functions to ensure we don't get confused about whether we're in world space or navigation space.

```
-- | Sample every n pixels in on the navmesh.
sampleRate :: Float
sampleRate = 4
-- | Newtype to differentiate nav node coordinates from world coordinates.
newtype Nav = Nav { unNav :: Int }
deriving (Eq, Ord, Num, Integral, Real)
toNav :: V2 Float -> V2 Nav
toNav = fmap round
. fmap (/ sampleRate)
fromNav :: V2 Nav -> V2 Float
fromNav = fmap (* sampleRate)
. fmap fromIntegral
```

`toNav`

and `fromNav`

are roughly inverses of one another -- good enough for half-assing it at least. We'll do all of our graph traversal stuff in nav-space, and use world-space only at the boundaries.

We start with some helper functions:

```
navBounds :: Image a -> V2 Nav
navBounds = subtract 1
. toNav
. fmap fromIntegral
. imageSize
```

`navBound`

gives us the largest valid navigation point from an image -- this will be useful later when we want to build a graph and *don't* want to sample points that are not on it.

The next step is our `neighbors`

function, which should compute the edges for a given node on the navigation step.

```
neighbors :: Image PixelRGBA8 -> V2 Nav -> HashSet (V2 Nav)
neighbors img v2 = HS.fromList $ do
let canWalkOn' = canWalkOn img
. fmap floor
. fmap fromNav
V2 x y <- fmap (v2 &)
[ _x -~ 1
, _x +~ 1
, _y -~ 1
, _y +~ 1
]
guard $ canWalkOn' v2
guard $ x >= 0
guard $ x <= w
guard $ y >= 0
guard $ y <= h
guard . canWalkOn' $ V2 x y
return $ V2 x y
```

We use the list monad here to construct all of the possible neighbors -- those which are left, right, above and below our current location, respectively. We then guard on each, ensure our current nav point is walkable, that our candidate neighbor is within nav bounds, and finally that the candidate itself is walkable. We need to do this walkable check last, since everything will explode if we try to sample a pixel that is not in the image.

Aside: if you actually have a mesh (or correspondingly a polygon in 2D), you can bypass all of this sampling nonsense by tessellating the mesh into triangles, and using the results as your graph. In my case I didn't have a polygon, and I didn't want to write a tessellating algorithm, so I went with this route instead.

Finally we need a distance function, which we will use both for our astar heuristic as well as our actual distance. The actual distance metric we use doesn't matter, so long as it corresponds monotonically with the actual distance. We'll use distance squared, because it has this monotonic property we want, and saves us from having to pay the cost of computing square roots.

```
distSqr :: V2 Nav -> V2 Nav -> Float
distSqr x y = qd (fmap fromIntegral x) (fmap fromIntegral y)
```

And with that, we're all set! We can implement our pathfinding by filling in all of the parameters to `aStar`

:

```
pathfind :: Image PixelRGBA8 -> V2 Float -> V2 Float -> Maybe [V2 Float]
pathfind img = \src dst ->
fmap fromNav <$> aStar neighbors distSqr (distSqr navDst) navSrc
where
navSrc = toNav src
navDst = toNav dst
```

Sweet. We can run it, and we'll get a path that looks like this:

Technically correct, in that it does in fact get from our source location to our destination. But it's obviously half-assed. This isn't the path that a living entity would take; as a general principle we try not to move in rectangles if we can help it.

We can improve on this path by attempting to shorten it. In general this is a hard problem, but we can solve that by giving it the old college try.

Our algorithm to attempt to shorten will be a classic divide and conquer approach -- pick the two endpoints of your current path, and see if there is a straight line between the two that is walkable throughout its length. If so, replace the path with the line you just constructed. If not, subdivide your path in two, and attempt to shorten each half of it.

Before we actually get into the nuts and bolts of it, here's a quick animation of how it works. The yellow circles are the current endpoints of the path being considered, and the yellow lines are the potential shortened routes. Whenever we can construct a yellow line that doesn't leave the walkable region, we replace the path between the yellow circles with the line.

The "divide and conquer" bit of our algorithm is easy to write. We turn our path list into a `Vector`

so we can randomly access it, and then call out to a helper function `sweepWalkable`

to do the nitty gritty stuff. We append the `src`

and `dst`

to the extrema of the constructed vector because `aStar`

won't return our starting point in its found path, and because we quantized the `dst`

when we did the pathfinding, so the last node on the path is the closest navpoint, rather than being where we asked the character to move to.

```
shorten :: Image PixelRGBA8 -> V2 Float -> V2 Float -> [V2 Float] -> [V2 Float]
shorten img src dst path =
let v = V.fromList $ (src : path) ++ [dst]
in go 0 (V.length v - 1) v
where
go l u v =
if sweepWalkable img (v V.! l) (v V.! u)
then [v V.! u]
else let mid = ((u - l) `div` 2) + l
in go l mid v ++ go mid u v
```

The final step, then, is to figure out what this `sweepWalkable`

thing is. Obviously it wants to construct a potential line between its endpoints, but we don't want to have to sample every damn pixel. Remember, we're half-assing it. Instead, we can construct a line, but actually only sample the nav points that are closest to it.

In effect this is "rasterizing" our line from its vector representation into its pixel representation.

Using the Pythagorean theorem in navigation space will give us the "length" of our line in navigation space, which corresponds to the number of navpoints we'll need to sample.

For example, if our line looks like this:

Then the number *n* of nav points we need to sample is:

$$
\begin{align*}
n &= \lfloor \sqrt{4^2 + 5^2} \rfloor \\
&= \lfloor \sqrt{16 + 25} \rfloor \\
&= \lfloor \sqrt{41} \rfloor \\
&= \lfloor 6.4 \rfloor \\
&= 6
\end{align*}
$$

We can then subdivide our line into 6 segments, and find the point on the grid that is closest to the end of each. These points correspond with the nodes that need to be walkable individually in order for our line itself to be walkable. This approach will fail for tiny strands of unwalkable terrain that slices through otherwise walkable regions, but maybe just don't do that? Remember, all we want is for it to be good enough -- half-assing it and all.

So, how do we do it?

```
sweepWalkable :: Image PixelRGBA8 -> V2 Float -> V2 Float -> Bool
sweepWalkable img src dst =
let dir = normalize $ dst - src
distInNavUnits = round $ distance src dst
bounds = navBounds img
in getAll . flip foldMap [0 .. distInNavUnits] $ \n ->
let me = src + dir ^* (fromIntegral @Int n)
in All . canWalkOn' img
. clamp (V2 0 0) bounds
$ toNav me
```

Sweet! Works great! Our final pathfinding function is thus:

```
navigate :: Image PixelRGBA8 -> V2 Float -> V2 Float -> Maybe [V2 Float]
navigate img src dst = fmap (shorten img src dst) $ pathfind src dst
```

Golden, baby.

Next time we'll talk about embedding a scripting language into our game so we don't need to wait an eternity for GHC to recompile everything whenever we want to change a line of dialog. Until then!

]]>An adventure game in which you're unable to interact with anything isn't much of a game, and that's where we left the engine. So it seemed like a thing to focus on next.

I knew that click/hold interaction that I wanted formed some sort of DFA, so I unwisely headed down that garden path for a bit. After implementing a bit, I found a state machine with the denotation of `type DFA s e a = s -> e -> Either s a`

, where `s`

is the state of the machine, `e`

is the type of an edge transition, and `a`

is the eventual output of the machine. Upon the final result, however, it became clear that I had fallen into an abstraction hole. I spent a bunch of time figuring out the implementation of this thing, and then afterwards realized it didn't actually solve my problem. Whoops. Amateur Haskell mistake :)

The problem is that transitioning into some state might need to make a monadic action in order to generate the next edge. For example, when you press down on the mouse button, we need to start a timer which will open the action menu when it expires. This could be alleviated by changing `Either`

to `These`

and letting `a ~ (Monad m => m b)`

, but that struck me as a pretty ugly hack, and getting the implementation of the denotation to work again was yucky.

So I decided that instead maybe I should write a dumb version of what I wanted, and find out how to abstract it later if I should need similar machinery again in the future. I burned my `DFA`

implementation in a fire.

This posed a problem, though, because if I wanted to write this for real I was going to need things to actually interact with, and I didn't yet have those. I decided to put the interaction sprint on hold, in order to focus more on having things with which to interact.

One abstraction I think in terms of when working with adventure games is that of the **hotspot**. A hotspot is a mask on the background image which indicates a static piece of interesting geometry. For example, a window that never moves would be baked into the background image of the room, and then a hotspot would be masked on top of it to allow the character to interact with it.

For example, if our room looks like this (thanks to MI2 for the temporary art):

Then our mask image would look like this:

We can add some logic to be able to read the mask:

```
mkHotspot
:: Image PixelRGBA8
-> (Word8 -> Bool)
-> Hotspot
-> Pos
-> Maybe Hotspot
mkHotspot img f h = bool Nothing (Just h)
. f
. getHotspotByte
. uncurry (pixelAt img)
. (\(V2 x y) -> (x, y))
. clampToWorld
. fmap round
where
clampToWorld = clamp (V2 0 0) $ imageSize img
getHotspotByte (PixelRGBA8 _ g _ _) = g
```

and now bake the first three parameters of this function when we construct our level definition.

In order to test these things, I gave added a field `_hsName :: Hotspot -> String`

in order to be able to test if my logic worked. The next step was to bind the click event to be able to call the `Pos -> Maybe Hotspot`

that I curried out of `mkHotspot`

and stuck into my `Room`

datastructure (`_hotspots :: Room -> Pos -> Maybe Hotspot`

).

I clicked around a bunch, and found that `print . fmap _hsName $ _hotspots currentRoom mousePos`

lined up with the door when I clicked on it. It seemed to be working, so I considered my first yak shave successful: I now had something in the world that I could interact with.

The next step was to code up a little bit of the DFA I was originally working on. I decided that I should make the avatar walk to the place you clicked if it wasn't a hotspot.

```
case event of
MouseButton Down ->
case _hotspots currentRoom mousePos of
Just hs ->
print $ _hsName hs
Nothing ->
when (isWalkable (_navmesh currentRoom) mousePos) $
emap $ do
with isAvatar
pure defEntity'
{ pathing = Set $ NavTo mousePos
}
```

So: when the mouse is pressed, see if it was over top of a hotspot. If so, print out the name of it. Otherwise, check the navmesh of the room, and see if that's a valid place to walk. If so, update any entity who has the `isAvatar`

component and set its `pathing`

component to be the location we want.

The engine at this point already has navigation primitives, which is why this works. We'll discuss how the navmesh is generated and used in another devlog post.

I ran this code and played around with it for a while. Everything looked good -- after I remembered to set `isAvatar`

on my player entity :)

The next step was to implement timers that would have a callback, and could be started and stopped. I'd need support for these in order to wait a little bit before opening up the action menu. Thankfully, timers are super easy: just have an amount of time you decrement every frame until it hits zero, and then do the necessary action. I came up with this model for timers:

```
data Timer = Timer
{ _tTime :: Time
, _tCallback :: Game ()
}
data TimerType
= TimerCoin
deriving (Eq, Ord)
data GlobalState = GlobalState
{ ... -- other stuff
, _timers :: Map TimerType Timer
}
```

A `Timer`

is just an amount of remaining time and something to do afterwards. It's stored in the `GlobalState`

with a `TimerType`

key. I originally thought about using a bigger type (such as `Int`

) as my timer key, but realized that would make canceling specific timers harder as it would imply they're given a non-deterministic key when started. The interface for starting and canceling timers turned out to be trivial:

```
startTimer :: TimerType -> Time -> Game () -> Game ()
startTimer tt t cb =
setGlobals $ timers . at tt ?~ Timer t cb
cancelTimer :: TimerType -> Game ()
cancelTimer tt =
setGlobals $ timers . at tt .~ Nothing
```

The only thing left is to update timers and run their callbacks when it's time. I fucked around with this implementation too hard, trying to find a completely lensy way of doing it, but eventually settled on this ugly `fromList . toList`

thing:

```
updateTimers :: Time -> Game ()
updateTimers dt = do
ts <- getGlobals $ view timers
ts' <- forOf traverse ts $ \t ->
if _tTime t - dt <= 0
then _tCallback t $> Nothing
else pure . Just
$ t & tTime -~ dt
setGlobals $
timers .~ M.fromList (catMaybes . fmap sequence $ M.toList ts')
```

`ts'`

is a traversal over the `Map`

of timers, that decrements each of their times, optionally runs their callbacks, then returns a `Mayber Timer`

for each one. The last line is where the interesting bit is -- `sequence`

over a `(TimerType, Maybe Timer)`

is a `Maybe (TimerType, Timer)`

, which we can then insert back into our `Map`

as we construct it -- essentially filtering out any timers which have expired.

Finally we can get back to our DFA. Instead of printing out the name of the hotspot you clicked on, we can now start a timer that will update our game state. I added a field to `GlobalState`

:

```
data GlobalState = GlobalState
{ ... -- other stuff
, _gInputDFA :: InputDFA
}
data InputDFA
= IStart
| IBeforeCoin
| ICoinOpen Pos HotSpot
deriving (Eq, Ord)
```

The idea is that we start in state `IStart`

, transition into `IBeforeCoin`

when we start the timer, and into `ICoinOpen`

when the timer expires. Additionally, if the user releases the mouse button, we want to cancel the timer. All of this becomes:

```
case (_gInputDFA globalState, event) of
(IStart, MouseButton Down) ->
case _hotspots currentRoom mousePos of
Just hs -> do
startTimer TimerCoin 0.5 $ do
setGlobals $ gInputDFA .~ ICoinOpen mousePos hs
setGlobals $ gInputDFA .~ IBeforeCoin
Nothing ->
-- as before
(IBeforeCoin, MouseButton Up) -> do
cancelTimer TimerCoin
setGlobals $ gInputDFA .~ IStart
(ICoinOpen p hs, MouseButton Up) -> do
let verb = getBBSurface (coinSurface p) mousePos
for_ verb $ doInteraction hs
setGlobals $ gInputDFA .~ IStart
```

If you care, try to trace through these cases and convince yourself that this logic is correct. The reason we have a position stored inside the `ICoinOpen`

is so that we know where the mouse was when the user started holding their mouse down. This corresponds to where we should draw the action menu.

This is done in the drawing routine by checking the current state of `_gInputDFA`

-- if it's `ICoinOpen`

it means the menu is up and we need to draw it.

The only last thing is how can we map where you release your mouse button on the menu to what interaction we should do. Our action menu looks like this:

From left to right, these squares represent talking/eating, examining, and manipulating. We need some way of mapping a location on this image to a desired outcome.

Doing rectangle collision is easy enough -- we define a bounding box and a test to see if a point is inside of it (as well as some auxiliary functions for constructing and moving `BB`

s, elided here):

```
data BB = BB
{ leftX :: Float
, rightX :: Float
, topY :: Float
, bottomY :: Float
} deriving (Eq, Ord, Show)
inBB :: BB -> Pos -> Bool
inBB BB{..} (V2 x y) = and
[ x >= leftX
, x < rightX
, y >= topY
, y < bottomY
]
rectBB :: Float -> Float -> BB
moveBB :: Pos -> BB -> BB
```

The final step is to somehow map these bounding boxes to things we want to return. This seems like it'll be a recurring theme, so we build some machinery for it:

```
data BBSurface a = BBSurface [(BB, a)]
deriving (Eq, Ord, Show)
getBBSurface :: BBSurface a -> Pos -> Maybe a
getBBSurface (BBSurface bs) p =
getFirst . flip foldMap bs $ \(b, a) ->
if inBB b p
then First $ Just a
else First $ Nothing
```

The abstraction is my amazingly-named `BBSurface`

, which is a mapping of `BB`

s to values of some type `a`

. We can find a `Maybe a`

on the `BBSurface`

by just checking if the point is in any of the bounding boxes. If it is, we return the first value we find.

All that's left is to construct one of these `BBSurface`

s for the coin, and then to move it to the position indicated inside the `ICoinOpen`

. Easy as pie. Pulling everything together, and our interactive menu works as expected. Great success!

Next time we'll talk about navigation. Thanks for reading!

]]>Perhaps you could explain a little bit about your choice to write ecstasy rather than to use apecs? I've not used apecs, I'm just interested as I had done some limited research into writing games in Haskell and apecs seemed to have traction.

That seems like a really good idea, and combined with the fact that I really haven't published anything about `ecstasy`

suggested I actually write about it!

So before diving in, let's take a look at the problem an entity-component-system (ECS) solves. Let's say we're writing a simple 2D platformer, we'll have dudes who can run around and jump on platforms.

The way I'd go about writing this before knowing about ECS would be to implement one feature at a time, generally using the player character to test it as I went. I write functions that look something like this:

```
moveActor :: Controller -> Actor -> Actor
moveActor ctrl actor =
actor & actorPos +~ movingDirection ctrl
```

and then provide some types to hold all of the world together:

```
data Universe = Universe
{ _uPlayer :: Actor
, _uPlayerCtrl :: Controller
, _uCurrentLevel :: Level
}
data Level = Level
{ _lActors :: [Actor]
}
```

and finally write some glue code to lift `moveActor`

over the universe.

```
updateUniverse :: Universe -> Universe
updateUniverse u@Universe{..} =
u & uPlayer %~ moveActor _uPlayerCtrl
& uCurrentLevel . lActors . traverse %~ moveActor someCtrl
```

On the surface this feels good. We've reused the code for `moveActor`

for both the player and any other dudes on the level who might want to walk around. It feels like we can build up from here, and compose pieces as we go.

Which is true if you're really patient, good at refactoring, or have spent a lot of time building things like this and know where you're going to run afoul. Because you're always going to run afoul in software.

The problem with our first attempt at this code is that it codifies a lot of implicit assumptions about our game. For example, did you notice that it implies we'll always have an `Actor`

for the player? It seems like a reasonable assumption, but what if you want to play a cut-scene? Or how about if you don't want to always have control over the player? Maybe you've just been hit by something big that should exert some acceleration on you, and you don't want to be able to just press the opposite direction on the control stick to negate it.

All of a sudden, as you try to code for these things, your simple `moveActor`

function takes more and more parameters about the context of the circumstances in which it's running. And what's worse is that often the rules of how these behaviors should play out will change depending on whether its the player or some enemy in the level. We're left with a conundrum -- should we build ad-hoc infrastructure around the callers of `moveActor`

or should we put all of the logic inside of it?

As you can imagine, it pretty quickly becomes a mess.

In one of the few times I'll praise object-oriented programming, I have to say that its inheritance-based polymorphism lends itself well to this problem. You can build more complicated and specific behaviors out of your ancestors' behaviors. Unfortunately, this approach bucks the OOP best-practice of "composition over inheritance."

ECS takes what I consider to be the functional-programming-equivalent of this OOP strategy. It's fundamental stake in the ground is that rather than representing your universe of game objects as an array-of-structs, you instead represent it as a struct-of-arrays. Conceptually, this is a cognitive shift that means instead of looking like this:

```
data GameObject = GameObject
{ position :: V2
, velocity :: V2
, graphics :: Picture
, buffs :: [Buff]
, notAffectedByGravity :: Bool
}
type Universe = [GameObject]
```

you instead model the domain like this:

```
data Universe = Universe
{ position :: Array V2
, velocity :: Array V2
, graphics :: Array Picture
, buffs :: Array [Buff]
, notAffectedByGravity :: Array Bool
}
```

This has some profound repercussions. First of all, notice that we have no guarantee that our `Array`

s are the same length, which implies that not every `GameObject`

need have all of its possible components.

All of a sudden, we can pick and choose which components an entity has. Entities, now instead of being explicitly modeled by a `GameObject`

are implicitly defined by an `Int`

corresponding to their index in all of the arrays.

From here, we can now write specific, *global* behaviors that should manipulate the components of an entity. We can avoid a lot of our previous ad-hoc machinery by essentially running a `map`

that performs pattern matching on only the components we want to care about. For example, we can say that we only want to draw entities who have both a `position`

and a `graphics`

. We want to apply gravity to all entities that have a `velocity`

, but *don't* have the `notAffectedByGravity`

flag.

*EDIT 2018-01-30*: The author of apecs has replied to this post. It's worth reading through, as it gives a useful perspective from the other side.

With an understanding of what ECS brings to the table, we're now ready to take a look at different ways of implementing such a system. We first turn our attention to apecs.

If we wanted to model our above `GameObject`

via `apecs`

, it might look something like this:

```
newtype Position = Position (V2 Double)
instance Component Position where
type Storage Position = Map Position
newtype Velocity = Velocity (V2 Double)
instance Component Velocity where
type Storage Velocity = Map Velocity
newtype Graphics = Graphics Picture
instance Component Graphics where
type Storage Graphics = Map Graphics
newtype Buffs = Buffs [Buff]
instance Component Buffs where
type Storage Buffs = Map Buffs
newtype NotAffectedByGravity = NotAffectedByGravity
instance Flag NotAffectedByGravity where
flag = NotAffectedByGravity
instance Component NotAffectedByGravity where
type Storage NotAffectedByGravity = Set NotAffectedByGravity
makeWorld "World"
[ ''Position
, ''Velocity
, ''Graphics
, ''Buffs
, ''NotAffectedByGravity
]
```

You'll have to admit it's a lot of boilerplate, which in turn would use Template Haskell to generate something similar to our conceptual `Universe`

above:

```
data World = World
{ position :: Array (Maybe Position)
, velocity :: Array (Maybe Velocity)
, graphics :: Array (Maybe Graphics)
, buffs :: Array (Maybe Buffs)
, notAffectedByGravity :: Set Int
}
```

I haven't dug too much into the internals of `apecs`

, so this representation might not be perfect, but it's good enough for us to get an understanding of what's going on here.

We can now use some of `apecs`

' primitives to, for example, transfer our velocity over to our position:

`rmap $ \(Position p, Velocity v) -> Position $ p + v`

This `rmap`

function is something I'd describe as "fucking magic." You pass it a lambda, it inspects the type of the lambda, uses the tuple of its input to determine which components an entity must have, and then will update the components of the corresponding output tuple.

At first, this seems like a fine abstraction, but it breaks down pretty quickly when used in anger. For example, what if you want to run a function over `Position`

that only works if you *don't* have a `Velocity`

? Or if you want to remove a component from an entity? `apecs`

can do it, but good luck finding the right function. Do you want `cmap`

, `cmapM`

, `cmapM_`

, `cimapM`

, `cimapM_`

, `rmap'`

, `rmap`

, `wmap`

, `wmap'`

or `cmap'`

? After a week of working with the library, I still couldn't come up with heads or tails for which function I needed in any circumstance. I'm sure there's a mnemonic here somewhere, but I'm not bright enough to figure it out.

When you do eventually find the right function, doing anything other than a pure map from one component to another becomes an exercise in futility and magic pattern matching. There's this thing called `Safe`

you sometimes need to pattern match over, or produce, and it roughly corresponds to when you're not guaranteed to have all of the components you asked for.

There are several other gotchas, too. For example, you can construct an entity by providing a tuple of the components you want to set. Unfortunately, due to `apecs`

' design, this thing *must be type-safe.* Which means you can't construct one based on runtime data if you're loading the particular components from e.g. a level editor. Well, you can, if you're willing to play "existentialize the dictionary" and learn enough of the underlying library (and quirks of Haskell's type inference algorithm) in order to convince the compiler what you're doing is sound.

One final gotcha I'll mention is that this magic tuple stuff is provided through typeclasses which are generated for the library by template haskell. Out of the box, you only get support for 5-tuples, which means you can't easily construct entities with more components than that. Furthermore, changing the TH to generate more results in exponential growth of your compile times.

None of this is to say that `apecs`

is bad software. It's actually pretty brilliant in terms of its technology; I just feel as though its execution is lacking. It depends on a lot of tricks that I wouldn't consider to be idiomatic Haskell, and its usability suffers as a consequence.

So with all of the above frustrations in mind, and a lot of time to kill in a Thai airport, I felt like I could make a better ECS. Better is obviously subjective for things like this, but I wanted to optimize it for being used by humans.

My explicit desiderata were:

- Keep boilerplate to a minimum.
- The user shouldn't ever bump into any magic.

I think `ecstasy`

knocks it out of the park on both of these fronts. Before diving into how it all works, let's take a peek at how it's used. We can define our components like so:

```
data EntWorld f = Entity
{ position :: Component f 'Field V2
, velocity :: Component f 'Field V2
, graphics :: Component f 'Field Picture
, buffs :: Component f 'Field [Buff]
, notAffectedByGravity :: Component f 'Field ()
} deriving (Generic)
type Entity = EntWorld 'FieldOf
```

That's it! No template haskell, no typeclasses, no nothing. You get everything for free just out of this one `deriving Generic`

statement. We'll talk about how it works in just a second.

We can implement the velocity/position behavior as follows:

```
emap $ do
p <- get position
v <- get velocity
pure defEnt'
{ position = Set $ p + v
}
```

Ecstasy clearly wins on minimizing the definition-side of boilerplate, but it seems like we've gained some when we actually go to use these things. This is true, but what we buy for that price is flexibility. In fact, `emap`

is powerful enough to set, unset and keep components, as well as branch on whether or not a component is actually there. Compare this to the ten functions with different signatures and semantics that you need to keep in mind when working with `apecs`

, and it feels like more of a win than the syntax feels like a loss.

So the question I'm sure you're wondering is "how does any of this work?" And it's a good question. Part of the reason I wrote this library was to get a feel for the approach and for working with GHC.Generics.

The idea comes from my colleague Travis Athougies and his mind-meltingly cool library `beam`

. The trick is to get the library user to define one semantic type that makes sense in their domain, and then to use tricky type system extensions in order to corral it into everything you need. `beam`

uses this approach to model database tables; `ecstasy`

uses it to provide both a struct-of-arrays for your components, as well as just a struct corresponding to a single entity.

As you'd expect, the sorcery is inside of the `Component`

type family. We can look at its definition:

```
type family Component (s :: StorageType)
(c :: ComponentType)
(a :: *) :: * where
Component 'FieldOf c a = Maybe a
Component 'SetterOf c a = Update a
Component 'WorldOf 'Field a = IntMap a
Component 'WorldOf 'Unique a = Maybe (Int, a)
```

This `Component`

thing spits out different types depending on if you want a record for the entity (`'FieldOf`

), an updater to change which components an entity has (`'SetterOf`

), or the actual universe container to hold all of this stuff (`'WorldOf`

). If we're building an entity record, every component is a `Maybe`

. If we're describing a change to an entity, we use `data Update a = Set a | Unset | Keep`

. If we want a place to store all of our entities, we generate an `IntMap`

for every `'Field`

. There's also support for adding components that are uniquely owned by a single entity, but we won't get into that today.

The trick here is that we get the user to fill in the `c :: ComponentType`

when they define the components, and ask them to keep the `s :: StorageType`

polymorphic. The library then can instantiate your `EntWorld f`

with different `StorageType`

s in order to pull out the necessary types for actually plumbing everything together.

We use the `Generic`

derivation on `EntWorld`

in order to allow ourselves to construct the underlying machinery. For example, when you're defining an entity, you don't want to be able to `Keep`

the old value of its components, since it didn't have any to begin with. We can use our `Generic`

constraint in order to generate a function `toSetter :: EntWorld 'FieldOf -> EntWorld 'SetterOf`

which takes an entity record and turns it into an entity update request, so that we don't actually need special logic to construct things. The `Generic`

constraint also helps generate default values of the `EntWorld 'WorldOf`

and other things, so that you don't need to write out any boilerplate at the value level in order to use these things.

The actual how-to-do of the `GHC.Generics`

is outside of the scope of today's post, but you can read through the source code if you're curious.

I want to make an old school point-and-click adventure game in the style of Monkey Island or Full Throttle. I've wanted to make one for as long as I can remember, and I finally have a concept and some amount of script that I think would be fitting for the medium. I spent roughly two days searching for engines to run this baby on, and I didn't have any luck whatsoever.

- adventure - an old adventure game engine I wrote back in '12 or so. It requires writing a
*lot*of lua, and appears to have bitrotten since then. I couldn't get it to compile. - Adventure Game Studio - the latest version of the IDE immediately segfaults when run through WINE.
- WinterMute - has a "garbage" rating on WINE HQ.
- Godot/Escoria - Escoria doesn't appear to run on recent versions of Godot.
- Visionaire - I successfully got the editor running on WINE, but it couldn't draw anything, so I could edit everything but had no visual feedback on anything.
- Bladecoder Adventure Engine - I fought to compile this for a while, and eventually succeeded, but got scared of it. It's written by a single guy in a language I never want to touch, and decided the risk factor was too high.
- Unity Adventure Creator - looks promising, but required forking out 70 euros before you could try it. As someone who is unemployed knows nothing about Unity, this is a pretty steep price to determine whether or not the project will work for my purposes.

So it looks like we're SOL. The existing engines don't seem like they're going to cut it. Which means we're going to need to roll our own.

Fortunately I've rolled a few of my own already. This wasn't my first rodeo. There's the previously mentioned adventure, an unnamed XNA/C# one I wrote before knowing about source control which is unfortunately lost to the sands of time, and one I most recently put together as a technical demo for a project a friend and I were going to work on. The friend pulled out, unfortunately, so the project died, but that means I have a starting point.

The engine as it existed had basic functionality for pathing around a bitmap, moving between rooms, and basic support for interacting with the environment. Unwisely, it was also a testbed for lots of type-trickery involving existentially pushing around types to manage the internal state of things in the game. It was intended that we'd do all of our game scripting directly in Haskell, and this seemed like the only approach to have that work.

So my first order of business was to tear out all of the existential stuff. I've learned since that you should always avoid existentializing things unless you are really really sure you know what you're doing. It's a soft and slow rule, but more often than not I regret existentializing things. The new plan was to script the game with a dedicating scripting language, and so Haskell never needs to know about any of the internal state.

Since writing the first draft of this game engine, I've published a library called `ecstasy`

. It's an entity-component system that allows you to describe behaviors over components of things, and then compose all of those behaviors together. The magic here is that you can write a function that only manipulates the components you need, and the library will lift it over all entities such a behavior would be relevant to. This means you can pick-and-choose different behaviors for game objects without needing to do a lot of heavy plumbing to get everything to play nicely with one another.

And so the next step was to hook up `ecstasy`

to my existing engine. I didn't want to alter any of the game's behavior yet, so entities managed by `ecstasy`

would have to exist completely parallel to the ones managed by the existing engine.

I defined my `ecstasy`

component type with the most minimal support for drawing things on the screen.

```
data EntWorld f = Entity
{ pos :: Component f 'Field Pos
, gfx :: Component f 'Field Picture
} deriving (Generic)
```

and then updated my drawing routine to find any `Entity`

who had both a `pos`

and a `gfx`

and then hook it into the existing drawing stuff:

```
drawGame :: MyState -> IO Picture
drawGame ms@(s, _) = evalGame' ms $ do
gfxs <- efor . const $
(,) <$> get pos <*> get gfx
pure . scaleToView s
. uncurry translate (-camera)
. pictures
$ roomPic
: [ drawActors actors
, drawGfxs gfxs
]
```

There was some silly plumbing necessary to connect my old, convoluted `Game`

monad with the `System`

monad provided by `ecstasy`

. That's what this `ms@(s, _)`

and `Game'`

silliness is here; little shims that can run the two monads simultaneously and reconcile the results. It was pretty gnarly, but thankfully only a hack until I could convert enough of the game logic over to being exclusively managed by `ecstasy`

.

I think that's where we'll leave the dev blog for today. I want to get us roughly caught up to the present in terms of getting from there-to-here in order to provide a better overall view of what game development in Haskell looks like. But I'm also pretty anxious to actually get some work done, rather than just describing work I have done. I expect the posts to get more technical as we get closer to being caught up, when I don't need to depend on my memory for what changes were made.

Next time we'll discuss ripping out most of the silly global variables that used to be in play, and talk about how an ECS better models things like "what should the camera be focused on?" and "how should characters navigate the space?"

Until then.

]]>