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.


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!


"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


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.


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.

#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