Monadic profunctors for bidirectional programming

Preface

(Updated May 2018)

This is an unfinished post consolidating ideas on monadic profunctors, that I’ve also written about in previous posts.. In particular, this post walks step by step from simple parsers and printers, to this “bidirectional” representation. Since it kept getting longer with no end in sight, I put this out there in this unfinished state. For more examples and a more up-to-date preview of this work, I am working on a few libraries.

Introduction

Programmers deal with data in various forms, and often need ways to convert back and forth between different representations. Such conversions are usually expected to follow some inverse relationship, leading to partially overlapping and redundant specifications. Multiple techniques have been investigated to exploit that redundancy in order to define mappings between two representations as a single bidirectional transformation. These programs avoid code duplication; they are more concise and more maintainable. Certain properties relating the unidirectional mappings that are extracted from these artifacts can be established by construction, lessening burden of correctness on the programmer.

Diverse languages have been created to program bidirectional transformations. A popular approach in functional programming is the design of combinator libraries, or ways to compose complex programs which inherit the good behavior of their components. Such libraries form an embedded domain specific language, and are generally simpler to implement and use than a wholly separate language.

TODO: Blabla

Unifying parsers and printers

This document is written in Literate Haskell. Familiarity with syntax in the ML family of functional languages is assumed (e.g., type annotations, pattern matching, function application), and we shall try to explain constructs which are specific to Haskell when necessary.

{-# LANGUAGE InstanceSigs #-}
module Monadic.Profunctors where

import Data.Char
import Data.Monoid

Let us first consider the problem of parsing and printing with a straightforward approach.

Types

Here are simple parser and printer types. A parser consumes a prefix of an input string, converts it to a value of some type a, returned alongside the unconsumed suffix of the string. A printer simply converts a value into a string.

data Parser   a = Parser   (String -> (a, String))
data Printer0 a = Printer0 (a -> String)

runParser :: Parser a -> String -> (a, String)
runParser (Parser p_) = p_

runPrinter0 :: Printer0 a -> a -> String
runPrinter0 (Printer0 q_) = q_

We would like to be able to write both a parser and a printer as a single enitity. So let us put them together in a pair, and call it an invertible parser.

data IParser0 a = IParser0 (Parser a) (Printer0 a)

asParser0 :: IParser0 a -> Parser a
asParser0 (IParser0 p _) = p

asPrinter0 :: IParser0 a -> Printer0 a
asPrinter0 (IParser0 _ q) = q

Elementary parsers

Let us define some elementary invertible parsers, to parse/print a word made of digits and to consume/print whitespace.

digits0 :: IParser0 String
digits0 = IParser0 p q
  where
    p = Parser $ \s -> span isDigit s
    q = Printer0 $ \digits -> digits

whitespace0 :: IParser0 ()
whitespace0 = IParser0 p q
  where
    p = Parser $ \s -> ((), dropWhile isSpace s)
    q = Printer0 $ \() -> " "

Parsers, like various other kinds of “computations”, can generally be modelled as applicative functors or monads, concretely represented in Haskell by the type classes Applicative and Monad. These abstractions provide a familiar interface for functional programmers to compose computations. Unfortunately, we will see that we cannot implement instances of Applicative or Monad for IParser0. However, it is still tempting to imitate these abstractions for invertible parsers.

Functors

Parsers are functors. The mapParser higher-order function takes a function and applies it to the result of a parser, producing a parser with a different output type.

mapParser :: (a -> b) -> Parser a -> Parser b
mapParser f p = Parser $ \s ->
  let (a, s') = runParser p s
  in (f a, s')

Functors are represented in Haskell by the Functor type class in the standard library base.

class Functor m where
  fmap :: (a -> b) -> m a -> m b

instance Functor Parser where
  fmap = mapParser

More precisely, the Functor type class represents covariant functors: the input type a (resp. result type b) of f :: a -> b corresponds to the input type Parser a (resp. result type Parser b) of mapParser f :: Parser a -> Parser b.

In contrast, Printer0 is a contravariant functor.

A contravariant functor reverses the direction of the lifted arrow: the input type a (resp. result type b) of f :: a -> b corresponds to the result type Printer0 a (resp. input type Printer0 b) of mapPrinter0 f :: Printer0 b -> Printer0 a.

mapPrinter0 :: (a -> b) -> Printer0 b -> Printer0 a
mapPrinter0 f q = Printer0 $ \a -> runPrinter0 q (f a)

Invertible parsers

To transform an IParser0, which contains both a parser and a printer, we thus need to map both ways. We say that IParser0 is an invariant functor.

class Invariant m where
  imap :: (a -> b) -> (b -> a) -> m a -> m b

instance Invariant IParser0 where
  imap :: (a -> b) -> (b -> a) -> IParser0 a -> IParser0 b
  imap f f' (IParser0 p q) = IParser0 (mapParser f p) (mapPrinter0 f' q)

Parser and Printer0 independently turn out to also be instances, simply ignoring one component or the other.

instance Invariant Parser where
  imap f _ p = fmap f p

instance Invariant Printer0 where
  imap _ f' q = mapPrinter0 f' q

Demonstration: parsing an integer

We need to wrap digit0, which only returns a string of digits. We may map between that string and the corresponding number using read :: String -> Int and show :: Int -> String.

int0 :: IParser0 Int
int0 = imap read show digits0

Using the invertible parser:

> runParser (asParser0 int0) "42sixtimesnine"
(42, "sixtimesnine")
> runPrinter0 (asPrinter0 int0) 42
"42"

Applicative functors

Applicative functors make it possible to sequence computations and combine their results. Functor is a superclass of Applicative: every applicative functor is a (covariant) functor.

class Functor m => Applicative m where
  pure :: a -> m a
  (<*>) :: m (a -> b) -> m a -> m b

Our Parser is an instance of Applicative.

pure creates a parser that does nothing beyond producing a constant value. The binary operator (<*>) (“ap”) runs a parser producing a function f, followed by another producing a value a, and returns the application f a.

instance Applicative Parser where
  pure a = Parser $ \s -> (a, s)

  -- "ap"
  pf <*> pa = Parser $ \s ->
    let (f, s') = runParser pf s
        (a, s'') = runParser pa s'
    in (f a, s'')

However, Printer0 is not an applicative functor, since it is not even a covariant functor, but a contravariant one. Furthermore, even if we ignore the superclass constraint, a printer qf <*> qa :: Printer0 b would need to print a value (of type) b using printers qf :: Printer0 (a -> b) and qa :: Printer0 a, but there is no general way to extract a function a -> b and a value a out of a value b.

Monoidal functors

We can still apply the idea of sequencing operations to printers with a different type class:

class Invariant m => Monoidal m where
  pure' :: a -> m a

  -- "pair"
  (<.>) :: m a -> m b -> m (a, b)

A pure printer just prints the empty string (essentially doing nothing).

Given two printers qa :: Printer0 a and qb :: Printer0 b, we can construct a printer for pairs of values qa <.> qb :: Printer0 (a, b), by concatenating their printing results.

Thus Printer0 is a monoidal functor.

instance Monoidal Printer0 where
  pure' :: a -> Printer0 a
  pure' _ = Printer0 $ \_ -> ""

  (<.>) :: Printer0 a -> Printer0 b -> Printer0 (a, b)
  qa <.> qb = Printer0 $ \(a, b) ->
    runPrinter0 qa a ++
    runPrinter0 qb b

Assuming that a type is a covariant Functor (e.g., Parser), then (<*>) and (<.>) (“pair”) are equivalent, in the sense that we can implement one with the other.

Below, (<$>) is an infix synonym for Functor’s fmap, quite frequent when programming in applicative style. (,) is the constructor of pairs used as a regular identifier.

(<.>*) :: Applicative m => m a -> m b -> m (a, b)
ma <.>* mb = (,) <$> ma <*> mb

(<*>.) :: (Functor m, Monoidal m) => m (a -> b) -> m a -> m b
ma <*>. mb = (\(f, a) -> f a) <$> (ma <.> mb)

-- f <$> a = fmap f a
-- f <$> a <*> b = (f <$> a) <*> b  -- Associates like that
-- (,) a b = (a, b)

Given two parsers pa :: Parser a and pb :: Parser b, we can construct a parser pa <.>* pb :: Parser (a, b) which runs both parsers successively and collects their results in a pair.

Thus Parser is a Monoidal functor.

instance Monoidal Parser where
  pure' :: a -> Parser a
  pure' = pure

  (<.>) :: Parser a -> Parser b -> Parser (a, b)
  (<.>) = (<.>*)

Invertible parsers

IParser0 is the product of two monoidal functors, which is monoidal as well.

instance Monoidal IParser0 where
  pure' :: a -> IParser0 a
  pure' a = IParser0 (pure' a) (pure' a)

  (<.>) :: IParser0 a -> IParser0 b -> IParser0 (a, b)
  (IParser0 pa qa) <.> (IParser0 pb qb) = IParser0 (pa <.> pb) (qa <.> qb)

Demonstration: parsing a pair

Here is an invertible parser of a pair of numbers separated by whitespace.

We define the (.>) (“then”) combinator which ignores the unit result of its first operand, using imap to restructure the tuple produced by (<.>).

It is similar to (*>) :: Applicative m => m a -> m b -> m b from the standard library. The restriction that the left argument returns a unit result is necessary to avoid loss of information.

-- "then"
(.>) :: Monoidal m => m () -> m a -> m a
mu .> ma = imap f f' (mu <.> ma)
  where
    f ((), m) = m
    f' m = ((), m)

pairInt0 :: IParser0 (Int, Int)
pairInt0 = int0 <.> (whitespace0 .> int0)

Using the invertible parser:

> runParser (asParser0 pairInt0) "2048   2187"
((2048, 2187), "")
> runPrinter0 (asPrinter0 pairInt0) (2048, 2187)
"2048 2187"

Monads

Applicative or Monoidal sequence independent operations, thus their expressiveness remains quite limited.

A generic kind of format we cannot parse with those is one where the input is separated into a header and a body, with the header containing information about the shape of the body. For instance, consider strings that start with an integer n (the header), followed by n more integers (the body).

For such a format, we need a monadic parser, and Parser is indeed a Monad. That means that it exposes the following operation: (>>=) (“bind”) runs the first parser, and passes the result to the second parameterized parser before running it.

class Applicative m => Monad m where
  -- "bind"
  (>>=) :: m a -> (a -> m b) -> m b

instance Monad Parser where
  (>>=) :: Parser a -> (a -> Parser b) -> Parser b
  pa >>= topb = Parser $ \s ->
    let (a, s') = runParser pa s
    in runParser (topb a) s'

Extending the header/body analogy, we can see that (>>=) also does not fit printers. If qa :: Printer0 a is the printer of headers a, and toqb :: a -> Printer0 b is the printer of bodies b parameterized by headers, their composition needs to accept a type containing the header, whereas (>>=) simply forgets the type of the header a in the result. We can join the results of two computations in a pair, similarly to the way we reshaped Applicative into Monoidal.

class Monoidal m => Monadoidal m where
  -- "pairing bind"
  (>>+) :: m a -> (a -> m b) -> m (a, b)

Every Monad instance, including Parser, can be an instance of Monadoidal.

(>>+=) :: Monad m => m a -> (a -> m b) -> m (a, b)
ma >>+= tomb = ma >>= \a -> tomb a >>= \b -> pure (a, b)

instance Monadoidal Parser where
  (>>+) :: Parser a -> (a -> Parser b) -> Parser (a, b)
  (>>+) = (>>+=)

A Printer0 is an instance of Monadoidal.

instance Monadoidal Printer0 where
  (>>+) :: Printer0 a -> (a -> Printer0 b) -> Printer0 (a, b)
  qa >>+ toqb = Printer0 $ \(a, b) ->
    runPrinter0 qa a ++
    runPrinter0 (toqb a) b

Thus, so is IParser0.

instance Monadoidal IParser0 where
  (>>+) :: IParser0 a -> (a -> IParser0 b) -> IParser0 (a, b)
  pqa >>+ topqb = IParser0 p q
    where
      p = asParser0 pqa >>+ (asParser0 . topqb)
      q = asPrinter0 pqa >>+ (asPrinter0 . topqb)

Demonstration: parsing a list

Here is an invertible parser of a list of integers, written as the length n followed by n integers.

Given the length, we can iterate a parser with the replicate0 combinator defined here.

replicate0 :: Monadoidal m => Int -> m a -> m [a]
replicate0 0 _ = pure' []
replicate0 n pq = imap cons uncons (pq <.> replicate0 (n - 1) pq)
  where
    cons (a, as) = a : as
    uncons (a : as) = (a, as)
    uncons [] = error "Unexpected empty list"

intList0 :: IParser0 [Int]
intList0 = imap f f' (int0 >>+ \n -> replicate0 n (whitespace0 .> int0))
  where
    f (_, xs) = xs
    f' xs = (length xs, xs)

Using the invertible parser:

> runParser (asParser0 intList0) "3      0 1  2  "
([0, 1, 2], "  ")
> runPrinter0 (asPrinter0 intList0) [0, 1, 2]
"3 0 1 2"

The approach outlined above leads to a type class hierarchy Invariant/Monoidal/Monadoidal which parallels a well-established one Functor/Applicative/Monad.

TODO: drawbacks? Tuples.

Invertible parsing as a profunctor

We study a different construction of invertible parsers, which is actually an instance of Functor/Applicative/Monad.

Recall the previously defined type of invertible parsers:

data IParser0 a = IParser0 (Parser a) (Printer0 a)

It is not an instance of Functor (thus neither of Applicative nor Monad) due to Printer0 a being contravariant with respect to a.

Let us reflect this difference in variance by generalizing the invertible parser type, with a parameter x in negative occurences, and a in positive occurences:

TODO: explain negative/positive. Basically contravariant/covariant.

data IParser1 x a = IParser1 (Parser a) (Printer0 x)

asParser1 :: IParser1 x a -> Parser a
asParser1 (IParser1 p _) = p

asPrinter1 :: IParser1 x a -> Printer0 x
asPrinter1 (IParser1 _ q) = q

IParser0 a is equivalent to IParser1 a a.

type IParser1' a = IParser1 a a

iparser0to1 :: IParser0 a -> IParser1' a
iparser0to1 (IParser0 p q) = IParser1 p q

Let us translate the elementary parsers digits0 and whitespace0. The following sections will demonstrate a different way to compose them.

digits1 :: IParser1' String
digits1 = iparser0to1 digits0

whitespace1 :: IParser1' ()
whitespace1 = iparser0to1 whitespace0

Profunctors

We can map over each parameter independently, the first “contravariantly”, the second “covariantly”. We call such a type a profunctor.

class Profunctor f where
  lmap :: (x -> y) -> f y a -> f x a
  rmap :: (a -> b) -> f x a -> f x b

instance Profunctor IParser1 where
  lmap g (IParser1 p q) = IParser1 p (mapPrinter0 g q)
  rmap f (IParser1 p q) = IParser1 (mapParser f p) q

Applying two functions at once results in a function equivalent to imap (up to the order of arguments), but with a much more general type:

dimap :: Profunctor f => (x -> y) -> (a -> b) -> f y a -> f x b
dimap g f = lmap g . rmap f

Demonstration

We can now define int1 from digits1, equivalent to int0.

int1 :: IParser1' Int
int1 = dimap show read digits1

Profunctors are functors

A profunctor is a covariant functor with respect to its second argument:

instance Functor (IParser1 x) where
  fmap = rmap

Applicative functors and monoids

Invertible parsers can also be sequenced via an Applicative instance. Parser is already an instance of Applicative. Printer0 is not an instance of Applicative, but we only need it to be a Monoid.

Printer0 x, equivalent to the type of functions x -> String, is a monoid where the binary operation is the pointwise concatenation of strings.

instance Monoid (Printer0 x) where
  -- Identity element
  mempty :: Printer0 x
  mempty = Printer0 $ \_ -> ""

  -- Associative operation
  mappend :: Printer0 x -> Printer0 x -> Printer0 x
  mappend p p' = Printer0 $ \x ->
    runPrinter0 p x ++
    runPrinter0 p' x

The binary operation of that monoid seems to be the only reasonable¹ implementation of the printer component of (<*>) for IParser1, given its type.

instance Applicative (IParser1 x) where
  pure a = IParser1 (pure a) mempty

  (<*>) :: IParser1 x (a -> b) -> IParser1 x a -> IParser1 x b
  pqf <*> pqa = IParser1 pb qb
    where
      pb = asParser1 pqf <*> asParser1 pqa
      qb = asPrinter1 pqf <> asPrinter1 pqa
      -- (<>) = mappend

Partial printers

The type of the binary operation (<>) :: Printer0 x -> Printer0 x -> Printer0 x seems surprising at first: what use is printing the same value of type x twice? The answer is that a Printer0 x does not necessarily print a complete representation of x. It may be a partial printer of x.

For instance, given a printer q :: Printer0 x, we can construct (mapPrinter0 fst q) :: Printer0 (x, y) printing only the first component of a given pair. We can similarly obtain a printer for the second component, and finally combine them.

pairPrinter0 :: Printer0 x -> Printer0 y -> Printer0 (x, y)
pairPrinter0 qx qy = mapPrinter0 fst qx <> mapPrinter0 snd qy

Applicative style sequences parsers concisely, allowing users to provide their own functions to combine results. Here they are simply put in a pair.

pairParser :: Parser a -> Parser b -> Parser (a, b)
pairParser pa pb = (,) <$> pa <*> pb

Note that pairParser and pairPrinter0 are equal to (<.>). The point here is that Monoidal simply turns out to be a composition of more elementary abstractions. We already mentioned that Monoidal and Applicative are equivalent for types which are covariant functors (e.g., Parser). Above, pairPrinter0 shows that a type which is both a contravariant functor and a monoid is also a monoidal functor (the identity morphism pure' is equal to \_ -> mempty).

Below, pair combines these implications, applying lmap (renamed as the infix operator (=.) for a record-like notation) to obtain two values

(fst =. pqa) :: f (x, y) a
(snd =. pqb) :: f (x, y) b

under the same context f (x, y) which can then be combined with the applicative product (<*>), using the products of parsers (Applicative) and printers (Monoid) when f ~ IParser1.

(=.) :: Profunctor f => (x -> y) -> f y a -> f x a
(=.) = lmap

-- Very general type
pair
  :: (Profunctor f, Applicative (f (x, y)))
  => f x a -> f y b -> f (x, y) (a, b)
pair pqa pqb =
  (,)
    <$> (fst =. pqa)
    <*> (snd =. pqb)

-- Specializes to a (<.>)-looking type
pair1 :: IParser1' a -> IParser1' b -> IParser1' (a, b)

-- Expanded type
pair1 :: IParser1 a a -> IParser1 b b -> IParser1 (a, b) (a, b)

Applicative functors are in fact a generalization of monoids. Indeed, the Const type (constant type function) turns monoids into applicative functors.

data Const w a = Const w

instance Functor (Const w) where
  fmap _ (Const w) = Const w

instance Monoid w => Applicative (Const w) where
  pure _ = Const mempty
  Const w <*> Const w' = Const (w <> w')

Thus, IParser1 x _ is not an applicative functor by any fortuitous accident, but because it is actually the product of two applicative functors (Parser _ and Const (Printer0 x) _, or perhaps x -> Const String _).

Demonstration

We no longer need a new (.>) operator, we can now reuse Applicative’s (*>).

With (=.) (i.e., lmap), we apply the unit function to the whitespace1 invertible parser, indicating that it produces/requires no information.

unit :: x -> ()
unit _ = ()

pairInt1 :: IParser1' (Int, Int)
pairInt1 =
  (,)
    <$> (fst =. int1)
    <*> (snd =.
          ((unit =. whitespace1) *> int1))

A monadic printer

Printer0 x is not a monad, we shall replace it with a type which is one. Recall that Const creates an applicative functor out of a monoid, but since its second type parameter is ignored, there is no way to implement a monadic “bind” operator (>>=).

The writer monad

The writer monad arises out of any monoid. Values are annotated with a log, an element of some monoid w. The Monoid structure provides an empty log for pure values, and an operation to append logs when combining values with (<*>) or (>>=).

data Writer w a = Writer w a

-- The embedding must now have a restricted type,
-- as opposed to Const :: w -> Const w a.
write :: w -> Writer w ()
write w = Writer w ()

runWriter :: Writer w a -> w
runWriter (Writer w _) = w

instance Functor (Writer w) where
  fmap f (Writer w a) = Writer w (f a)

instance Monoid w => Applicative (Writer w) where
  pure a = Writer mempty a
  Writer wf f <*> Writer wa a = Writer (wf <> wa) (f a)

instance Monoid w => Monad (Writer w) where
  Writer wa a >>= toWb =
    let Writer wb b = toWb a
    in Writer (wa <> wb) b

The new printer

The original Printer0 can also be seen as the composition of the reader (x -> _) and the constant (Const String _) functors: for any a, Printer0 x a is equivalent to x -> Const String a.

The new Printer owes its instances of Functor/Applicative/Monad to its being the composition of reader (x -> _) and writer (Writer String _).

data Printer x a = Printer (x -> Writer String a)

runPrinter :: Printer x a -> x -> String

-- Instances in the appendix:
-- Profunctor, Functor, Applicative, Monad.

Our final version IParser of invertible parsers is: a parser of a and a printer of a contained in x. More precisely, as a printer, it accepts an argument x, from which it extracts a value a, prints it, and returns it (so that it can be used with (>>=)). An IParser x a is the product of two monads, and therefore it is a monad.

data IParser x a = IParser (Parser a) (Printer x a)

asParser :: IParser x a -> Parser a
asPrinter :: IParser x a -> Printer x a

-- Instances in the appendix:
-- Profunctor, Functor, Applicative, Monad.

type IParser' a = IParser a a

Since whitespace1 is always going to be used as (unit =. whitespace1), we might as well include that in its translation to whitespace. Parametricity tells us from just its type that whitespace uses no information from the input x so it might as well be (), but polymorphism makes it more convenient to use.

iparser1to_ :: IParser1' a -> IParser' a
iparser1to_ (IParser1 p q) = IParser p q'
  where
    q' = Printer $ \a -> Writer (runPrinter0 q a) a

int :: IParser' Int
int = iparser1to_ int1

whitespace :: IParser x ()
whitespace = (unit =. iparser1to_ whitespace1)

Demonstration

Let us write again an invertible parser of lists. We still need a special replicate1 function. (:) is the constructor of lists used as a regular identifier.

In contrast with IParser0 functions such as replicate0, we no longer need to construct/deconstruct intermediate tuples, instead we can use normal constructors and accessors straightforwardly.

replicate1
  :: (Profunctor f, Applicative (f [x]))
  => Int -> f x a -> f [x] [a]
replicate1 0 _ = pure []
replicate1 n pq =
  (:)
    <$> (head =. pq)
    <*> (tail =. replicate1 (n - 1) pq)

-- Specializes to
replicate1 :: Int -> IParser' a -> IParser' [a]

Since IParser' is an instance of Monad, we can use Haskell’s do-notation, which desugars to expressions using (>>=).

intList1 :: IParser' [Int]
intList1 = do
  n <- length =. int
  replicate1 n (whitespace *> int)

A type class based interface

In the examples above, the only components specific to the application of parsing and printing are the “elementary” actions. They are then composed using polymorphic combinators.

These combinators require constraints involving general type classes: Profunctor, Applicative and Monad. The latter two are well-known interfaces against which functional programmers compose many sorts of computations. We have shown that, contrary to what the initial approach suggested, invertible parsers can also implement these type classes.

The abstractness of these constraints suggests that we can use these combinators to create bidirectional transformations other than parsers/printers.

From functor to profunctor

In fact, we have here a generalization of the Functor/Applicative/Monad hierarchy for “unidirectional” computations. Indeed, every instance m of Functor can be lifted to a Profunctor by adding a phantom type parameter:

data Pro m x a = Pro (m a)

unPro :: Pro m x a -> m a
unPro (Pro ma) = ma

instance Functor m => Profunctor (Pro m) where
  lmap _ (Pro ma) = Pro ma
  rmap f (Pro ma) = Pro (fmap f ma)

And Functor/Applicative/Monad instances are simply inherited:

instance Functor m => Functor (Pro m x) where
  fmap = rmap

instance Applicative m => Applicative (Pro m x) where
  pure a = Pro (pure a)
  Pro mf <*> Pro ma = Pro (mf <*> ma)

instance Monad m => Monad (Pro m x) where
  Pro ma >>= toprob = Pro (ma >>= (unPro . toprob))

We can recognize that construction to be equivalent to the parser component of the IParser type above. Similarly, if we focus on the printer component, we obtain another general way to turn a functor into a profunctor.

-- As it's named by the profunctors package.
data Star n x a = Star (x -> n a)

unStar :: Star n x a -> x -> n a
unStar (Star q) = q

instance Functor n => Profunctor (Star n) where
  lmap g (Star q) = Star (q . g)
  rmap f (Star q) = Star (fmap f . q)

instance Functor n => Functor (Star n x) where
  fmap = rmap

instance Applicative n => Applicative (Star n x) where
  pure a = Star (\_ -> pure a)
  Star qf <*> Star qa = Star (\x -> qf x <*> qa x)

instance Monad n => Monad (Star n x) where
  Star qa >>= tostarb = Star (\x -> qa x >>= \a -> unStar (tostarb a) x)

Thus IParser consists of the product of Pro and Star, respectively specialized to the Parser and Writer w monads.

Programming lenses

A lens is a bidirectional transformation from a source s, which can “focus” on a fragment called view v, using a function get' :: s -> v, and reflect an update of the view into the source: put' :: s -> v -> s.

data Lens' s v = Lens'
  { get' :: s -> v
  , put' :: v -> s -> s
  }

Given two lenses lb :: Lens' a b and lc :: Lens' b c, we can obtain a Lens' a c: to define get', from a, we can get b using the lens lb, and then get c using lc; to define set', an updated c can be put back into b using lc, and the result again put back into a using lb. In fact, lenses are the morphisms of a category of types.

idLens' :: Lens' a a
idLens' = Lens' (\a -> a) (\_ a -> a)

composeLens' :: Lens' a b -> Lens' b c -> Lens' a c
composeLens' lb lc = Lens'
  { get' = get' lc . get' lb
  , put' = \c a ->
      let b = get' lb a
      in put' lb (put' lc c b) a
  }

This composition is great to access nested structures.

A more interesting way for us to compose lenses is to access two values in parallel from the same source. The resulting operator corresponds to Monoidal’s (<.>).

(<.>~) :: Lens' s a -> Lens' s b -> Lens' s (a, b)
la <.>~ lb = Lens'
  { get' = \s -> (get' la s, get' lb s)
  , put' = \(a, b) s -> put' lb b (put' la a s)
  }

Like invertible parsers, we can generalize the lens type in order to create an instance of Applicative and Monad. First, we may split the invariant parameter v into a contravariant x and a covariant a.

data Lens0 s x a = Lens0
  { get0 :: s -> a
  , put0 :: x -> s -> s
  }

We can recognize that s -> _ is a monad (which can be lifted with Pro), and that x -> s -> s is of the form x -> w where w ~ (s -> s) is the monoid of endofunctions. The type of put0 is equivalent to x -> Const w a, and we can transform it as we did for Printer to x -> Writer w a, or equivalently, Star (Writer (s -> s)) x a.

data Lens s x a = Lens
  { get :: s -> a
  , put :: x -> (s -> s, a)
  }

instance Profunctor (Lens s) where
  lmap g (Lens get put) = Lens get (put . g)
  rmap f (Lens get put) = Lens (f . get) ((fmap . fmap) f put)

instance Functor (Lens s x) where
  fmap = rmap

instance Applicative (Lens s x) where
  pure a = Lens (\_ -> a) (\_ -> (id, a))
  lf <*> la = Lens
    { get = \s -> get lf s (get la s)
    , put = \x ->
        let (r , f) = put lf x
            (r', a) = put la x
        in (r' . r, f a)
    }

instance Monad (Lens s x) where
  la >>= f = Lens
    { get = \s -> get (f (get la s)) s
    , put = \x ->
        let (r , a) = put la x
            (r', b) = put (f a) x
        in (r' . r, b)
    }

composeLens :: Lens s t t -> Lens t x a -> Lens s x a
composeLens lt la = Lens
  { get = get la . get lt
  , put = \x ->
      let (f, a) = put la x
          put' s = let (g, _) = put lt (f (get lt s)) in g s
      in (put', a)
  }

Demonstration: a lens to the spine of a tree

Consider a type of trees with values at every node.

data Tree a
  = Leaf
  | Node a (Tree a) (Tree a)

Start with crude lenses to get and put values at nodes, and to access the children of a node.

node :: Lens (Tree a) (Maybe a) (Maybe a)
node = Lens get put
  where
    get Leaf = Nothing
    get (Node a _ _) = Just a
    put Nothing = (\_ -> Leaf, Nothing)
    put (Just a) = (put', Just a)
      where
        put' Leaf = Node a Leaf Leaf
        put' (Node _ l r) = Node a l r

rightChild :: Lens (Tree a) (Tree a) (Tree a)
rightChild = Lens
  { get = \(Node _ _ r) -> r
  , put = \r -> (\(Node a l _) -> Node a l r, r)
  }

maybeHead :: [a] -> Maybe a
maybeHead (a : _) = Just a
maybeHead [] = Nothing

Then we can compose them to obtain the elements in the right spine of the tree. In the put direction, fine grained structural modifications are possible and allow to match the lengths of an input list and the spine of the updated tree.

spine :: Eq a => Lens (Tree a) [a] [a]
spine = do
  m <- maybeHead =. node
  case m of
    Nothing -> pure []
    Just a -> do
      as <- tail =. (composeLens rightChild spine)
      pure (a : as)

• Higher constraints: ForallF Applicative f
• Codec
• Generable sets
• More combinators

Appendix

Printer instances

-- :: Printer x a -> x -> String
runPrinter q x = runWriter (runPrinter' q x)

runPrinter' :: Printer x a -> x -> Writer String a
runPrinter' (Printer q_) = q_

instance Profunctor Printer where
  lmap g (Printer q_) = Printer (q_ . g)
  rmap = fmap

instance Functor (Printer x) where
  fmap f (Printer q_) = Printer $ \x ->
    fmap f (q_ x)

instance Applicative (Printer x) where
  pure a = Printer $ \_ -> pure a
  Printer qf_ <*> Printer qa_ = Printer $ \x ->
    qf_ x <*> qa_ x

instance Monad (Printer x) where
  Printer qa_ >>= toqb = Printer $ \x ->
    let toWb a = runPrinter' (toqb a) x
    in qa_ x >>= toWb

IParser instances

asParser (IParser p _) = p
asPrinter (IParser _ q) = q

instance Profunctor IParser where
  lmap g (IParser p q) = IParser p (lmap g q)
  rmap = fmap

instance Functor (IParser x) where
  fmap f (IParser p q) = IParser (fmap f p) (fmap f q)

instance Applicative (IParser x) where
  pure a = IParser (pure a) (pure a)
  pqf <*> pqa = IParser pb qb
    where
      pb = asParser pqf <*> asParser pqa
      qb = asPrinter pqf <*> asPrinter pqa

instance Monad (IParser x) where
  pqa >>= topqb = IParser pb qb
    where
      pb = asParser pqa >>= (asParser . topqb)
      qb = asPrinter pqa >>= (asPrinter . topqb)