Posted on 2017-12-23
by Oleg Grenrus
lens

It's good time to write tongue-in-cheek posts on Christmas Holidays.

You have probably have heard about *Profunctor Optics*, there is a paper by Matthew Pickering et. al, and my *Glassery* post. *Functor optics* are similar and *simple*. With profunctors you can define type-changing optics, with bare `Functor`

you can define only so called simple optics.

As this is a literal Haskell file, first a moderate prelude
```haskell
{-# LANGUAGE RankNTypes, TypeOperators, DeriveFunctor, GADTs #-}
module FunctorOptics where
import Data.Functor.Contravariant
import Data.Functor.Identity
import Data.Functor.Invariant
import Data.Type.Equality
import Data.Monoid (Endo (..))
import Data.Tuple (swap)
import Data.Bifunctor (first)
import qualified Data.Profunctor as P
```

As I mentioned already, to express type changing optics the `OpticP`

(`P`

for profunctor) type synonym takes five arguments: a profunctor and four type variables:

`type OpticP p s t a b = p a b -> p s t`

But what if you don't want to change types? When `s ~ t`

and `a ~ b`

, we can simplify the above into *Functor optics*:

```
type OpticP' p s a = p a a -> p s s
type Optic f s a = f a -> f s
```

As with profunctor optics, there are different type-classes constraining variable a -functor, that's how we get lenses, prisms, getters, setters etc. We will explore them below.

Every Haskell programmer is familiar with the `Functor`

type class:

```
class Functor f where
fmap :: (a -> b) -> f a -> f b
```

What might be surprising, in functor optics it's used to define `Review`

(similarly as `Bifunctor`

is used to define `Review`

in profunctor optics, this kind of analogy is visible through all definitions).

`type Review s a = forall f. Functor f => Optic f s a`

We have `upto`

to create `Review`

and `review`

to use one. `upto`

is simply a `fmap`

, and to define `review`

we use `Identity`

functor: `a -> b ≅ Identity a -> Identity b`

.

```
upto :: (a -> s) -> Review s a
upto = fmap
type AReview s a = Optic Identity s a
review :: AReview s a -> a -> s
review l a = runIdentity (l (Identity a))
```

By the way, A Representation Theorem for Second-Order Functionals by Mauro Jaskelioff and Russell O'Connor tells us that

`forall f. Functor f => f a -> f s ≅ a -> s`

which is intuitively true. The left to right is witnessed by `review`

, and other direction by `upto`

. However, the paper has more rigorous and general proof.

Let's continue with classes more or less widely used, i.e. there is a package on Hackage!

"Dually" to `Functor`

(dual of `Functor`

is `Functor`

), the `Contravariant`

type class gives rise to a `Getter`

.

Whereas in Haskell, one can think of a

`Functor`

as containing or producing values, a contravariant functor,`Contravariant`

is a functor that can be thought of asconsumingvalues.

`Contravariant`

lives in a `contravariant`

package.

```
class Contravariant f where
contramap :: (b -> a) -> f a -> f b
```

As with `Review`

, constructor of `Getter`

is simply a member of the class, in this case `contramap`

:

```
type Getter s a = forall f. Contravariant f => Optic f s a
to :: (s -> a) -> Getter s a
to = contramap
```

`to`

was easy to define, for `view`

we will need a new `newtype`

`Flipped`

:

```
newtype Flipped a b = Flip { unflip :: b -> a }
instance Contravariant (Flipped a) where
contramap f (Flip g) = Flip (g . f)
type AGetter s a = Optic (Flipped a) s a
view :: AGetter s a -> s -> a
view l s = unflip (l (Flip id)) s
```

The `Invariant`

class is less known. It's a moral superclass of both, `Functor`

and `Contravariant`

type classes. In fact, any `* -> *`

type parametric (i.e. ADTs) in the argument permits an instance of `Invariant`

. It lives in `invariant`

package.

```
class Invariant f where
invmap :: (a -> b) -> (b -> a) -> f a -> f b
```

For example, `Flipped`

is also an `Invariant`

functor:

```
instance Invariant (Flipped a) where
invmap _ = contramap
```

Reader could guess that `invmap`

is a constructor for `Iso`

.

```
type Iso s a = forall f. Invariant f => Optic f s a
iso :: (a -> s) -> (s -> a) -> Iso s a
iso = invmap
```

`view`

and `review`

work with optics constructed with `iso`

, e.g.

```
negated :: Num a => Iso a a
negated = iso negate negate
-- evaluates to -2
example1 :: Int
example1 = view negated 2
```

One remark about `Invariant`

. In *Profunctor Optics: The Categorical view* Bartosz Milewski looks into profunctor optics. In very similar way, we can look into Functor optics, yet instead of using pairs *<a, b>* and *<s, t>*, it's enought to use *a* and *s*, then we arrive to the similar conclusion:

`forall f. Invariant f => f a -> f s ≅ (s -> a, a -> s)`

If we don't constraint `f`

, we have an equality. Note: `data a :~: b`

is a non-parametric GADT, and therefore **not even ** an `Invariant`

.

```
type Equality s a = forall f. Optic f s a
simple :: Equality a a
simple = id
toEquality :: a :~: s -> Equality s a
toEquality = gcastWith
fromEquality :: Equality s a -> a :~: s
fromEquality l = l Refl
```

Also note, here we havee a Leibnizian equality as in `eq`

package, just without a `newtype`

wrapper:

`data a := b = Refl' { subst :: forall c. c a -> c b }`

So far we handled the edges of optics lattice: `Identity`

, `Iso`

, `Getter`

, and `Review`

. But how about simple `Lens`

?

We can define `over`

using a `Endo`

newtype.

```
type ASetter s a = Optic Endo s a
over:: ASetter s a -> (a -> a) -> (s -> s)
over l f = appEndo (l (Endo f))
```

Note: `Endo`

is neither `Functor`

, nor `Contravariant`

, but it's `Invariant`

!

```
-- evaluates to -25
example2 :: Int
example2 = over negated (\x -> x * x) (- 5)
```

But what's the type-class for `Setter`

? Here, we can use what we know about profunctor optics. There, the class is `Mapping`

, we can have similar class too

```
class Invariant f => Mapping f where
map' :: Functor g => f a -> f (g a)
```

`Endo`

is an instance of this class, but `Flipped`

isn't (we cannot `view`

through a `Setter`

!):

```
instance Mapping Endo where
map' (Endo f) = Endo (fmap f)
```

So we can defined `Setter`

as

`type Setter s a = forall f. Mapping f => Optic f s a`

For `setting`

we need an auxiliary `Functor Context`

:

```
setting :: ((a -> a) -> s -> s) -> Setter s a
setting f = invmap (\(Context g s) -> f g s) (Context id) . map'
data Context a b t = Context (b -> t) a deriving Functor
```

`Setter`

was defined in a very same way as it would be in a profunctor optics, so are many other optics, e.g. `Lens`

we cover next.

We'll conclude the journey by defining `Lens`

. As with `Setter`

, we can piggyback on what we know from profunctors:

```
class Invariant f => Strong f where
first' :: f a -> f (a, c)
first' = invmap swap swap . second'
second' :: f a -> f (c, a)
second' = invmap swap swap . first'
{-# MINIMAL first' | second' #-}
```

There aren't that many `Strong`

functors, `Endo`

and `Flipped`

are (we we can `over`

/ `set`

and `view`

through the lens, respectively):

```
instance Strong Endo where
first' (Endo f) = Endo (first f)
instance Strong (Flipped a) where
first' (Flip f) = Flip (f . fst)
```

So finally we can define `Lens`

type-alias and `lens`

constructor:

```
type Lens s a = forall f. Strong f => Optic f s a
lens :: (s -> a) -> (s -> a -> s) -> Lens s a
lens getter setter fa = invmap
(\(a, s) -> setter s a)
(\s -> (getter s, s))
(first' fa)
```

In this post we saw definitions *Functor optics*, which are simple versions of *Profunctor optics*. This simplicity might be useful when experimenting with optics, as there is less type-variables to deal with. Working out `Prism`

or `Traversal`

is this "formalism" is left as an exercise to the reader. Another interesting exercise is to figure out *Free Strong*, apply it in the construction of Jaskelioff & O'Connor & Bartosz, turn the category theory wheels and see

`data ConcreteLens s a = CL (s -> a) (s -> a -> s)`

pop out.Please comment on Reddit thread or on Twitter.

Edward Kmett mentions on Twitter

Fun fact: We figured out prisms, etc. for this form of optic before we figured out the profunctor versions.

Phil Freeman wonders on Reddit on how you go between Profunctor and Functor optics.

Let's see a simple example converting `Lens`

. From functor to profunctor is simple using `Trace`

newtype Phil mentions:

```
data Trace p a = Trace { getTrace :: p a a }
instance P.Profunctor p => Invariant (Trace p) where
invmap f g (Trace x) = Trace (P.dimap g f x)
instance P.Strong p => Strong (Trace p) where
first' (Trace x) = Trace (P.first' x)
profunctorFirst :: P.Strong p => OpticP' p (a, c) a
profunctorFirst = getTrace . first' . Trace
```

Other way around is a little tricker!

Phil *thinks* using existential `Split`

would work. And **he is right**.

```
data Split f a b where
Split :: (a -> x) -> (x -> b) -> f x -> Split f a b
instance P.Profunctor (Split f) where
dimap f g (Split h i x) = Split (h . f) (g . i) x
split :: f a -> Split f a a
split = Split id id
unsplit :: Invariant f => Split f a a -> f a
unsplit (Split h i x) = invmap i h x
```

We can even write `Strong`

instance:

```
instance Strong f => P.Strong (Split f) where
first' (Split h i x) = Split (first h) (first i) (first' x)
```

So we can convert Profunctor Lens into Functor one:

```
functorFirst :: Lens (a, c) a
functorFirst = unsplit . P.first' . split
```

This direction, using `Split`

, isn't as elegant as other one using `Trace`

, but seems to work!

Site proudly generated by Hakyll