# Applicative style programming with profunctors

Quite unusually, this post is not written in Literate Haskell.

## Applicative style

Applicative functors allow less expressiveness than monads, but are more general: every monad is an applicative functor.

A commonly mentionned benefit of programming with applicative
functors is that they allow more optimizations to take place,
in particular because the applicative product `(<*>)`

can
execute its two arguments “in parallel”.

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

In contrast, the monadic bind `(>>=)`

expects an arbitrary function
as its second argument, which is quite opaque.
This forces a sequential execution, where the first operand must be evaluated
so that the second one can be applied to its result.

`>>=) :: Monad f => f a -> (a -> f b) -> f b (`

*Applicative style* relies on the `Applicative`

and `Alternative`

type
classes; the former is actually a superclass of the latter.

Can we use this style to program bidirectionally with profunctors?
In fact, my previous posts already show how to generalize `Applicative`

.
Here we shall focus on extending that generalization to work with
`Alternative`

.

### Outline of naive parsers and printers

A parser typically uses `Alternative`

to parse a sum type, with one
branch for each constructor.

```
data Term
= Var Int
| Lambda Int Term
| App Term Term
parseTerm :: Parser Term
parseTerm
= parseVar
<|> parseLambda
<|> parseApp
```

A printer decides the branch to take by pattern matching.

```
printTerm :: Term -> String
printTerm t =
case t of
Var _ -> printVar t
Lambda _ _ -> printLambda t
App _ _ -> printApp t
```

### Bidirectional programming

Let us imagine we have invertible parsers for each alternative,
merging `parseVar`

and `printVar`

, etc.

```
data IParser x a
var, lambda, app :: IParser Term Term
```

The final parser would look like this:

```
term :: IParser Term Term
term
= isVar =? var
<|> isLambda =? lambda
<|> isApp =? app
```

with some yet unknown operator `(=?)`

and functions `isVar`

, `isLambda`

,
`isApp`

.

### Filter

Each branch should *filter* the input term, such that if it doesn’t have the
right constructor, then the current branch fails and control flows to the
next branch.

Filtering can obviously enough be done with a boolean predicate.

```
isVar (Var _) = True
isVar _ = False
...
```

Then, we expect a signature similar to the standard `filter`

on lists.
The naive solution is just to put this in a type class.

```
class Profunctor p => Filterable p where
=?) :: (x -> Bool) -> p x a -> p x a (
```

But this lacks the elegance of previous “high-level” abstractions.

Instead, consider that `Profunctor`

gives us `lmap`

.

`lmap :: (y -> x) -> p x a -> p y a`

The combination of `lmap`

and `(=?)`

(filter) is in fact equivalent to:

`filterMap :: (y -> Maybe x) -> p x a -> p y a`

The type of partial functions `y -> Maybe x`

is essentially what the
Invertible Syntax Descriptions paper uses to work with its own redefinition of
`Alternative`

(removing the `Applicative`

superclass constraint),
as one component of “partial isomorphisms”.

`filterMap`

should satisfy some laws:

```
filterMap (f >=> g) = filterMap f . filterMap g
filterMap pure = id
```

So `filterMap`

actually represents a functor; its domain is the Kleisli
category associated with the `Maybe`

monad.

## Contravariant functors

We shall generalize `Profunctor`

. Focusing on the first type parameter of
`p`

, we have that `p`

must be a contravariant functor, from some arbitrary
category associated with `p`

, here called `First p`

. In comparison,
`Profunctor`

specializes it to the `Hask`

category of pure functions
(`First p = (->)`

).

The `Category`

type class can be found in `Control.Category`

, in `base`

.
The `type`

syntax is allowed here by the `TypeFamilies`

extension,
allowing one to write type-level functions to some extent.

```
class Category (First p) => Contravariant p where
type First p :: * -> * -> *
lmap :: First p y x -> p x a -> p y a
```

### Maybe

In the case of an applicative parser, its instance may use the
`Kleisli Maybe`

category to allow mappings to fail:

```
newtype Kleisli m y x = Kleisli (y -> m x)
instance Monad m => Category (Kleisli m)
instance Contravariant IParser where
type First IParser = Kleisli Maybe
lmap :: Kleisli Maybe y x -> IParser x a -> IParser y a
lmap = (...)
```

A derived function can take care of unwrapping the `Kleisli`

newtype in
Haskell.

```
filterMap
:: (Contravariant p, First p ~ Kleisli m, Monad m)
=> (y -> m x) -> p x a -> p y a
filterMap = lmap . Kleisli
```

### Pure functions

Of course, there are profunctors which cannot fail, the obvious one being
the function type `(->)`

.

```
instance Contravariant (->) where
type First (->) = (->)
lmap :: (y -> x) -> (x -> a) -> (y -> a)
lmap f g = g . f
```

However, `Contravariant`

may seem like too big of a generalization. In
particular, we have lost the ability to map a pure function in general when the
domain `First p`

is not `(->)`

.

### Arrows

We can use the fact that pure functions can still be lifted
as Kleisli arrows.
One fitting structure is arrows, as found in `Control.Arrow`

, in `base`

,
it is situated somewhere between applicative functors and monads on the
abstraction ladder, but we are more particularly interested in one
method it provides: `arr :: Arrow p => (y -> x) -> p y x`

.

```
=.)
(:: (Contravariant p, Arrow (First p))
=> (y -> x) -> p x a -> p y a
=.) = lmap . arr (
```

There may be interesting non-arrow categories for bidirectional programming with profunctors, but I can’t think of any at the moment.

Using Kleisli arrows for the `Maybe`

monad allows printers to fail for
certain inputs.
Monads are a very general notion, can we find uses for other effects?

### State

One situation where we may need to perform side-effects with `lmap`

is when the data we are working on is represented in some indirect way,
e.g., with explicit pointers.

A more concrete example is *hash consing*: sharing values which are
structurally equal. Deconstructing a hash-consed value may require a lookup in
memory. Then we can imagine a hypothetical parser working in some hash consing
monad `H`

.

```
data HIParser x a
instance Contravariant HIParser where
type First HIParser = Kleisli (MaybeT H)
lmap :: Kleisli (MaybeT H) y x -> HIParser x a -> HIParser y a
```

Unrolling the type definitions, the type of `lmap`

is equivalent to
the following, with an arrow combining state and exception.

`lmap :: (y -> H (Maybe x)) -> HIParser x a -> HIParser y a`

I have written a more complete example of that in the new repository
summarizing my current work as a Haskell package: `profunctor-monad`

.

The bodies of two equivalent parsers are copied below, the first one with a monadic definition, the second one with a (primarily) applicative definition.

```
-- type p :: (* -> *) -> * -> * -> *
-- A monad transformer with parsing/printing functionality (via ``IParser``).
--
-- type M :: * -> *
-- A monad for hash consing and exceptions (for parse errors).
--
-- type P (p M) I = p M I I
ppTree
:: forall p
. (Monad1 (p M), IParser (p M), First (p M) ~ Kleisli M, PMonadTrans p)
=> P (p M) I
ppTree = with @Monad @(p M) @TreeI $ uncons =: do
c0 <- firstChar =. anyChar
case c0 of
'0' -> lift leaf
'1' -> do
i <- c1 =. ppTree
j <- c2 =. ppTree
lift (node i j)
_ -> fail "Invalid character"
where
firstChar Leaf = '0'
firstChar (Node _ _) = '1'
c1 (Node i _) = i
c2 (Node _ j) = j
ppTree2
:: forall p
. ( Alternative1 (p M), Monad1 (p M), PMonadTrans p
IParser (p M), First (p M) ~ Kleisli M)
, => P (p M) I
ppTree2 =
with @Alternative @(p M) @TreeI $
uncons =:
guard . isLeaf) =: char '0' *> lift leaf
( (<|> (guard . isNode) =: char '1' *> ppNode'
)where
ppNode' = with @Monad @(p M) @TreeI $ do
i <- c1 =. ppTree2
j <- c2 =. ppTree2
lift (node i j)
c1 (Node i _) = i
c2 (Node _ j) = j
-- Maybe helpful definitions below.
-- Unique value identifier.
data I :: *
-- Shallow representation of a hash-consed tree.
data TreeI = Leaf | Node I I
-- Predicates.
isLeaf, isNode :: TreeF a -> Bool
-- Monadic smart constructors.
leaf :: H I
node :: I -> I -> H I
```