## 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 Doubles that returns True if the double is non-negative and then uses co-Applicative (Divisible) style to create a nonNegativeOctant Predicate on Points 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:

#### 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 Doubles.

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

However, we want to work with Points 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:

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 RecordEncoders 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 RecordEncoders into larger RecordEncoders, 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 RecordEncoders (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: