Syntax & Semantics

In linguistics there is the concept of syntax and semantics. The syntax comprises of the possible constructions that can be made in a language, while semantics is the actual meaning ascribed to those constructions. This terminology is equally applicable to domain-specific languages (DSLs), such as for example for expressing animations.

I think the key lies in the difference of the expected semantics of the two approaches. So, as a starting point, I want to gave a basic explanation of these concepts.

Syntax

First, let’s define syntax for two different animation DSLs: a combinator-style DSL and a callback-style DSL.

Combinator-Style DSL

In the combinator-style DSL we have three main concepts: basic animations, sequential animations and parallel animations. Basic animations are atomic units of animation. A simple example of such unit is the linear interpolation between a from and to value. A more complex example is the morphing of a shape into another shape. In contrast with the atomic units of animation are the composed animations. A sequential animation is the sequential composition of two animations, while the parallel animations is the parallel composition of two animations. We can describe the syntax for this DSL in Backus-Naur form (BNF).

Combinator-Style BNF

<animation> ::= basic
              | <animation> parallel <animation>
              | <animation> sequential <animation>

If you are not familiar with BNF, it gives a convenient notation for describing syntax. The rules above can be read as follows: an animation is either a basic animation OR an animation in parallel with another animation OR an animation in sequence with another animation. The reference to animation is a recursive reference, so the mention of <animation> in the parallel or sequential declarations refers to the definition itself. Below are some examples that can be expressed with this syntax:

basic
basic parallel basic
basic sequential basic
(basic parallel basic) sequential basic
basic parallel (basic sequential basic)
(basic parallel basic) sequential (basic parallel basic)
...

The expression basic can be replaced with any suitable basic animation, such as change box alpha from 0 to 1 for 1 second or morph box from square to circle for 2 seconds. Which basic animations are or are not available isn’t relevant for the points made in this post. Rather, the focus of this post is on the different styles of composing animations.

Callback-Style DSL

In the callback-style DSL we similarly have three basic concepts: basic animations and composed animations using either onStart or onComplete. We can think of x onStart y as shorthand for something like x.onStart(() => y), it registers animation y to play when animation x starts, and similarly for onComplete to register on the completion of an animation. Of course, for now this is merely syntax and the exact meaning will be decided once we define semantics.

Callback-Style BNF

<animation> ::= basic
              | <animation> onStart <animation>
              | <animation> onComplete <animation>

Again, for illustrative purposes, let’s look at some examples that can be expressed with this syntax:

basic
basic onStart basic
basic onComplete basic
(basic onStart basic) onComplete basic
basic onStart (basic onComplete basic)
(basic onStart basic) onComplete (basic onStart basic)
...

Semantics

The syntax we described does not mean anything yet until we give semantics for it. These semantics can be whatever we want. We could create an awkward notation for simple arithmetic by stating that the meaning of basic is 1, the meaning of parallel is + and the meaning of sequential is *. But, we are in the process of creating a DSL for animations, so probably our semantics should have something to do with those.

There are different ways of giving meaning to syntax. Here, we give so-called denotational semantics. This means that the meaning of syntax is described by certain mathematical objects. For example, the mathematical object used as domain for the awkward syntax of arithmetic is the natural numbers.

For semantics of animations we work a bit more informally. The domain for this context is a timeline. This timeline describes what is going on in the animation for each point in time.

For example, the animation in this picture:

can be described with the following timeline:

From t=0 until t=1 the background fades from black to blue. Then, at the same time, from t=1 to t=2 the left part fades from blue to red and the right part fades from blue to yellow.

Basic

The semantics of the basic expression is a simple box in the timeline. From t=0 until t=x, where x is the length of the animation, a certain part of the application is transformed.

For example, the animation fade background from black to blue for 1 second has the following semantics:

Combinator-Style DSL

Typically, denotational semantics is compositional: the meaning of a composed expression is built out of the meaning of its sub-expressions. This is also the case here, since the semantics of an x parallel y expression is given by the semantics of x occurring at the same time in the timeline as the semantics of y. Visually, we can describe it as follows:

Similarly, for an x sequential y expression, where y occurs after x in the timeline:

Remember that each of the x or y animations can in turn be composed animations. For example, the timeline of (a parallel b) sequential c is:

Callback-Style DSL (?)

We might expect that we can proceed in the same way for the semantics for the callback-style syntax. The onStart operator could have the same semantics as parallel and the onComplete operator could have the same semantics as sequential:

However, no actual implementation of the onStart/onComplete style adheres to these semantics. Take the following example: (a onStart b) onComplete c. If we copy the parallel/sequential semantics, then we get the timeline as we saw earlier:

The actual timeline resulting from the implementation, however, is the following:

Remember that (a onStart b) onComplete c in, for example, a JavaScript animation library is something like a.onStart(() => b).onComplete(() => c). This means that both the onStart and onComplete callbacks are attached to the animation a. The animation c is attached to the end of animation a, it is not possible to attach a callback to the composed animation a onStart b as a whole¹.

Callback-Style DSL

Since the earlier semantics doesn’t quite capture the actual behaviour, we have to come up with something else that does. The key difference is that composition of animations is not based on the start and end point of the composed sub-animations. Instead, we need to keep track of specific start and end points which signify where the second operand of an onStart and onComplete operator will be attached to.

For the callback-style dsl, we have to update the semantics of the basic expression to take into account these attachment points. So, the semantics of basic is again a box in the timeline, where the start attachment point is at the start of the animation and the end attachment point is at the end.

Now, we can define the semantics of an x onStart y expression: attach animation y to the start attachment point of animation x. Similarly, the semantics for an x onComplete y expression: attach animation y to the end attachment point of animation x. Visually we can represent it like this:

The attachment points for the composed animation are derived from the attachment points of the first operand.

Now, the actual implementation follows our defined semantics of (a onStart b) onComplete c:

Combinator-style > Callback-style

We have defined two different DSLs for animations, given some simple syntax and an informal explanation of the semantics. Is one better suited to the task of creating animations than the other? I prefer the combinator-style for two main reasons.

First, when I create an animation I think of it in terms of its behaviour as I have been describing them with timelines as in the pictures of this post. I find it a very convenient approach, which easily maps to getting the results you expect on the screen. Since the combinator-style operators more directly express the timeline semantics that I expect, it seems clearly better in this regard.

Second, the callback-style is less expressive when viewed as it is presented here². What I mean with that is: every timeline that is expressible in the callback-style is expressible with the combinator-style, but not vice versa. This can be derived from the fact that (a parallel b) sequential c, where the durations of a and b are not known upfront, can not be expressed with the callback-style and we can implement the onStart/onComplete operators using the parallel/sequential operators, see the appendix for a sketch of the translation.

I am not the only one to come up with this idea of course. I could for example find some similar things in the Qt animation library and Ren’Py. Even GSAP, which provides the callback-style, also provides a different feature for creating animations which they appropriately call Timeline. This feature is also based on the idea of describing timelines, similar to what parallel/sequential provide, and in the link they claim that ‘choreographing complex sequences is crazy simple’ with Timelines. What surprises me though, is that the approach isn’t the most prevalent way animations are expressed.

Conclusion

In conclusion, the main point I want to make is that I believe that the callback-style approach to describe animations does not seem like a good interface for animations. I argue this on the fact that it is not conducive to simple semantics of describing timelines, and by themselves the onStart/onComplete operators are less expressive than the parallel/sequential operators.

Have you ever used an animation library and felt something was off? Do you think of animations in terms of timelines? Or maybe you are a happy user of the callback-style and want to convince me of your ways? Feel free to discuss in the accompanying reddit thread!

Appendix A

In this appendix I give an implementation of the onStart/onComplete operators based in terms of the parallel/sequential operators.

The translation is based on the idea that given a sequence of onStart and onComplete callbacks on an animation, we can always transform it to the form (a sequential (.. parallel ..)) parallel (.. parallel ..). For example, if we have ((((a onStart b) onComplete c) onStart d) onComplete e) onStart f then the timeline described by that expression is the same timeline as (a sequential (c parallel e)) parallel (b parallel d parallel f).

In the translation, we ensure that everything is always of the form (x1 sequential x2) parallel x3, where x1 is a basic animation. Then, we can describe the translation of each of the expressions in the callback-style DSL in function of the expressions in the combinator-style DSL. We do this by induction on the syntax definition.

The translation of a basic expression requires us to put it in the required form. We do this by using a simple noop expression, which is a basic animation that takes 0 seconds and does not do anything. The translation is then: basic = (basic sequential noop) parallel noop.

The translation of an x onStart y expression requires us to make use of the fact that x has been transformed to the form (x1 sequential x2) parallel x3, in other words: we apply the induction hypothesis on x. The translation should then add y onto the animations that are in parallel with x1. The translation is: (x1 sequential x2) parallel (x3 parallel y).

Similarly, for x onComplete y we deconstruct x and put y in parallel with the animations occurring after x. The translation is: (x1 sequential (x2 parallel y)) parallel x3.

History

The DSL I will present in this post originated as a layer I created on top of tweening functionality provided by the Phaser game engine. By the way, the word tweening is short for inbetweening, which means: generating frames inbetween two images to create the appearance of motion. Anyway, the tweening API in Phaser provides the user with the ability to alter properties of objects over time. For example, let’s say we start with an object obj = { x: 100, y: 100 }. Then, we can attach a tween on obj, for example the tween object tween.to({ x: 150 }, 200). By attaching this tween to obj, it will increase the property obj.x to 150 over the next 200 ms. There are various configuration parameters, such as different easing functions, to create all kinds of basic animations.

I use this to create various animations within a game prototype I am working on. The game features abilities with multiple effects which happen in sequence. When such an ability is activated, the animation for each of these effects needs to play in order. An animation for an effect can consist of various other animations in parallel. And what makes things even more complicated are statuses which intercept and alter effects, again with corresponding animations. This means that there are tons of animations that need to play in sequence or in parallel, and these are in turn composed of multiple animations playing in sequence or in parallel. Specifying this with the basic tweening interface was quite cumbersome, and so I started experimenting with this DSL on top of the more basic operations and have been very happy with it so far.

Now I want to take it a step further by porting the DSL to Haskell and looking at it from an effect handler perspective. We will be looking at the current iteration of the Haskell DSL in this post.

Overview

First, let’s take a look at the very basics we want to achieve with the DSL: composing basic animations in sequence and in parallel. The post leaves out some code, but you can find the full example code in this github repo.

Basic Animations

As a first step, we need to specify what a basic animation is. We will model a basic animation consisting of three things. First, its duration specifies how many seconds the animation should last. Second, we provide a way to specify which values in our world model should change, we do this by passing a traversal since we can potentially focus on multiple values. Last, we provide the wanted target value, which tells us what the values focused on by the traversal should be at the end of the animation.

^{Note: Traversals are a concept from the various lens libraries. I will not go into detail on lenses in this post. I hope the use of lenses in this post is lightweight enough to understand from context what is going on even if you are not familiar with them. If you do want to read more about this, maybe this lens tutorial can be of help.}

Let’s say we want to create the animation of a box moving over the x-axis, we would create it as follows. We create a basic animation with a duration of 0.2 seconds, a traversal focusing on sprites.box.x, which is the x-value of the box object in the sprites of our world, and an end value of 50.

basicBoxAnim = basic (For 0.5) (sprites . box . x) (To 50)

This results in the following animation. Obviously, we are still missing some code to actually create these animations, but this gives an idea of what we are working towards.

Sequential and Parallel Animations

The next steps in our DSL are sequential and parallel composition of animations.

First, let’s take a look at sequential composition. With the seq combinator, we can create an animation which consists of multiple basic animations executed sequentially. For example, if we wanted our box to walk a square path, we can create this by first creating an animation which increases the x value, then increases the y value, then decreases the x value and lastly decreases the y value. This animation is shown by means of code and a visual animation below.

seqBoxAnim = seq
  [ basic (For 0.5) (sprites . box . x) (To 50)
  , basic (For 0.5) (sprites . box . y) (To 50)
  , basic (For 0.5) (sprites . box . x) (To 0)
  , basic (For 0.5) (sprites . box . y) (To 0)
  ]

We can also compose animations in parallel with the par combinator. For example, to create an animation of a box moving diagonally, we compose an animation of increasing x and increasing y in parallel. The code and visual are given below.

parBoxAnim = par
  [ basic (For 0.5) (sprites . box . x) (To 50)
  , basic (For 0.5) (sprites . box . y) (To 50)
  ]

Effect DSL

Now, we will take a look at the internals of the DSL’s and build it from an effect handler perspective. When working in an effect handler setting, DSL’s are divided in two parts: the operations and the combinators. The former are the basic effects supported by our DSL, such as the basic animation effect. The latter represent the possibilities in which effects can be combined to create larger effects, such as the seq and par combinators. However, we will take the more well-known combinators bind and return as starting point, which makes our DSL a free monad.

Starting Point

First, we have only one operation: Basic, which represents the effect of executing a basic animation. Notice that the Ops data type has a type parameter a. This type parameter represents the return type of the operation. The return type of the Basic operation is not very interesting, as it is unit. Later we will see an example with a more interesting return type.

-- duration in s
newtype Duration = For Float

-- end result value of animation
newtype To = To Float

data Ops obj a where
  Basic :: Duration -> Traversal' obj Float -> To -> Ops obj ()

Next, we introduce the Bind and Return combinators. The f type parameter is a higher-kinded parameter where we will plug in Ops obj to create our actual DSL.

data Dsl f a where
  Bind :: f a -> (a -> Dsl f b) -> Dsl f b
  Return :: a -> Dsl f a

^{Note: Intuitively speaking, this is a free monad because we obtain a free instance for the Monad typeclass. In this post we won’t delve deeper into the mathematical background of this data type. If you are interested in this, the free package is a good starting point.}

The return type of an operation is of importance in the Bind combinator. It takes as input an f a, or an effect from the operations f with a return type a, and a function a -> Dsl f b, the remaining part of the effect which has to be executed after we have done the first operation. The Return combinator allows us to embed any value a as a no-op effect.

Creating a sequential animation with this encoding can be done as follows. We create a series of Binds where we put a Basic animation as the first parameter and the remaining effects in the continuation function. These functions have unit as input value, since that is the return type of the Basic effect. So, we can implement the seqBoxAnim example like this:

seqBoxAnim' =
  Bind (Basic (For 0.5) (sprites . box . x) (To 50)) $ \_ ->
  Bind (Basic (For 0.5) (sprites . box . y) (To 50)) $ \_ ->
  Bind (Basic (For 0.5) (sprites . box . x) (To 0)) $ \_ ->
  Bind (Basic (For 0.5) (sprites . box . y) (To 0)) $ \_ ->
  Return ()

Or, we can implement the seq combinator in a generic fashion. This combinator takes a list of animations and creates an animation which executes them sequentially. This implementation uses the omitted Monad instance for Dsl.

seq :: [Dsl (Ops obj) ()] -> Dsl (Ops obj) ()
seq [] = Return ()
seq (anim:r) = anim >>= (\_ -> seq r)

Combined with the following helper function for the Basic effect, we can then literally implement the first version of seqBoxAnim.

basic :: Duration -> Traversal' obj Float -> To -> Dsl (Ops obj) ()
basic duration traversal to = Bind (Basic duration traversal to) (\_ -> Return ())

Par Combinator

We were able to support sequential animations out of the box with the free monad, but we are not able to support parallel animations. We might expect that we need to add an applicative combinator to our existing monad combinators. However, that only allows us to specify parallel effects (the Ops data type) as opposed to parallel animations (the Dsl data type). In essence, it is the difference between adding this combinator:

  ParLimited :: [f a] -> ([a] -> Dsl f b) -> Dsl f b

or this combinator:

  Par :: [Dsl f a] -> ([a] -> Dsl f b) -> Dsl f b

Thus, the Par combinator takes as first argument a list of animations to execute in parallel. The second argument is a continuation which expects the return values of each of the animations executed in parallel.

So now our Dsl data type becomes:

data Dsl f a where
  Bind :: f a -> (a -> Dsl f b) -> Dsl f b
  Return :: a -> Dsl f a
  Par :: [Dsl f a] -> ([a] -> Dsl f b) -> Dsl f b

With our shiny new combinator, we can support the first parBoxAnim example.

parBoxAnim' =
  Par
  [ Bind (Basic (For 0.2) (sprites . box . x) (To 150)) (\_ -> Return ())
  , Bind (Basic (For 0.2) (sprites . box . y) (To 50)) (\_ -> Return ())
  ] $ \_ ->
  Return ()

Or, we can implement the par combinator generically, which can again be used in combination with basic to allow the literal implementation of the earlier parBoxAnim.

par :: [Dsl (Ops obj) ()] -> Dsl (Ops obj) ()
par l = Par l (\_ -> Return ())

Running Animations

Now that we know how the DSL is implemented under the hood, we can take a look at how running animations actually works.

Applying Operations

First, we take a look at applying an operation to a world model, represented by the abstract type obj. The second parameter t, a Float, is the amount of time elapsed since the previous frame. The third and last parameter is the operation that we want to apply, of type Ops obj a. The output of the function is a tuple containing the new world model and either a new operation or a result value.

There is only one case to consider, the Basic operation. The function works as follows.

1. We update the value(s) within the world model based on the amount of elapsed time.
2. We deduct the elapsed time from the remaining duration in the operation.
3. If: The new remaining duration is greater than 0.
   • Then: Return a modified operation with the reduced duration.
   • Else: Return a unit result.

applyOp :: obj -> Float -> Ops obj a -> (obj, Either (Ops obj a) a)
applyOp obj t (Basic (For duration) traversal (To x)) = let
  -- (1) update world model values
  newObj = obj & traversal %~ updateValue t duration x
  -- (2) reduce duration
  newDuration = duration - t
  -- (3) create new animation/result
  result = if newDuration > 0
    then Left (Basic (For newDuration) traversal (To x))
    else Right ()
  in (newObj, result)

This is the updateValue helper function to update a value within the world model. The value is clamped to make sure we don’t overshoot. There might be some numerical instability in the way this is calculated, but I haven’t properly tested this yet.

updateValue ::
  Float -> -- time elapsed
  Float -> -- duration
  Float -> -- target value
  Float -> -- current value
  Float -- new value
updateValue t duration target current = let
  newValue = (current + ((target - current) * t) / duration)
  in if target > current
    then min target newValue
    else max target newValue

We can test this function on a simple example. We will start with (100, 100) as our world model and apply an animation which changes the first value to 150. We end up with a world model of (150, 100) after applying the animation fully, as we expect.

-- our world model
example1_state :: (Float, Float)
example1_state = (100, 100)

-- a basic animation
example1_anim :: Ops (Float, Float) ()
example1_anim = Basic (For 0.2) _1 (To 150)

-- after 1 operation step
example1_1 :: ((Float, Float), Either (Ops (Float, Float) ()) ())
example1_1 = applyOp (example1_state) 0.1 example1_anim
-- ((125.0,100.0),Left Basic (For 0.1) (At ...) (To 150.0))

-- after 2 operation steps
example1_2 :: ((Float, Float), Either (Ops (Float, Float) ()) ())
example1_2 = applyOp (fst example1_1) 0.1 (fromLeft undefined (snd example1_1))
-- ((150.0,100.0),Right ())

Applying Animations

Next, we need to be able to apply a complete animation to a world model. We again take an obj and Float as parameter and a Dsl (Anim obj) a representing the animation. As a result, we obtain the modified world model and animation.

Essentially, how the applyDsl function works is that we apply the operations to the world model and replace the newly obtained animations inside the combinators. If the operations have returned a result when they are finished, we apply their results to the continuation in the combinators.

We take a more in-depth look to the function here. There are three cases to consider:

1. Bind: We apply the animation within the Bind combinator with applyOp. This can have two outcomes:
   • We obtain a result value, we can apply this value to the continuation inside the Bind combinator to obtain the new animation.
   • We obtain a new animation, which replaces the animation in the previous Bind combinator.
2. Par: We apply all of the operations in the Par combinator. Then, we check whether all values after this step are Return values.
   • If that is the case, we can apply the those values to the continuation within the Par constructor.
   • If that is not the case, we replace the operations inside the Par combinator.
3. Return: We don’t modify the object or the animation, since the animation is finished.

applyDsl :: obj -> Float -> Dsl (Ops obj) a -> (obj, Dsl (Ops obj) a)
-- (1) Bind case
applyDsl obj t (Bind fa k) = let
  (newObj, eResult) = applyOp obj t fa
  in case eResult of
    Right result -> (newObj, k result)
    Left newOp -> (newObj, Bind newOp k)
-- (2) Par case
applyDsl obj t (Par fs k) = let
  (newObj, newOps) = applyOps obj t fs
  in case returnValues newOps of
    Right l -> (newObj, k l)
    Left () -> (newObj, Par newOps k)
-- (3) Return case
applyDsl obj t (Return a) = (obj, Return a)

The helper functions applyOps and returnValues are given below. The former applies all the operations in a list to the given world model and keeps track of the final modified world model and new operations. The latter gathers all Return values in a list, but returns Left () if there was a non-Return value.

applyOps :: obj -> Float -> [Dsl (Ops obj) a] -> (obj, [Dsl (Ops obj) a])
applyOps obj t [] = (obj, [])
applyOps obj t (op:r) = let
  -- apply first operation
  (obj', op') = applyDsl obj t op
  -- apply the rest of the operations
  (obj'', ops) = applyOps obj' t r
  in (obj'', op' : ops)

returnValues :: [Dsl f a] -> Either () [a]
returnValues [] = Right []
returnValues ((Return a):r) = do
  l <- returnValues r
  return (a : l)
returnValues _ = Left ()

We can take out our tuple world model example again, and apply a simple parallel animation to it to check that it works as we expect.

-- our world model
example2_state :: (Float, Float)
example2_state = (100, 100)

-- a composed animation
example2_anim :: Dsl (Ops (Float, Float)) ()
example2_anim =
  par
  [ basic (For 0.2) _1 (To 150)
  , basic (For 0.2) _2 (To 150)
  ]

-- after 1 dsl step
example2_1 :: ((Float, Float), Dsl (Ops (Float, Float)) ())
example2_1 = applyDsl example2_state 0.1 example2_anim
-- Note that the 0.2 values inside the animation are reduced to 0.1
{-
( (125.0,125.0)
, Par (
    [ Bind (Basic (For 0.1) (At ...) (To 150.0)) (Return)
    , Bind (Basic (For 0.1) (At ...) (To 150.0)) (Return)]
  ) (Return)
)
-}

-- after 2 dsl steps
example2_2 :: ((Float, Float), Dsl (Ops (Float, Float)) ())
example2_2 = applyDsl (fst example2_1) 0.1 (snd example2_1)
-- ((150.0,150.0),Return)

Gluing with Gloss

At this point, we have seen enough to be able to glue everything up to the gloss package and actually create some animations.

First, we will define the representation of our world model in the following data types. The Sprite data type contains a gloss Picture and some additional information on how to draw it. Then we have the collection of sprites in the Sprites data type. And lastly, we have the World data type which contains the sprites and the currently running animations. We also create lenses for all these data types.

 data Sprite
  = Sprite
  { _x :: Float
  , _y :: Float
  , _alpha :: Float
  , _scale :: Float
  , _picture :: Picture
  }

makeLenses ''Sprite

data Sprites
  = Sprites
  { _box :: Sprite
  }

makeLenses ''Sprites

allSprites :: Sprites -> [Sprite]
allSprites (Sprites box) = [box]

data World
  = World
  { _sprites :: Sprites
  , _runningAnimations :: [Dsl (Ops World) ()]
  }

makeLenses ''World

Next, we need various functions which will be passed to the gloss entrypoint. drawSprite takes a Sprite and returns a Picture. The draw function takes a world and creates a picture from it, essentially combining all sprites converted into a Picture into one. The handleInput function will add an animation to the world when the x key is pressed. The update function updates the world model based on the currently running animations. Then we define an initial world model and pass everything into the gloss play function.

drawSprite :: Sprite -> Picture
drawSprite (Sprite {_x, _y, _alpha, _scale, _picture}) =
  _picture &
  Color (makeColor 1 1 1 _alpha) &
  Scale _scale _scale &
  Translate _x _y

draw :: World -> Picture
draw (World {_sprites}) = let
  worldSprites = allSprites _sprites
  in Pictures (map drawSprite worldSprites)

handleInput :: Event -> World -> World
handleInput (EventKey (Char 'x') Down _ _) w@(World {_runningAnimations}) = let
  newRAnims = _runningAnimations ++ [fancyBoxAnim]
  in w { _runningAnimations = newRAnims }
handleInput _ w = w

update :: Float -> World -> World
update t w@(World {_runningAnimations}) = let
  (newWorld, newOps) = applyOps w t _runningAnimations
  f (Return _) = False
  f _ = True
  filteredOps = filter f newOps
  in newWorld { _runningAnimations = filteredOps }

boxPic :: Picture
boxPic = Pictures
  [ Line [(-1, 1), (1, 1)]
  , Line [(1, 1), (1, -1)]
  , Line [(1, -1), (-1, -1)]
  , Line [(-1, -1), (-1, 1)]
  ]

initialWorld :: World
initialWorld = let
  worldSprites = Sprites (Sprite 0 0 1 20 boxPic)
  in World worldSprites []

main :: IO ()
main = let
  window = InWindow "animation-dsl" (400, 400) (10, 10)
  in play window black 60 initialWorld draw handleInput update

As a last example let’s take a look at a more complicated animation. This animation is similar to the square path animation, but in parallel the box will fade in and out.

fancyBoxAnim = let
  fade = seq
    [ basic (For 0.125) (sprites . box . alpha) (To 0)
    , basic (For 0.125) (sprites . box . alpha) (To 1)
    ]
  in par
  [ seqBoxAnim
  , seq (replicate 8 fade)
  ]

Create Effect

So far we have created animations using only the Basic effect. However, there are other interesting effects we can add to the DSL. In this section we will look at the Create effect, which creates an object within the world model.

To add an effect to our DSL, we have to update the Ops data type definition. The Create effect will take as input a function on how to create an object. Then, we also need to know how to access this object later on in the animation, so this function returns an integer index. This index is also the return type of the effect, note that the Create constructor constructs a value of type Anim obj Int. This means that this operation has an Int as result type.

The updated Ops declaration is given below.

data Ops obj a where
  Basic :: Duration -> Traversal' obj Float -> To -> Ops obj ()
  Create :: (obj -> (obj, Int)) -> Ops obj Int

By adding this constructor, we also have to add a clause to the applyOp function. The implementation is quite easy, we call the create function inside the Create constructor and pass the obtained data along.

applyOp obj t (Create create) = let
  (createdObj, objIndex) = create obj
  in (createdObj, Right objIndex)

And we can again create a helper function create for convenience.

create :: (obj -> (obj, Int)) -> Dsl (Ops obj) Int
create create = Bind (Create create) (\index -> Return index)

For the following animation we make a small update to our World data type. The _sprites field is now a list of sprites, so it can host a dynamic amount of sprites.

data World
  = World
  { _sprites :: [Sprite]
  , _runningAnimations :: [Dsl (Ops World) ()]
  }

The following animation uses the create effect to create a new box in the world and play a little animation along with it.

createBox :: World -> (World, Int)
createBox w@(World {_sprites}) = let
  newIndex = w ^. sprites & length
  sprite = Sprite ((-120) + fromIntegral newIndex * 60) 0 0 30 boxPic
  newWorld = w { _sprites = _sprites ++ [sprite] }
  in (newWorld, newIndex)

atIndex :: Int -> Lens' [a] a
atIndex i = lens (!! i) (\s b -> take i s ++ b : drop (i+1) s)

createBoxAnim :: Dsl (Ops World) ()
createBoxAnim = do
  i <- create createBox
  par
    [ basic (For 0.5) (sprites . atIndex i . alpha) (To 1)
    , basic (For 0.5) (sprites . atIndex i . scale) (To 20)
    ]

This results in the animation below, each new box appearing happens after a key is pressed.

Conclusion

We looked at building an animation DSL from the ground up, starting from a traditional effect handler perspective. We extended this with the Par combinator for parallel animations, created visual animations using the gloss library and added an extra create operation.

One main future direction I want to explore is converting it into a modular effects approach. This allows an end user to mix and match whatever basic effects they want in the DSL. For example, an effect they might want to add is playing sounds during an animation, or maybe hook into game engine primitives such as certain shaders (de)activating. These additional effects can be dependent on how the user wants to use the DSL, and so a modular approach seems appropriate.

Feel free to post any interesting ideas or feedback in the accompanying reddit thread!

The What

I have been using immutable-assign for updating immutable datastructures. This library provides the function iassign for deep immutable update on plain javascript objects. For example, if we have x = { a: { b: 1 } } then we can use iassign(x, x => x.a.b, x => 5) to obtain { a: { b: 5 } } without mutating x.

However, one thing that had been bothering me is updating multiple properties in one go. For example, if we want to update all values in { a: { b: 1, c: 2}, d: 3 } by 1. Then we have to do:

iassign(iassign(iassign(
  { a: { b: 1, c: 2 }, d: 3 },
  x => x.a.b, x => x + 1),
  x => x.a.c, x => x + 1),
  x => x.d, x => x + 1);

We need one iassign for each property that is updated. At the end of the post we will be able to slightly compress this and use the following syntax:

focus(
  { a: { b: 1, c: 2}, d: 3 },
  over(x => x.a.b, x => x + 1),
  over(x => x.a.c, x => x + 1),
  over(x => x.d, x => x + 1),
);

The How Not

Why would we need something as scary sounding as ‘existential types’? Let’s have a first attempt without anything fancy. Our use case boils down to writing a function which takes a value of type S and then a collection of getters S => A and modifiers A => A. The type GetModOps<S, A> encodes a record with such a getter and modifier function. Then the focus function accumulates the results of consecutive iassign calls with these getters and modifiers, achieved by a reduce.

type GetModOps<S, A> = { get: (s: S) => A, modify: (a: A) => A };

function focus<S, A>(
  s: S,
  ...ops: GetModOps<S, A>[]
) {
  return ops.reduce((acc, op) => iassign(acc, op.get, op.modify), s);
}

That seemed simple enough, let’s try it out.

const x = { a: { b: 1 } };

focus(x,
  { get: x => x.a.b, modify: (x: number) => x + 1 }
);

Okay, let’s try a more complex example.

const x = { a: { b: 1, c: "a" } };

focus(x,
  { get: x => x.a.b, modify: (x: number) => x + 1 },
  { get: x => x.a.c, modify: (x: string) => x + "a" }, // error :(
);

Whoops, A type error! We can see what is going wrong by looking at how the generic types for focus are instantiated.

First the parameter x instantiates type S to { a: { b: number, c: string } }.

focus<{ a: { b: number, c: string } }, A>(x,
  ...ops: GetModOps<{ a: { b: number, c: string } }, A>[]
)

Now, the first passed GetModOps instantiates type A to number.

focus<{ a: { b: number, c: string } }, number>(x,
  { get: x => x.a.b, modify: (x: number) => x + 1 },
  ...ops: GetModOps<{ a: { b: number, c: string } }, number>[]
)

Then, the last GetModOps has type string where A was originally, but has now been instantiated to number.

focus<{ a: { b: number, c: string } }, ???>(x,
  { get: x => x.a.b, modify: (x: number) => x + 1 },
                                      ^
 A cannot be both string and number ! |
			   	      v
  { get: x => x.a.c, modify: (x: string) => x + "a" },
)

The type string and number do not unify and this results in a type error.

Currently, focus specifies that it works for any choice of S and A, but the choice of this S and A is fixed. So when we try to have updates focused on a property of type number and string at the same time it does not work.

Instead, what we intended is that the parameter A is existentially quantified on the type GetModOps. This means that for each op in ops there exists a type A for which we have an S => A and A => A.

The How

So, our intended focus function is more like this: focus works for all types S and each op in ops has a, potentially different, type A associated with it.

type GetModOps<S> = <exists A>{ get: (s: S) => A, modify: (a: A) => A }

function focus<S>(
  s: S,
  ...ops: GetModOps<S>[]
) {
  return ops.reduce((acc, op) => iassign(acc, op.get, op.modify), s);
}

Where <exists A> is invented syntax to specify the existential type A. Obviously, typescript does not support this syntax, so what do we do?

Luckily, we remember the incantation <exists A>(T<A>) = <R>(cont: (<A> (t: T<A>) => R)) => R from our spell book (slightly adapted to fit the syntax used in typescript).

We create the type GetMod<S> which encodes <exists A>(GetModOps<S, A>).

type GetModOps<S, A> = { get: (s: S) => A, modify: (a: A) => A };
type GetMod<S> = <R>(cont: <A>(t: GetModOps<S, A>) => R) => R;

… Let’s take a step back here, what exactly is GetMod and how do we use it?

Continuations

The type GetMod has the form (_ => R) => R, which is the typical form of continuation passing style.

Let’s first take a look at the slightly simpler type NumberCont<R> = (cont: (x: number) => R) => R. It is a function that takes a function (x: number) => R as parameter. We can think of (x: number) => R as awaiting a number for completion, also known as a continuation. So, the following function yourNumber is waiting for a number to return a string.

function yourNumber(x: number): string {
  return ("your number is " + x);
}

Then, myNumber of type NumberCont<string> passes the value 1 to a continuation waiting for a number.

const myNumber: NumberCont<string> = cont => cont(1);

We obtain our result value by passing the continuation yourNumber to myNumber, or myNumber(yourNumber) return "your number is 1".

Polymorphic Continuations

The use of GetMod is very similar to the NumberCont type. To explain it, we will go back to the ‘more complicated’ example where we wanted to transform { a: { b: 1, c: "a" } } with the following modifications:

{ get: x => x.a.b, modify: x => x + 1 }
{ get: x => x.a.c, modify: x => x + "a" }

Let’s start with creating a focus function for this case specifically. We create a continuation corresponding to each of the modifications we want to apply. The first continuation waits for a GetModOps and applies it to x. We obtain the result of the modification by passing the continuation to the modification, remember that a modification of type GetMod will call the passed continuation with a provided value. The interesting part is that the type parameter A of each continuation is linked to the continuation, not to the focus function, meaning that A can be different for each modification. Which is of course exactly what we wanted!

function focus<S>(
  x: S,
  modification1: GetMod<S>,
  modification2: GetMod<S>, 
) {
  const continuation1 = <A>(op: GetModOps<S, A>) => iassign(x, op.get, op.modify);
  const acc1 = modification1(continuation1);
  const continuation2 = <A>(op: GetModOps<S, A>) => iassign(acc1, op.get, op.modify);
  return modification2(continuation2);
}

A GetMod is created by passing the get and modify functions as a record to the received continuation. I called this over for a slightly more memorable syntax, the name is inspired by its namesake of the Haskell lens library.

function over<S, A>(
  get: (s: S) => A,
  modify: (a: A) => A,
): GetMod<S> {
  return e => e({ get, modify });
}

Using over, we can tansform our object as advertised at the start of the post.

const transformedX = focus(
  { a: { b: 1, c: "a" } },
  over(x => x.a.b, x => x + 1),
  over(x => x.a.c, x => x + "a"),
);
// transformedX = { a: { b: 2, c: "aa" } }

We can easily generalize the focus function with reduce so it takes any number of GetMods.

function focus<S>(
  s: S,
  ...mods: GetMod<S>[]
): S {
  return mods.reduce((acc, mod) => mod(op => iassign(acc, op.get, op.modify)), s);
}

Conclusion

In this post we covered the use of existential types encoding to create a wrapper for the immutable-assign library. We took a closer look at the use of this encoding with an analogy to continuation passing style.

However, it lacks nice support for subrecords, a record which may contain values for the labels. While we can create the SubRow class to denote in the context that we are dealing with a subrecord, it does not solve all our problems.

-- | `Union a b c` means a ∪ b = c
-- | `SubRow a b` means a is a subrow of b
-- | or: there exists an x for which `Union a x b` holds
class SubRow (a :: # Type) (b :: # Type)
instance subRow :: Union a x b => SubRow a b

Let’s say we wanted to create a subrecord as a value. The following will not compile:

-- does not compile
testSubRecord1 :: forall a. SubRow a ( x :: Int, y :: String ) => Record a
testSubRecord1 = { x: 42 }

The problem is that we need an exists quantifier, instead of a forall quantifier. Namely, there exists an a, in this case ( x :: Int ), which is a subrow of ( x :: Int, y :: String ) and returned as value. Function testSubRecord1 does not work for all subrows of ( x :: Int, y :: String ).

purescript-subrecord

Introducing the Work-In-Progress purescript-subrecord, a library which contains the SubRecord type. A SubRecord x may contain values for the labels in row x. For example, a value of type SubRecord ( x :: Int, y :: String ) could be any of: {}, { x :: Int }, { y :: String} or { x :: String, y :: String }.

So, how does it work? Let’s take a look at the data declaration for SubRecord.

foreign import data SubRecord :: # Type -> Type

It has the same kind as Record, but the data type does not have any constructor for its values. Instead a constructor function is provided, giving us something similar to an exists quantifier. I got this idea from the purescript-exists library. To create a SubRecord we use mkSubRecord.

mkSubRecord :: forall a x r.
               Union a x r =>
               Record a -> SubRecord r
mkSubRecord = unsafeCoerce

It uses unsafeCoerce under the hood, a SubRecord uses the same underlying representation as a Record.

We can use mkSubRecord on a Record a, from which it creates a SubRecord r if a is a subrow of r. This constructor allows the returning of subrecords as values, for example:

testSubRecord2 :: SubRecord ( x :: Int, y :: String )
testSubRecord2 = mkSubRecord { x: 42 }

And if we try to add a wrong label, the compiler will warn us.

wrongLabel :: SubRecord ( x :: Int, y :: String )
wrongLabel = mkSubRecord { z: 42 }
             ^^^^^^^^^^^^^^^^^^^^^
   could not match ( z :: Int | r ) with ( x :: Int, y :: String )

We can go back to a Record by providing default values for all labels in the row. (Note: For some reason the function withDefaults compiles only if the type is inferred, it doesn’t compile if the annotation is given explicitly.)

withDefaults :: forall a. Record a -> SubRecord a -> Record a
withDefaults defaults = unSubRecord (\r -> Record.build (Record.merge defaults) r)

Which makes use of the slightly more general unSubRecord.

unSubRecord :: forall x r.
               (forall a.
                Union a x r =>
                Record a -> Record r
               ) ->
               SubRecord r -> Record r
unSubRecord = passNullContext

Which is basically unsafeCoerce but it passes an undefined into the dictionary argument of the forall a. Union a x r => Record a -> Record r function. The unSubRecord is the deconstructor for SubRecord, it safely transforms a SubRecord into a Record by taking a function which works on all subrecords a of r.

An example use of withDefaults is:

testWithDef :: { x :: Int, y :: String }
testWithDef = withDefaults { x: 0, y: "default" } testSubRecord2

Then testWithDef.x evaluates to 42, set by testSubRecord2, and testWithDef.y evaluates to "default", the given default for label y.

Building SubRecords

With the Data.SubRecord.Builder, similar to the Data.Record.Builder, we can create a record by inserting values one at a time.

insert
  :: forall l a r1 r2
   . RowCons l a r1 r2
  => RowLacks l r1
  => IsSymbol l
  => SProxy l
  -> Maybe a
  -> Builder (SubRecord r1) (SubRecord r2)
insert l (Just a) = Builder \r1 -> unsafeInsert (reflectSymbol l) a r1
insert l Nothing = Builder \r1 -> unsafeCoerce r1

Notice that we can add Maybe a values to the SubRecord, meaning that we can extend the label of the SubRecord without actually adding a value. For example:

testInsert :: SubRecord ( x :: Int, y :: String )
testInsert =
  SubRecord.build
    (SubRecord.insert (SProxy :: SProxy "x") (Just 42) >>>
     SubRecord.insert (SProxy :: SProxy "y") Nothing
    ) (mkSubRecord {})

Is equivalent to mkSubRecord { x: 42 } :: SubRecord ( x :: Int, y :: String ).

Feedback Welcome

Any feedback or suggestions are welcome, so they can be added before I make the first release. I plan to port the Data.Record.Builder functions present in purescript-record to their SubRecord equivalent. Feel free to add suggestions as a github issue.

The interesting point I want to highlight in this post doesn’t have much to do with this specific use case. It’s probably quite rare that you specifically need nub where ordNub wouldn’t work. What I do want to highlight is that if this situation ever arose in Scala, we would be able to use implicit prioritization to avoid having to choose at all.

Approach

We are going to create a typeclass containing the function signature for nub. By using implicit prioritization we can prefer the instance which uses Ord over the one with Eq, this is done by putting the Ord-based instance in a subclass. This was explained in the stackoverflow post:

trait LowPriorityImplicits {
  //lower priority conversions
}

object HighPriorityImplicits extends LowPriorityImplicits {
  //higher-order ones here
}

Implementation

First we set up the Eq and Ord typeclasses so we can control the available implicit values for them. We’re not actually going to implement any deduplicator functions here, so let’s just make them return a cool String.

trait Eq[A] {
  def eq: String
}
trait Ord[A] {
  val ord: String
}

Let’s give Int an Eq and Ord instance, but only give String an Eq instance. So, when we nub a list of Ints it should use the Ord version while for a list of Strings it should use the Eq version.

implicit val eqInt: Eq[Int]
 = new Eq[Int] { val eq = "My name is Eq Int." }
implicit val ordInt: Ord[Int]
 = new Ord[Int] { val ord = "Hi! I'm Ord Int." }

implicit val eqString: Eq[String]
 = new Eq[String] { val eq = "Hello there, I am known as Eq String." }

We set up another typeclass called Nubbable. We prioritize the creation of instances for this typeclass with a simple rule: prefer the Ord-based over the Eq-based one. We can do this by putting the Ord-based instance in a subclass of where the Eq-based instance is located. For example:

trait Nubbable[A] {
  def nubbed(l: List[A]): String
}

trait LowPrio {
  implicit def eqNub[A](implicit ev: Eq[A]): Nubbable[A]
    = new Nubbable[A] {
      def nubbed(l: List[A]) = "Message from nubber: " + ev.eq
    }
}

object HighPrio extends LowPrio {
  implicit def ordNub[A](implicit ev: Ord[A]): Nubbable[A]
    = new Nubbable[A] {
      def nubbed(l: List[A]) = "Message from nubber: " + ev.ord
    }
}

Now, when we create our nub function by taking Nubbable as an implicit parameter and run it on some examples we get our expected output. The Ord instance responds for Int, while the Eq instance responds for String.

import HighPrio._

def nub[A](l: List[A])(implicit ev: Nubbable[A]): String
 = ev.nubbed(l)

println(nub(List(1,2,3)))
// Message from nubber: Hi! I'm Ord Int.
println(nub(List("a","b","c")))
// Message from nubber: Hello there, I am known as Eq String.

Conclusion

I think this is a cool showcase of maybe a lesser known feature, used by some Scala libraries. I also find it interesting that I could easily solve this problem in Scala, while I wouldn’t know how to solve it in a same fashion in Haskell (if it is even possible). You can find the code for this example here.

For this reason I would disadvise using this trick in actual code, make sure you are aware of the risks and are able to deal with them if you ever intend to use this.

The examples are given in Purescript. The effect of laziness (for example in Haskell) on this trick is discussed in section ‘Laziness’.

Monadic Computations

As opposed to computations with Applicative constraints, this post will only handle computations which have Monad constraints. For example consider the following computation:

prog1 :: forall f r a.
         Monad f =>
         { get :: String -> f a
         , put :: String -> a -> f Unit | r } ->
         a -> f (Array a)
prog1 k mouse = do
   f <- k.get "Cats"
   s <- k.get "Dogs"
   k.put "Mice" mouse
   t <- k.get "Cats"
   pure [f, s, t]

The type signature tells us that we need a handler k which interprets at least the get and put operations, it also takes an input for the "Mice" location named mouse. The computation returns all retrieved data as an f (Array a), f being the type constructor the handler interprets to.

We want to interpret the computation into two Sets, one to gather all keys from get operations and the other to gather all keys and values from put operations. These Sets enable the creation of an optimized program: a unique get and put for each location, but we won’t go into detail on this here.

However, we cannot use applicative inspection using Const to realize this. The program is written in do notation and thus has a Monad constraint and Const doesn’t have a Monad instance. This is where the trick comes in. We will write an interpretation to Writer. Normally we would consider this impossible because of the following problem:

We need to write an interpretation for the get and put operation. However, note the spots marked with ?. We need to construct the writer by giving it both a value a and a value of (Set, Set). Remember that Writer w a is isomorphic to (w, a). The value a is missing since we are not actually running the computation, merely inspecting it.

get1 :: forall a. String -> Writer (Tuple (S.Set String) (S.Set (Tuple String Int))) a
get1 key = writer (Tuple ? (Tuple (S.singleton key) (S.empty)))

put1 :: forall a. String -> Int -> Writer (Tuple (S.Set String) (S.Set (Tuple String Int))) a
put1 key value = writer (Tuple ? (Tuple (S.empty) (S.singleton (Tuple key value))))

The trick is actually very simple, we will use a function which tricks the type system:

undef :: forall a. a
undef = unsafeCoerce "oops!"

We use this new undef as a replacement for ?, essentially cheating the type system by saying the value a is available while it actually isn’t. However, we never intend to do anything with this value, so this fact doesn’t matter. We replace ? by undef to obtain the handler:

get1 :: forall a. String -> Writer (Tuple (S.Set String) (S.Set (Tuple String Int))) a
get1 key = writer (Tuple undef (Tuple (S.singleton key) (S.empty)))

put1 :: forall a. String -> Int -> Writer (Tuple (S.Set String) (S.Set (Tuple String Int))) a
put1 key value = writer (Tuple undef (Tuple (S.empty) (S.singleton (Tuple key value))))

This is already sufficient to inspect prog1 and give us the result we want, for the gets [“Cats”, “Dogs”] and for the puts [(“Mice”, 1)]:

 > snd $ runWriter $ prog1 {get:get1, put:put1} 1
(Tuple (fromFoldable ("Cats" : "Dogs" : Nil)) (fromFoldable ((Tuple "Mice" 1) : Nil)))

We can also see the type system lying to us (because we cheated!):

 > :t fst $ runWriter $ prog1 {get:get1, put:put1} 1
Array Int

Which, when evaluated, gives us ["oops!","oops!","oops!"], definitely not an array of Ints! But, again, the intention of the inspection is to ignore the actual result of the computation, the a part of the writer is intended to never be used. So, while somewhat weird, this isn’t really the problem with the trick.

Laziness

Laziness has some interesting implication for this trick. Consider a slightly altered version of our scenario. The get operation returns Maybe a instead of a:

prog2_strict :: forall f r a.
                Monad f =>
                { get :: String -> f (Maybe a)
                , put :: String -> a -> f Unit | r } ->
                a -> f (Array a)
prog2_strict k mouse = do
   f <- k.get "Cats"
   s <- k.get "Dogs"
   k.put "Mice" mouse
   t <- k.get "Cats"
   pure (catMaybes [f, s, t])

The only change we have to make is returning the final array using catMaybes to compress Array (Maybe a) into Array a.

What happens if we inspect this program?

 > snd $ runWriter $ prog2_wrong {get:get1,put:put1} "a"
Uncaught Error: Failed pattern match at Data.Maybe line ...

Whoops! Purescript is not lazy, so it tries to interpret the "oops!"s as Maybe as because it wants to know if it is a Just a or Nothing, due to the catMaybes call, even though we never requested to calculate the result of the computation…

When using Haskell, this problem shouldn’t surface because it is lazy by default. And if we never request the result array, the dark secret won’t be revealed.

A solution in Purescript is to use opt-in laziness and create a thunk out of the result array:

prog2_lazy :: forall f r a.
              Monad f =>
              { get :: String -> f (Maybe a)
              , put :: String -> a -> f Unit | r } ->
              a -> f (Lazy (Array a))
prog2_lazy k mouse = do
   f <- k.get "Cats"
   s <- k.get "Dogs"
   k.put "Mice" mouse
   t <- k.get "Cats"
   pure (defer (\_ -> catMaybes [f, s, t]))

Which makes the example work again:

 > snd $ runWriter $ prog2_lazy {get:get1, put:put1} 1
(Tuple (fromFoldable ("Cats" : "Dogs" : Nil)) (fromFoldable ((Tuple "Mice" 1) : Nil)))

Applicability

So, why go through the trouble to use this unsafe trick when a perfectly viable alternative exists? The reason is that the alternative is not as perfect as it seems on first sight.

Categorizing computations as applicative or monadic is very coarse-grained. This results in Monad constraints popping up in all sorts of situations, which disables the applicative inspection. But it doesn’t mean that these programs are not inspectable at all. In some sense this coarse modeling of computations results in the type system preventing us of running some inspections we would want to do.

Take prog3 for example:

prog3 :: forall f r a.
         Monad f =>
         { get :: String -> f a
         , put :: String -> a -> f Unit | r } ->
         f (Array a)
prog3 k = do
   f <- k.get "Cats"
   s <- k.get "Dogs"
   k.put "Mice" f
   t <- k.get "Cats"
   pure [f, s, t]

The difference with prog1 is that we pass the value f from k.get "Cats" to k.put "Mice" f. Obviously, we cannot inspect this computation to return the values of all puts, they are not statically known. But, we are able to inspect all locations which will be touched by only gathering the keys. We can easily adapt the handler:

get2 :: forall a. String -> Writer (Tuple (S.Set String) (S.Set String)) a
get2 key = writer (Tuple undef (Tuple (S.singleton key) (S.empty)))

put2 :: forall a. String -> Int -> Writer (Tuple (S.Set String) (S.Set String)) a
put2 key value = writer (Tuple undef (Tuple (S.empty) (S.singleton key)))

We see the sets [“Cats”, “Dogs”] and [“Mice”] as result of our inspection:

> snd $ runWriter $ prog3 {get:get2, put:put2}
(Tuple (fromFoldable ("Cats" : "Dogs" : Nil)) (fromFoldable ("Mice" : Nil)))

Another example of a Monad constraint popping up is when we add some logging to our computation:

prog4 :: forall f r a.
         Monad f =>
         Show a =>
         { get :: String -> f a
         , put :: String -> a -> f Unit
         , log :: String -> f Unit | r } ->
         a -> f (Array a)
prog4 k mouse = do
   f <- k.get "Cats"
   k.log ("Cats: " <> show f)
   s <- k.get "Dogs"
   k.log ("Dogs: " <> show s)
   k.put "Mice" mouse
   t <- k.get "Cats"
   k.log ("Cats: " <> show t)
   pure [f, s, t]

I am aware that we could rewrite the program to fit the applicative inspection style, but it feels quite awkward that this is necessary.

By essentially turning off the logging to prevent any errors from surfacing (although I don’t think it is a problem even if it actually logged things):

log1 :: forall f a. Applicative f => String -> f a
log1 s = pure undef

We can analyze the computation as well, without having to modify its definition:

> snd $ runWriter $ prog4 {get:get1, put:put1, log:log1} 1
(Tuple (fromFoldable ("Cats" : "Dogs" : Nil)) (fromFoldable ((Tuple "Mice" 1) : Nil)))

There are more situations this applies to, but hopefully the point is clear.

Mismatching handler and computation

I want to highlight the fact that if we mismatch a handler and computation we will get into weird behaviour territory as well. This is in fact the main issue I see with actually using this trick. You are essentially throwing away the safety given by the type system to apply this trick.

For example inspecting prog3 with get1 and put1, which assume that all put values are statically available will result in an erroneous value since the computation will catch the unsafe undef value.

> snd $ runWriter $ prog3 {get:get1, put:put1}
(Tuple (fromFoldable ("Cats" : "Dogs" : Nil)) (fromFoldable ((Tuple "Mice" oops!) : Nil)))

Notice the "oops!" value in the second set, if it was used as an Int it would most likely result in a runtime error somewhere.

Conclusion

I think this trick highlights possibilities for alternative categorizations of computations, which are more fine-grained than applicative/monad, in fact also more fine-grained than applicative/arrow/monad. The actual trick in itself, due to it actively cheating the type system, should probably not be used in practice however.

You can check out the full code in this gist, which can be pasted into Try Purescript to run it.

For example with a definition of the natural numbers:

data Nat = Zero | S Nat

And some functions:

-- returns whether a natural number is even
even' :: Nat -> Bool
even' Zero = True
even' (S n) = not (even' n)

-- returns 2* the input natural number
times2 :: Nat -> Nat
times2 Zero = Zero
times2 (S n) = S (S (times2 n))

We can prove that even' (times2 x) evaluates to True for all x by induction on x. Let’s try that:

We have two cases. First we need to prove that it holds when x = Zero

even' (times2 Zero)
-- definition times2
= even' Zero
-- definition even'
= True

For X = S n we prove even' (times2 n) = True implies even' (times2 (S n)) = True.

even' (times2 (S n))
-- definition times2
= even' (S (S (times2 n)))
-- definition even'
= not (even' (S (times2 n)))
-- definition even'
= not (not (even' (times2 n)))
-- property of not
= even' (times2 n)
-- using induction hypothesis
= True

Having proven the property for both cases we have given a proof that even' (times2 x) = True for all x by induction.

In point-free equational reasoning however there are no ‘points’, there are no variables on which we can declare induction. But we would still like to be able to prove certain things in a similar manner.

So our earlier property written point-free is even' . times2 = const True, but how can we argue that this property holds? There is no x on which we can declare induction…

Initiality and $F$-Algebras

To correctly state our proof some mathematical concepts are to be introduced. I assume some basic familiarity with category theory, so I won’t reintroduce the definitions of a category or functor here. (If you are not familiar though, my suggestion would be to take a look at Bartosz’ category theory for programmers)

Initial Object An initial object is an object with a unique morphism to every other object. This uniqueness is an essential property we will use to prove that two morphisms are equal.

$F$-Algebra $F$-Algebras are composed of two things: a carrier $A$ and an action $a : FA \rightarrow A$, where $F$ is an endofunctor. I will use the notation $\langle A, a \rangle$ for $F$-Algebras.

Algebra homomorphisms are then functions on the underlying carriers which adhere to a special condition. A function $f : A \rightarrow B$ is an algebra homomorphism from $\langle A, a \rangle$ to $\langle B, b \rangle$ if $f \circ a = b \circ Ff$.

(For a more in-depth read on $F$-Algebras I suggest to read this post by Bartosz)

It turns out that $F$-Algebras and algebra homomorphisms form a category with the former as objects and the latter as morphisms. And in this category we have an initial object, the initial $F$-Algebra.

Coproduct One other thing I want to point out is the notation I will use for the universal property of coproducts. If we have morphisms $f : A \rightarrow X$ and $g : B \rightarrow X$ then I will use $[f, g] : A + B \rightarrow X$ to denote the universal property of the coproduct.

An example of this is pattern matching on Either:

coproduct :: (a -> x) -> (b -> x) -> (Either a b -> x)
coproduct f _ (Left a) = f a
coproduct _ g (Right b) = g b

To prove our example shown in the first section we actually only need to work with one functor, namely the one for which natural numbers are the initial algebra (with $[\mathit{zero}, \mathit{succ}]$ as action). This functor is $1 + X$, which instantiated as a Haskell Functor is Either () a.

Our initial algebra is then $\langle\mathbb{N}, [\mathit{zero}, \mathit{succ}] : 1 + \mathbb{N} \rightarrow \mathbb{N} \rangle$. Initiality for the $1 + X$ functor means the following diagram holds for any algebra $\langle B, [\phi_1, \phi_2] : 1 + B \rightarrow B \rangle$ (where $f$ is the unique morphism which makes the diagram commute):

Which is actually equivalent to the following two diagrams:

or in equations:

• $f \circ \mathit{zero} = \phi_1$
• $f \circ \mathit{succ} = \phi_2 \circ f$

So we will tackle our problem by proving that we have two different morphisms which satisfy these equations, but because we know $f$ is unique we know they must be equal.

Point-Free Induction

The Either () a functor from earlier is also isomorphic to the following data type, defined for convenience:

data NatF a = ZeroF | SF a

instance Functor NatF where
  fmap f ZeroF = ZeroF
  fmap f (SF a) = SF (f a)

Maybe you have seen this functor somewhere else.

Anyways, to create an initial algebra we also need an action:

inNatF :: NatF Nat -> Nat
inNatF ZeroF = Zero
inNatF (SF n) = S n

Or in coproduct notation $[$const Zero, S$] :$ NatF Nat -> Nat. These two together create our initial algebra $\langle$Nat, $[$const Zero, S$] : $ NatF Nat -> Nat $\rangle$. ($\mathit{zero}$ = const Zero, $\mathit{succ}$ = S)

This initial algebra has a unique algebra homomorphism to any other algebra for our functor. Let’s take the algebra $\langle$Bool, $[$const True, id$] : $ NatF Bool -> Bool $\rangle$, which we will need in our upcoming proof. ($\phi_1$ = const True, $\phi_2$ = id)

By initiality we have the unique function f : Nat -> Bool where the following two equations hold:

• f . const Zero = const True
• f . S = id . f

So intuitively speaking f is True when applied to Zero and then f applied on any successor Nat is equal to the result of its predecessor, so it results in always being True.

And indeed plugging in const True for f makes the two equations work out:

(const True) . (const Zero)
= const True

(const True) . S
= const True
= id . (const True)

So this seems like a step in the right direction. If we can show that the even' . times2 function is also an algebra homomorphism to this algebra then by uniqueness we can conclude that they are the same function and our proof is complete!

And indeed substituting f for even' . times2 makes the equations work out as well (we do have to adopt a point-free style for the even' and times2 functions, but they are still the same):

even' . times2 . (const Zero)
-- definition times2
= even' . (const Zero)
-- definition even'
= const True

even' . times2 . S
-- definition times2
= even' . S . S . times2
-- definition even'
= not . even' . S . times2
-- definition even'
= not . not . even' . times2
-- property of not
= even' . times2
-- introduce id
= id . even' . times2

Conclusion

So if you’ve ever wondered how initial algebras provide the framework for induction, in this post we explored an example illustrated with Haskell by applying the underlying theory for initiality of initial algebras.

When I was trying to figure out how this worked I couldn’t really find any source explaining it in enough detail for me to understand it from the ground up, so I decided to write this up.

I will explain how I did section 4.1 ‘Typed sprintf’.

Setting

Let’s explain what we want to achieve (paraphrasing from the pdf).

We want to make a typed printing function inspired by the not type-safe C function sprintf.

What this function does is print out a formatted string, but it can take a variable amount of parameters to be printed as well.

So for example sprintf("Name %s") requires an extra String argument, so we would want it to be a String => String. But we would want sprintf("Name=%s, Age=%d") to be a String => Int => String, since it takes an extra Int parameter. I assume you can extrapolate some other examples yourself.

The pdf then goes on to explain how it can be encoded in Haskell using type families. I will show how I ported this code to Scala.

Representation

We will represent what we want to print (in the pdf called an F) as follows:

• We can request to print a literal, we call this Lit. It must also take a String argument, this is the literal we want to print
• We can request to print a value, we call this Val. This can have any type so we make it have a generic type. We also encode a way to print this value as an A => String function.
• We need to be able to represent arbitrary combinations of the previous two, we call this Cmp. With Cmp we can combine two Fs to create a bigger F.

We end up with this definition:

sealed trait F
case class Lit(str: String) extends F
case class Val[A](printer: A => String) extends F
case class Cmp[F1 <: F, F2 <: F](f1: F1, f2: F2) extends F

In this way we could encode the name/age example printing as follows:

val valInt = Val[Int](_.toString)
val valStr = Val[String](identity)
val nameAge = Cmp(Cmp(Lit("name="), valStr), Cmp(Lit(", age="), valInt))

A little cumbersome, but it does the job.

Now our type family TPrinter will be represented like this:

sealed trait TPrinter[A <: F, X] {
   type Out

   def print(f: A, k: String => X): Out
}

We can see this as: given a type A and X we will have a type Out corresponding to it. A type-level function in a way.

Our TPrinter also has a function print which takes an F (our representation to print) and a k : String => X. It will then return something of type Out, which in the name/age example should be String => Int => String.

The function k will be String => String (or identity) at the top level, but will become more important when we get to the implementation of the Cmp case for printing.

We’re also gonna be using the Aux pattern to be able to refer to the Out type in implicit parameters:

object TPrinter {
  type Aux[A <: F, X, Out0] = TPrinter[A, X] { type Out = Out0 }
}

Implementing the Type Family

Remember when I referred to the the type family as a type-level function? This might come across clearer when you see what behaviour we expect:

// some example behaviour:
// given a Lit and a String, we want to receive type String
implicitly[TPrinter.Aux[Lit, String, String]]
// but also: given a Lit and an Int => String, we want to receive type Int => String
implicitly[TPrinter.Aux[Lit, Int => String, Int => String]]
// given a Val[Int] and a String, we want to receive type Int => String
implicitly[TPrinter.Aux[Val[Int], String, Int => String]]
// but also: given a Val[Int] and an Int => String, we want to receive type Int => Int => String
implicitly[TPrinter.Aux[Val[Int], Int => String, Int => Int => String]]
// given a Cmp[Lit, Val[Int]] and a String we want to receive type Int => String
implicitly[TPrinter.Aux[Cmp[Lit, Val[Int]], String, Int => String]]
// given a Cmp[Cmp[Lit, Val[String]], Cmp[Lit, Val[Int]]]
//   and a String we want to receive type String => Int => String
// notice this first type has the same type as `nameAge`
implicitly[TPrinter.Aux[Cmp[Cmp[Lit, Val[String]], Cmp[Lit, Val[Int]]],
           String, String => Int => String]]

More generally we want the following to hold:

When we have A = Lit then Out = X. A literal doesn’t change the type of our print function.

Implementing this is quite straightforward. The print function will execute the k on the given literal string.

implicit def tPrinterLit[X]: TPrinter.Aux[Lit, X, X] = new TPrinter[Lit, X] {
  type Out = X

  override def print(f: Lit, k: (String) => X): X = k(f.str)
}

When we have A = Val[V] then Out = V => X. A value adds another typed parameter at the start of our function.

This is also fairly straightforward. We return a function which takes the typed parameter and when called will use the given printer to print this parameter as a String.

implicit def tPrinterVal[X, A]: TPrinter.Aux[Val[A], X, A => X] = new TPrinter[Val[A], X] {
  type Out = A => X

  override def print(f: Val[A], k: (String) => X): A => X =
    (x: A) => k(f.printer(x))
}

When we have A = Cmp[F1, F2] then Out = something which combines the output of the printer function for F1 and F2.

Ouch this one seems a bit harder to express, let’s make the implementation and leave some generics open and see if the type checker can help us.

We will need the TPrinter instances for F1 and F2. These will be printerF1 : TPrinter.Aux[F1, XF1, OF1] and printerF2 : TPrinter.Aux[F2, XF2, OF2].

Eventually we will need to print the two sides and return an X again. This is k(s1 + s2) and has signature endStr : String => String => X.

If we have the first part as a String (let’s say s1) we can create the printer function for the second part by doing printerF2.print(f.f2, s2 => endStr(s1, s2)). This returns us the printer function determined by the second part OF2, so print2 : String => OF2.

Then we can create the definition for the overall printer function printerF1.print(f.f1, s1 => print2(s1). This has type OF1, the output type of the first TPrinter.

Let’s write out the first attempt. We can see the type checker isn’t quite happy yet.

// WARNING: doesn't compile, for fixed version see below
implicit def tPrinterCmp[X, F1 <: F, F2 <: F, XF1, XF2, OF1, OF2, OUT]
  ( implicit printerF1: TPrinter.Aux[F1, XF1, OF1]
  , printerF2: TPrinter.Aux[F2, XF2, OF2]
  ): TPrinter.Aux[Cmp[F1, F2], X, OUT] = new TPrinter[Cmp[F1, F2], X] {
  type Out = OUT

  override def print(f: Cmp[F1, F2], k: (String) => X): OUT = {
    def endStr(s1: String, s2: String): X = k(s1 + s2)
    def print2(s1: String) = printerF2.print(f.f2,
	// we have : String => XF2 , we need : String => X
	  s2 => endStr(s1, s2))
    def print1 = printerF1.print(f.f1,
	// we have : String => OF2 , we need : String => XF1
	  s1 => print2(s1))

	// we have : OF1 , we need : OUT
    print1
  }
}

Following the guidance of the type checker gets us at the correct result, but let’s reason about it a little bit more.

OF2 will give us the type of the second part of the print function. This will be (A =>)* String, where ()* denotes zero or more occurrences.

We want the first printer part to add types at the start of the OF2 type, as in (B =>)* (A =>)* String, this is OF1.

If XF1 = OF2 then we have the behaviour we want:

• in case of Lit, (B =>)* is empty and we get back (A =>)* String for OF1.
• in case of 1 Val[V] we get back V => (A =>)* String for OF1
• etc…

Then we can also see that OUT must be equal to OF1, since OF1 is the output type we want for the printer function for the Cmp case.

Since there is no recursive lookup for the tprinterF2 case our XF2 must be X. Ok, this explanation isn’t that intuitive but the type checker insists on having it like this, so let’s comply.

Doing all the substitutions gives us:

implicit def tPrinterCmp[X, F1 <: F, F2 <: F, OF1, OF2]
  ( implicit printerF1: TPrinter.Aux[F1, OF2, OF1]
  , printerF2: TPrinter.Aux[F2, X, OF2]
  ): TPrinter.Aux[Cmp[F1, F2], X, OF1] = new TPrinter[Cmp[F1, F2], X] {
    type Out = OF1

    override def print(f: Cmp[F1, F2], k: (String) => X): OF1 = {
      def endStr(s1: String, s2: String): X = k(s1 + s2)
      def print2(s1: String) = printerF2.print(f.f2, s2 => endStr(s1, s2))
      def print1 = printerF1.print(f.f1, s1 => print2(s1))

      print1
    }
}

And lo and behold! We have implemented our very own typed printing function.

Using the function

How can we use our function? Well that’s easy, like this:

println(
  implicitly[TPrinter.Aux[
    Cmp[Cmp[Lit, Val[String]], Cmp[Lit, Val[Int]]], String, String => Int => String]
  ].print(nameAge, identity)("ruben")(23))

Not convinced on the usability? Okay let’s create an implicit class for some nicer ops

implicit class printerOps[A <: F](f: A) {
   def print[X, O](k: String => X)(implicit tp: TPrinter.Aux[A, X, O]): O = tp.print(f, k)
   def sprintf[O](implicit tp: TPrinter.Aux[A, String, O]): O = tp.print(f, identity)
}

Now we can do this (I have to use .apply since otherwise it thinks I’m passing the implicit TPrinter instance):

println(nameAge.sprintf[String => Int => String].apply("ruben")(23))

Okay that’s a bit cooler, but if we leave out the type annotation then it doesn’t compile anymore, which is a bit of a shame.

But! The guys at dotty have done their job well and using the dotty compiler we can write the example like this:

println(nameAge.sprintf.apply("ruben")(23))

Ok that’s looking more like it. Now if only we could also parse "name=%s, age=%d" as it’s corresponding F type (at compile-time), then we would have something pretty close to the original C function, but type-safe. This is probably possible by implementing type-level String parsing, but I’ll leave that for another time…

Check out the full code for this post on this scalafiddle.

I will use the following as our running example for the different approaches:

We will create a method that gets the state of an Int variable. If it is larger than 0 we will decrease it by 1, otherwise we will throw an error.

We can identify that we have two types of effects: a State-effect (accessing and mutating a mutable variable) and an Error-effect (exiting computation with an error).

Monad Transformers

Let’s first take a look at the monad transformer approach. In this approach we work with the actual monad transformers to define our method. Let’s try that:

(Note that the ? alternate syntax for type lambdas comes from Kind Projector)

type MonadStackStateTEither[ErrorType, StateType, ReturnType] =
  StateT[Either[ErrorType, ?], StateType, ReturnType]

def decrMonadStackStateTEither: MonadStackStateTEither[String, Int, Unit] = ???

We can see that we compose the Either monad (which is what we’ll be using as our Error-effect during this post) with the State monad by using the StateT monad transformer.

This gives us a monad which can do both Error-effects and State-effects, which I called MonadStackStateTEither. Let’s complete our method definition:

def decrMonadStackStateTEither: MonadStackStateTEither[String, Int, Unit] = for {
  x <- StateT.get[Either[String, ?], Int]
  _ <- if (x > 0) { StateT.set[Either[String, ?], Int](x - 1) }
  else { StateT.lift[Either[String, ?], Int, Unit](Left("error")) }
} yield ()

We can call the get and set methods on the StateT object to get correctly typed State-effects. If we want to use an Error-effect though, we have to use StateT.lift to lift an effect from the Error-effect to our composed stack of State and Error-effects. The lifting makes the types match up so that the Error-effect correctly matches the MonadStackStateTEither type.

You might have noticed that we arbitrarily chose to use StateT on top of Either instead of the other way around. It might look like a small detail, but it is in fact something that can completely change the computed value. So the order in which the monad transformers are set up is important.

We can try the other way around as well. We will use the EitherT monad transformer on the State monad to receive a monad which can do Error and State-effects.

type MonadStackEitherTState[ErrorType, StateType, ReturnType] =
  EitherT[State[StateType, ?], ErrorType, ReturnType]

def decrMonadStackEitherTState: MonadStackEitherTState[String, Int, Unit] = for {
  x <- EitherT.liftT[State[Int, ?], String, Int](State.get[Int])
  _ <- if (x > 0) { EitherT.liftT[State[Int, ?], String, Unit](State.set(x - 1)) }
  else { EitherT.left[State[Int, ?], String, Unit](State.pure("error")) }
} yield ()

We see that now we have to lift State-effects into the correct type via the EitherT.liftT method.

If we run our method we can see that the results we get have different types, which is part of the reason why the order of the monad transformers matter.

(Note that in our second example we need the first .value to access the .run method from State and the second .value because State[S, A] is an alias for StateT[Eval, S, A], which means that we have an Eval effect as well)

val resultStateTEither: Either[String, (Int, Unit)] =
  decrMonadStackStateTEither.run(0)
// returns: Left(error)
val resultEitherTState: (Int, Either[String, Unit]) =
  decrMonadStackEitherTState.value.run(0).value
// returns: (0,Left(error))

mtl-Style Monad Transformers

In this style we have typeclasses for our effects. In our case we will be using MonadState and MonadError. These typeclasses define methods which make sense for their corresponding effects. So MonadState defines methods to interact with a State-effect (get, put, modify, …) and MonadError defines methods to interact with an Error-effect (raise, catch, …).

We declare the result type of our method to be a generic F[_]. Then we implicitly take a MonadState[F] and MonadError[F]. This means that this method is generic for any F[_] which can interact as both of those effects. In this way we do not have to lift any effects into our result type, this lifting will be done in the typeclass instances if necessary.

// beware: does NOT compile, see below
def decrMtlStateError[F[_]](implicit
  ms: MonadState[F, Int],
  me: MonadError[F, String]): F[Unit] = for {
    x <- ms.get
    _ <- if (x > 0) { ms.set(x - 1) }
    else { me.raiseError("error") }
  } yield ()

This method unfortunately does not compile (on Scala 2.12.1 and Cats 0.9.0). The reason for that is that MonadState and MonadError both are Monad[F] instances and so there is an ambiguous implicit. We can resolve this by explicitly using the flatMap method on one of both.

We can write it like this to get it compiled, but it looks a bit ugly:

def decrMtlStateError[F[_]](implicit
  ms: MonadState[F, Int],
  me: MonadError[F, String]): F[Unit] = {
  ms.flatMap(ms.get) { x =>
    if (x > 0) { ms.set(x - 1) }
    else { me.raiseError("error") }
  }
}

Then we can reuse this method for both monad types we used earlier in our example… If there would be a MonadState instance defined for EitherT, which as of writing this post is not the case (on Cats 0.9.0). But we can define our own for now (*).

val resultMtlStateTEither: Either[String, (Int, Unit)] =
  decrMtlStateError[StateT[Either[String, ?], Int, ?]].run(0)
// returns: Left(error)
val resultMtlEitherTState: (Int, Either[String, Unit]) =
  decrMtlStateError[EitherT[State[Int, ?], String, ?]].value.run(0).value
// returns: (0,Left(error))

We see we get the same results as in the previous paragraph, but we could reuse our generic method.

I’m not sure if this style is common in Scala, since playing with this simple example I already came across some issues. But I thought it would be interesting to include it, since it might provide some additional insight moving from monad transformers to Eff.

Eff

The way we use effects in Eff is somewhat similar to the mtl-style. We also have to declare as implicit parameters which effects we want to use. Let’s define some aliases for our effects (like in the Eff user guide):

type _eitherString[R] = Either[String, ?] |= R
type _stateInt[R] = State[Int, ?] |= R

In Eff the type variable R signifies the effect stack. This stack will contain all the effects which our methods can utilize. The |= helper functions means that the effect on the left is a member of the stack R. We will use this as an implicit parameter in the same way as we took MonadState and MonadError as implicit parameters.

Our method signature looks like this:

def decrEff[R : _eitherString : _stateInt]: Eff[R, Unit] = ???

Our effect stack R is a generic type and it must contain at least our _eitherString and _stateInt effect . Our result is Eff[R, A], which means that we will get a result of type A, but we might also execute effects according to the effects in the stack R. For our method A is Unit.

By importing the Eff syntax (import org.atnos.eff._, org.atnos.eff.all._, org.atnos.eff.syntax.all._) we can get a method which looks very similar to our mtl-style method:

def decrEff[R : _eitherString : _stateInt]: Eff[R, Unit] = for {
  x <- get
  _ <- if (x > 0) { put(x - 1) }
  else { left("error") }
} yield ()

Now when calling our method we have to do two things: 1. Choose which effect types we want to use to handle the effects in our stack 2. Choose in which order we will run our effects.

Choosing the types can be done like this:

type FxStack = Fx.fx2[State[Int, ?], Either[String, ?]]

And we can choose the order of effects by composing the runEither and runState methods differently.

val resultRunStateRunEither: Either[String, (Unit, Int)] =
  decrEff[FxStack].runState(0).runEither.run
  // returns: Left(error)
val resultRunEitherRunState: (Either[String, Unit], Int) =
  decrEff[FxStack].runEither.runState(0).run
  // returns: (Left(error),0)

So hopefully by going through this example the basics of Eff are explained well enough to go through the user guide and learn more about it.

You can find all the code used in this post on this gist.

Remark 1 (*)

The MonadState instance for EitherT I used is:

  implicit def monadStateEitherT[F[_], E, S](implicit ms: MonadState[F, S])
    : MonadState[EitherT[F, E, ?], S] = new MonadState[EitherT[F, E, ?], S] {
    val F = Monad[F]
    override def get: EitherT[F, E, S] = EitherT.liftT(ms.get)
    override def set(s: S): EitherT[F, E, Unit] = EitherT.liftT(ms.set(s))
    // copied from cats EitherTMonad
    override def pure[A](a: A): EitherT[F, E, A] = EitherT(F.pure(Either.right(a)))
    override def flatMap[A, B](fa: EitherT[F, E, A])(f: A => EitherT[F, E, B]): EitherT[F, E, B] = fa flatMap f
    override def tailRecM[A, B](a: A)(f: A => EitherT[F, E, Either[A, B]]): EitherT[F, E, B] =
      EitherT(F.tailRecM(a)(a0 => F.map(f(a0).value) {
        case Left(l)         => Right(Left(l))
        case Right(Left(a1)) => Left(a1)
        case Right(Right(b)) => Right(Right(b))
      }))
  }