Lenses for Arrows describes how the Lens datatype from Control.Lens can be generalise to support arrows.

lensesForArrows.lhs

> {-# LANGUAGE Rank2Types #-}
>
> import Prelude hiding (id)
> import Data.Functor.Constant (Constant(Constant), getConstant)
> import Control.Arrow (Arrow, arr, first, Kleisli(Kleisli), runKleisli, (&&&))
> import Control.Category ((<<<))
> import Control.Lens (sequenceAOf)
> import qualified Control.Lens as L
> import qualified Control.Lens.Internal.Setter as LS
> import Data.Profunctor (Profunctor, rmap)
> import System.Random (randomIO)

- Lenses that work with Arrows

Tom Ellis
2013-10-07

-- Abstract

I introduce a very simple extension to the `Lens` datatype from
`Control.Lens` that allows it to work with `Arrow`s.

Edit: Edward Kmett has demonstrated that this post is redundant.  See

    http://www.reddit.com/r/haskell/comments/1nwetz/lenses_that_work_with_arrows/ccmtfkj

-- Introduction

The van Laarhoven lens story starts with the following definition of
Lens:

> type Lens s t a b = GeneralLens (->) s t a b

which I have given in terms of a later generalisation noted by the
authors of `Control.Lens`:

> type GeneralLens p s t a b = forall f. Functor f
>                              => p a (f b) -> p s (f t)

We can define a function that modifies the contents of a lens:

> overFunction :: Lens s t a b -> (a -> b) -> (s -> t)
> overFunction l = fmap LS.runMutator . l . fmap LS.Mutator

In other words, this allows us to lift a function using a lens.  (We
also have the usual method of viewing the target of the lens:)

> viewFunction :: Lens s t a b -> s -> a
> viewFunction l = getConstant . l Constant

However, it does not seem possible to lift a general arrow.  That is,
I do not think it is possible to define a function

  overArrow :: Arrow arr => Lens s t a b -> arr a b -> arr s t

that lifts an arrow using a lens.  The `Lens` datatype seems not
powerful enough to support that operation.  In this post I will
demonstrate a minor adaptation of van Laarhoven lenses that allows
this in a satisfying way.  I called this adaptation the `ArrLens`.
`ArrLens` is a very general concept, and I have not been able to think
of any `Lens` that cannot be extended to an `ArrLens`. I propose that
`ArrLens` is supported by `Control.Lens` since it adds a lot of
functionality for little cost.

It seems rather odd that lenses do not already support this
functionality.  After all, it is part of the folklore of lenses that
they describe an isomorphism between some type `s` and `(a, z)` where
`a` is the target of the lens and `z` some anonymous type.  If the
lens really gave us this isomorphism we could use `first f` from
`Control.Arrow` to lift an arrow of type `arr a b` using the lens.

Still, it seems that the usual van Laarhoven lens does not support
this operation.  (I would be very interested to hear differently as it
would make this post redundant!)

-- Motivation

Arrows live in a somewhat marginal corner of the Haskell ecosystem and
don't get as much attention as other more popular abstractions.
Still, they are a useful generalisation of functions, the Kleisli
category of a monad forms an arrow, and every applicative gives rise
to an arrow whose first type argument is disregarded.

I came across the need for ArrLens whilst developing a database DSL.
I have already implemented some basic ArrLenses and used them
straightforwardly as one would use the more familiar Lens.

-- ArrLens

I propose a minor adaptation to van Laarhoven lenses, the ArrLens:

> type ArrLens s t a b = forall arr. Arrow arr
>                        => GeneralLens arr s t a b

"arr s t a b" might sound like something a pirate does, but they are
in fact type variables.  An `ArrLens` can be used anywhere a `Lens`
can, by specialising to `arr = (->)`.  With ArrLens we can lift any
arrow

> over  :: Arrow arr => ArrLens s t a b -> arr a b -> arr s t
> over l f = arr LS.runMutator <<< l (arr LS.Mutator <<< f)

(Note that 'view' did not pose any difficulty anyway.  We can already
lift any pure function into an arrow.)

> view :: Arrow arr => Lens s t a b -> arr s a
> view = arr . viewFunction

I suspect that by parametricity we have a nice relationship between
the general ArrLens and the ArrLens specialised to (->).  I
hypothesise the following properties, but I haven't proved them.

P1. arr (view l) = view l
P2. arr (over l f) = over l (arr f)

If we define `view` in terms of `viewFunction` as above then P1 seems
to follow immediately.

We can also define `set` (which sets the component of a lens) in the
usual way.  The concept of setting does not make sense for a general
Arrow arr, only when arr = (->).  Still, an ArrLens can be passed as
the first argument and it will be specialised to (->).

> set :: Lens s t a b -> b -> s -> t
> set l x = overFunction l (const x)

It is possible to define an ArrLens for any product type, and only
slighly more involved than defining a Lens.  Here are some examples
for 3-tuples.  The key observation is they each make explicit use of
an isomorphism with a pair.  For clarity I'll write them without
factoring out the obvious duplication.  Note that they use lenses from
`Control.Arrow` as part of their implementation!

> _1 :: ArrLens (a, y, z) (b, y, z) a b
> _1 f = arr (sequenceAOf L._1) <<< arr unwrap <<< first f <<< arr wrap
>   where wrap (x, y, z) = (x, (y, z))
>         unwrap (x, (y, z)) = (x, y, z)
>
> _2 :: ArrLens (x, a, z) (x, b, z) a b
> _2 f = arr (sequenceAOf L._2) <<< arr unwrap <<< first f <<< arr wrap
>   where wrap (x, y, z) = (y, (x, z))
>         unwrap (y, (x, z)) = (x, y, z)
>
> _3 :: ArrLens (x, y, a) (x, y, b) a b
> _3 f = arr (sequenceAOf L._3) <<< arr unwrap <<< first f <<< arr wrap
>   where wrap (x, y, z) = (z, (x, y))
>         unwrap (z, (x, y)) = (x, y, z)

-- Using ArrLens

For a demonstration, it is nice to use ArrLens on the Kleisli Arrow of
the IO monad.

> addRandom :: Kleisli IO Int String
> addRandom = Kleisli $ \x -> do putStrLn "Running randomIO"
>                                y <- randomIO :: IO Int
>                                return (show x ++ " and then " ++ show y)
>
> printK :: Show a => Kleisli IO a ()
> printK = Kleisli print

The order of effects makes a difference!

> randomThenShow :: Show a => Kleisli IO (Int, a, b) (String, b)
> randomThenShow = (view _1 &&& view _3)
>                  <<< over _2 printK
>                  <<< over _1 addRandom
>
> showThenRandom :: Show a => Kleisli IO (Int, a, b) (String, b)
> showThenRandom = (view _1 &&& view _3)
>                  <<< over _1 addRandom
>                  <<< over _2 printK
>
> runOnATuple :: Kleisli m (Int, Maybe String, Bool) b -> m b
> runOnATuple = flip runKleisli (1, Just "peachy", True)

    > runOnATuple randomThenShow
    Running randomIO
    Just "peachy"
    ("1 and then -2114250466",True)

    > runOnATuple showThenRandom
    Just "peachy"
    Running randomIO
    ("1 and then 1578832953",True)

-- Laws for ArrLens

The laws required for Control.Lens[1] are

L1. You get back what you put in:

    view l (set l b a) = b

L2. Putting back what you got doesn't change anything:

    set l (view l a) a = a

L3. Setting twice is the same as setting once:

    set l c (set l b a) = set l c a

Since `set` doesn't make sense for general arrows we have to express
these in terms of `over`.  Firstly we will state ArrLens laws 1 and 3.
Law 2 will come later.

A1. view l <<< over l f = f <<< view l

A3. over l f <<< over l g = over l (f <<< g)

From these we can derive the original laws.  Using A1 we derive L1.

    view l (set l b a) = view l (over l (const b) a)
                       = (view l <<< over l (const b)) a
                       = (const b <<< view l) a
                       = b

Using A3 we derive L3.

    set l c . set l b = over l (const c) <<< over l (const b)
                      = over l (const c <<< const b)
                      = over l (const c)
                      = set l c

It seems that the sensible-sounding law

A3b. over l id = id

is not actually needed here.  Perhaps it follows from general
considerations.  As for deriving L2, the simplest translation I have
found is A2

A2. over l (view l <<< arr (const a)) <<< arr (const a) = arr (const a)

Note that if hypotheses P1 and P2 are correct then this reduces to

    arr (over l (view l <<< const a) <<< const a) = arr (const a)

which is equivalent to A2 specialised to arr = (->)

A2'. over l (view l <<< const a) <<< const a = const a

(The latter follows from the former by specialising to arr = (->).
The former follows from the latter by applying arr to both sides.)
In turn this is equivalent to

    over l (const (view l a)) a = a

which is

A2''. set l (view l a) = a

We can still derive L2 from A2 without assuming P1 and P2.  We obtain
A2' immediately by specialising to arr = (->).

--- The origin of the ArrLens laws

Thinking about the product structure that the Arrow typeclass encodes
makes it very clear what `over` and `view` represent in the context of
Arrows, and why the laws A1 and A3 are justified.  An `ArrLens s t a
b` represents the structure of a type which is isomorphic to `(a, z)`
for some `z`, and allows the `a` to vary to `b` if we pass the
appropriate argument to `over`. (In the diagrams I abbreviate `over l`
and `view l` to `over` and `view`.)

`over f` applies `f` to the `a` component and does nothing to the `z`
component.

          over f
     +-+         +-+
     |a|----f--->|b|
     +-+         +-+
     |z|---id--->|z|
     +-+         +-+

`view` extracts the `a` component

     +-+         +-+
     |a|         |a|
     +-+--view-> +-+
     |z|
     +-+

The laws A1 and A2 arise naturally

          over f >>> view
     +-+         +-+         +-+
     |a|----f--->|b|         |b|
     +-+         +-+--view-> +-+
     |z|----id-->|z|
     +-+         +-+


           view >>> f
     +-+         +-+         +-+
     |a|         |a|----f--->|b|
     +-+--view-> +-+         +-+
     |z|
     +-+


         over f  >>> over g
     +-+         +-+         +-+
     |a|----f--->|b|----g--->|c|
     +-+         +-+         +-+
     |z|----id-->|z|----id-->|z|
     +-+         +-+         +-+


           over (f >>> g)
     +-+                     +-+
     |a|-------f >>> g ----->|c|
     +-+                     +-+
     |z|---------id--------->|z|
     +-+                     +-+

Law A2 is more difficult and I haven't found a particularly satisfying
interpretation of it.

-- Proposal for `Control.Lens`

Many of the components of `Control.Lens` can be extended to `ArrLens`
with no theoretical impediment.  I do not know whether there would be
a performance cost.

If we disregard performance issues then I would suggest that all
`Lens` definitions in `Control.Lens` should be generalised to
`ArrLens` as this would provide a strict increase in functionality.
The `Lens` definitions in `Control.Lens` include `makeLenses` and the
tuple accessors `_1`, `_2`, ....  Further it seems that `over` can be
generalized to take into account `ArrLens`.

> overGeneral :: (Profunctor q, Profunctor p) =>
>                L.Overloading p q LS.Mutator s t a b
>                -> p a b -> q s t
> overGeneral l f = LS.runMutator `rmap` l (LS.Mutator `rmap` f)

Hopefully, despite its name, this is not too much of a generalisation
to work in practice.  There are probably many other lens combinators
that will extend to `ArrLens` with only a slight change to their
implementation.

-- Further comments

The concept of van Laarhoven lens generalises very naturally to arrows
as do the laws which govern the lenses, with the exception of L2 whose
interpretation in terms of arrows is still rather unclear.

Note that ArrLenses are polymorphic in the arrow argument so we expect
that viewing is always a pure operation.  This property would also
follow from hypothesis P1.  Thus ArrLenses can only be used to view
data "you have already got your hands on".  Furthermore we hypothesise
that `over f` performs only the effect of `f`, and only once.  Thus an
ArrLens itself never has effects.

-- Further questions

* Can we replace A3 with its specialisation to (->)?
* What is the significance of law A3b?
* What is the nature of the difference between Lens and ArrLens?
* Is it possible to write an ArrLens for every Lens?

[1] http://hackage.haskell.org/package/lens-3.9.1/docs/Control-Lens-Lens.html