# Functor Optics

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.

## #Functor optics?

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.

## #Functor

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.

## #Existing classes

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

### #Contravariant

"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 as consuming values.

`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``````

### #Invariant

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)``

### #No class at all

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 }``

## #New classes

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.

### #Strong

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)``````

## #Conclusion

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.

## #Postscriptum

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

### #To and from Profunctor optics

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! This work is licensed under a “CC BY SA 4.0” license.

Site proudly generated by Hakyll