## Thursday, October 21, 2021

### Co-Applicative programming style

coapplicative

This post showcases an upcoming addition to the `contravariant` package that permits programming in a “co-`Applicative`” (`Divisible`) style that greatly resembles `Applicative` style.

This post assumes that you are already familiar with programming in an `Applicative` style, but if you don’t know what that is then I recommend reading:

#### Example

The easiest way to motivate this is through a concrete example:

``````{-# LANGUAGE NamedFieldPuns #-}

import Data.Functor.Contravariant (Predicate(..), (>\$<))
import Data.Functor.Contravariant.Divisible (Divisible, divided)

nonNegative :: Predicate Double
nonNegative = Predicate (0 <=)

data Point = Point { x :: Double, y :: Double, z :: Double }

nonNegativeOctant :: Predicate Point
nonNegativeOctant = adapt >\$< nonNegative >*< nonNegative >*< nonNegative
where
adapt Point{ x, y, z } = (x, (y, z))

-- | This operator will be available in the next `contravariant` release
(>*<) :: Divisible f => f a -> f b -> f (a, b)
(>*<) = divided

infixr 5 >*<``````

This code takes a `nonNegative` `Predicate` on `Double`s that returns `True` if the double is non-negative and then uses co-`Applicative` (`Divisible`) style to create a `nonNegativeOctant` `Predicate` on `Point`s that returns `True` if all three coordinates of a `Point` are non-negative.

The key part to zoom in on is the `nonNegativeOctant` `Predicate`, whose implementation superficially resembles the `Applicative` style that we know and love:

``nonNegativeOctant = adapt >\$< nonNegative >*< nonNegative >*< nonNegative``

The difference is that instead of the `<\$>` and `<*>` operators we use `>\$<` and `>*<`, which are their evil twins dual operators1. For example, you can probably see the resemblance to the following code that uses `Applicative` style:

``````readDouble :: IO Double

#### Types

I’ll walk through the types involved to help explain how this style works.

First, we will take this expression:

``nonNegativeOctant = adapt >\$< nonNegative >*< nonNegative >*< nonNegative``

… and explicitly parenthesize the expression instead of relying on operator precedence and associativity:

``nonNegativeOctant = adapt >\$< (nonNegative >*< (nonNegative >*< nonNegative))``

So the smallest sub-expression is this one:

``nonNegative >*< nonNegative``

… and given that the type of `nonNegative` is:

``nonNegative :: Predicate Double``

… and the type of the `(>*<)` operator is:

``(>*<) :: Divisible f => f a -> f b -> f (a, b)``

… then we can specialize the `f` in that type to `Predicate` (since `Predicate` implements the `Divisible` class):

``(>*<) :: Predicate a -> Predicate b -> Predicate (a, b)``

… and further specialize `a` and `b` to `Double`:

``(>*<) :: Predicate Double -> Predicate Double -> Predicate (Double, Double)``

… and from that we can conclude that the type of our subexpression is:

``````nonNegative >*< nonNegative
:: Predicate (Double, Double)``````

In other words, `nonNegative >*< nonNegative` is a `Predicate` whose input is a pair of `Double`s.

We can then repeat the process to infer the type of this larger subexpression:

``````nonNegative >*< (nonNegative >*< nonNegative))
:: Predicate (Double, (Double, Double))``````

In other words, now the input is a nested tuple of three `Double`s.

However, we want to work with `Point`s rather than nested tuples, so we pre-process the input using `>\$<`:

``````adapt >\$< (nonNegative >*< (nonNegative >*< nonNegative))
where
adapt :: Point -> (Double, (Double, Double))
adapt Point{ x, y, z } = (x, (y, z))``````

… and this works because the type of `>\$<` is:

``(>\$<) :: Contravariant f => (a -> b) -> f b -> f a``

… and if we specialize `f` to `Predicate`, we get:

``(>\$<) :: (a -> b) -> Predicate b -> Predicate a``

… and we can further specialize `a` and `b` to:

``````(>\$<)
:: (Point -> (Double, (Double, Double)))
-> Predicate (Double, (Double, Double))
-> Predicate Point``````

… which implies that our final type is:

``````nonNegativeOctant :: Predicate Point
nonNegativeOctant = adapt >\$< (nonNegative >*< (nonNegative >*< nonNegative))
where
adapt Point{ x, y, z } = (x, (y, z))``````

#### Duals

We can better understand the relationship between the two sets of operators by studying their types:

``````-- | These two operators are dual to one another:
(<\$>) :: Functor       f => (a -> b) -> f a -> f b
(>\$<) :: Contravariant f => (a -> b) -> f b -> f a

-- | These two operators are similar in spirit, but they are not really dual:
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
(>*<) :: Divisible   f => f a        -> f b -> f (a, b)``````

Okay, so `(>*<)` is not exactly the dual operator of `(<*>)`. `(>*<)` is actually dual to `liftA2 (,)`2:

``````(>*<)      :: Divisible   f => f a -> f b -> f (a, b)
liftA2 (,) :: Applicative f => f a -> f b -> f (a, b)``````

In fact, if we were to hypothetically redefine `(<*>)` to be `liftA2 (,)` then we could write `Applicative` code that is even more symmetric to the `Divisible` code (albeit less ergonomic):

``````import Control.Applicative (liftA2)
import Prelude hiding ((<*>))

(<*>) = liftA2 (,)

infixr 5 <*>

where
adapt (x, (y, z)) = Point{ x, y, z }

-- Compare to:
nonNegativeOctant :: Predicate Point
nonNegativeOctant = adapt >\$< nonNegative >*< nonNegative >*< nonNegative
where
adapt Point{ x, y, z } = (x, (y, z))``````

It would be nice if we could create a `(>*<)` operator that was dual to the real `(<*>)` operator, but I could not figure out a good way to do this.

If you didn’t follow all of that, the main thing you should take away from this going into the next section is:

• the `Contravariant` class is the dual of the `Functor` class
• the `Divisible` class is the dual of the `Applicative` class

#### Syntactic sugar

GHC supports the `ApplicativeDo` extension, which lets you use `do` notation as syntactic sugar for `Applicative` operators. For example, we could have written our `readPoint` function like this:

``````{-# LANGUAGE ApplicativeDo #-}

return Point{ x, y, z }``````

… which behaves in the exact same way. Actually, we didn’t even need the `ApplicativeDo` extension because `IO` has a `Monad` instance and anything that has a `Monad` instance supports `do` notation without any extensions.

However, the `ApplicativeDo` language extension does change how the `do` notation is desugared. Without the extension the above `readPoint` function would desugar to:

``````readPoint =
return Point{ x, y, z }``````

… but with the `ApplicativeDo` extension the function instead desugars to only use `Applicative` operations instead of `Monad` operations:

``````-- I don't know the exact desugaring logic, but I imagine it's similar to this:
where
adapt x y z = Point{ x, y, z }``````

So could there be such a thing as “`DivisibleDo`” which would introduce syntactic sugar for `Divisible` operations?

I think there could be such an extension, and there are several ways you could design the user experience.

One approach would be to permit code like this:

``````{-# LANGUAGE DivisibleFrom #-}

nonNegativeOctant :: Predicate Point
nonNegativeOctant =
from Point{ x, y, z }
x -> nonNegative
y -> nonNegative
z -> nonNegative``````

… which would desugar to the original code that we wrote:

``````nonNegativeOctant = adapt >\$< nonNegative >*< nonNegative >*< nonNegative
where
adapt Point{ x, y, z } = (x, (y, z))``````

Another approach could be to make the syntax look exactly like `do` notation, except that information flows in reverse:

``````{-# LANGUAGE DivisibleDo #-}

nonNegativeOctant :: Predicate Point
nonNegativeOctant = do
x <- nonNegative
y <- nonNegative
r <- nonNegative
return Point{ x, y, z } -- `return` here would actually be a special keyword``````

I assume that most people will prefer the `from` notation, so I’ll stick to that for now.

If we were to implement the former `DivisibleFrom` notation then the `Divisible` laws stated using `from` notation would become:

``````-- Left identity
from x
x -> m
x -> conquer

= m

-- Right identity
from x
x -> conquer
x -> m

= m

-- Associativity
from (x, y, z)
(x, y) -> from (x, y)
x -> m
y -> n
z -> o

= from (x, y, z)
x -> m
(y, z) -> from (y, z)
y -> n
z -> o

= from (x, y, z)
x -> m
y -> n
z -> o``````

This explanation of how `DivisibleFrom` would work is really hand-wavy, but if people were genuinely interested in such a language feature I might take a stab at making the semantics of `DivisibleFrom` sufficiently precise.

#### History

The original motivation for the `(>*<)` operator and `Divisible` style was to support compositional `RecordEncoder`s for the `dhall` package.

Dhall’s Haskell API defines a `RecordEncoder` type which specifies how to convert a Haskell record to a Dhall syntax tree, and we wanted to be able to use the `Divisible` operators to combine simpler `RecordEncoder`s into larger `RecordEncoder`s, like this:

``````data Project = Project
{ name        :: Text
, description :: Text
, stars       :: Natural
}

injectProject :: Encoder Project
injectProject =
recordEncoder
( adapt >\$< encodeFieldWith "name"        inject
>*< encodeFieldWith "description" inject
>*< encodeFieldWith "stars"       inject
)
where
adapt Project{..} = (name, (description, stars))``````

The above example illustrates how one can assemble three smaller `RecordEncoder`s (each of the `encodeFieldWith` functions) into a `RecordEncoder` for the `Project` record by using the `Divisible` operators.

If we had a `DivisibleFrom` notation, then we could have instead written:

``````injectProject =
recordEncoder from Project{..}
name        -> encodeFieldWith "name"        inject
description -> encodeFieldWith "description" inject
stars       -> encodeFieldWith "stars"       inject``````

If you’d like to view the original discussion that led to this idea you can check out the original pull request.

#### Conclusion

I upstreamed this `(>*<)` operator into the `contravariant` package, which means that you’ll be able to use the trick outlined in this post after the next `contravariant` release.

Until then, you can define your own `(>*<)` operator inline within your own project, which is what `dhall` did while waiting for the operator to be upstreamed.

1. Alright, they’re not categorically dual in a rigorous sense, but I couldn’t come up with a better term to describe their relationship to the original operators.↩︎

2. I feel like `liftA2 (,)` should have already been added to `Control.Applicative` by now since I believe it’s a pretty fundamental operation from a theoretical standpoint.↩︎

1. I guess that this approach is not exactly dual to the `Applicative` one because your are not applying it to "functions". Applicative works with functions of the shape `a -> b -> c`, which is, functions taking two inputs. The dual could be seen as function which return two outputs, i.e. functions with the type `a -> (b, c)`. Now if you have a `pb :: Predicate b` and a `pc :: Predicate c` and a function `f :: a -> (b, c)`, you could obtain a `Predicate a` doing `f >\$< pb >*< pc`.

For example this works

data Point = Point Int Int

f :: Point -> (Int, Int)
f (Point x y) = (x, y)

type Predicate a = a -> Bool

positive :: Predicate Int
positive = (>= 0)

(>\$<) :: (a -> b) -> Predicate b -> Predicate a
(>\$<) f p = p . f

infixl 4 >\$<

(>*<) :: Predicate a -> Predicate b -> Predicate (a, b)
(>*<) pa pb (a, b) = pa a && pb b

infixl 5 >*<

p :: Predicate Point
p = f >\$< positive >*< positive
```

2. With respect to encoding and decoding of records, you might be interested in my (Scala, never got around to porting it to Haskell) Xenomorph project: https://github.com/nuttycom/xenomorph - there, rather than define encoders and decoders directly, I use free applicatives to capture the structure of an ADT and then derive the encoding and decoding from that structure value.

3. I don't really see a way to make a proper dual to `<*>`, but you can certainly make the code more ergonomic by hiding `adapt`. Using Generics, you can write:

adapt :: (Generic t, GenericAdapt (Rep t)) => t -> ListToPair (TList (Rep t))

type family ListToPair xs where
ListToPair '[] = ()
ListToPair '[x] = x
ListToPair (x ': (y ': ys)) = (x, ListToPair (y ': ys))

type TList f :: [Type]
gAdapt :: f x -> Vec (TList f)

type TList (f :*: g) = Append (TList f) (TList g)

type TList (D1 m x) = TList x

type TList (C1 m x) = TList x

type TList U1 = '[]

instance GenericAdapt (S1 m (Rec0 t)) where
type TList (S1 m (Rec0 t)) = '[t]
gAdapt (M1 (K1 x)) = Cons x Nil

data Vec lst where
Nil :: Vec '[]
Cons :: x -> Vec xs -> Vec (x ': xs)

type family Append xs ys :: [Type] where
Append '[] ys = ys
Append (x ': xs) ys = x ': Append xs ys

vecAppend :: Vec lst1 -> Vec lst2 -> Vec (Append lst1 lst2)
vecAppend Nil ys = ys
vecAppend (Cons x xs) ys = Cons x (vecAppend xs ys)

vecToPairs :: Vec lst -> ListToPair lst
vecToPairs Nil = ()
vecToPairs (Cons x Nil) = x
vecToPairs (Cons x xs@(Cons _ _)) = (x, vecToPairs xs)
```
(There's probably an existing Vec type that supports this.)

This will work for any record type that derives Generic. But, you can even be a little cheeky and go one step further by making your own custom `>\$<` function that uses adapt, as in:

infixl 4 >\$<
(>\$<)
:: (Generic t, GenericAdapt (Rep t), Contravariant f)
=> Constructor (TList (Rep t)) t
-> (f (ListToPair (TList (Rep t))) -> f t)
_ >\$< a = contramap adapt a

type family Constructor xs t where
Constructor '[] t = t
Constructor '[x] t = x -> t
Constructor (x ': (y ': ys)) t = x -> Constructor (y ': ys) t
```
With this setup, you can write code that _looks_ like it's dual to real applicative code: