Taking a good look at Optics

24 minute read Published: 2021-12-30

As part of my astrological forays, I built a little library that can traverse an interval of time and find significant events (changes in moon phase, a planet going retrograde/direct, ingresses into zodiac signs, transits, eclipses.) The data produced is necessarily verbose: you get back a sequence of events, and each type of event carries information about itself; in some cases, said information can be composed of further complex data (e.g. a Transit can tell you all the phases of application/separation it goes through in the interval, and each phase has a beginning and end.) To have to go through a sequence like this and pattern match and deconstruct in different ways depending on your use case seemed like a lot of annoying boilerplate that I, as a library author, could do better to help with than to just give you the types to pattern match, some good names, and a firm handshake. And this is when I realized what's so great about a popular, albeit intimidating, concept in the Haskell ecosystem: optics: the ability to build greatly upon "cheap" abstractions.

Getting (to) it

I have to admit, I've been one of the attention-challenged developers that gazes upon the Sacred UML and despairs, and both very practical tutorials that devolve into very clever combinator golf and strongly reasoned but impenetrable category theoretic approaches have left me in a state of mild panic.

I watched a few videos, read a few articles and book chapters that mostly helped me cobble together a working knowledge of optics/lenses, but beyond the "it's sort of just getters and setters for Haskell innit" notion that allows you to dig deep into some JSON or put together a couple diagrams or swagger docs, I didn't feel like I got it. On the one hand, why did the extremely pedestrian notion of thing.property.property.property = new_value feel so contrived? On the other hand, it felt like it needed to be more "fancy" to survive in the world of pure, lazy, functional programming.

It wasn't until I was sitting around thinking about how I can allow users of my library to go through a sequence of product values composed of further product values with some sum values in the middle there that the value proposition landed: I don't need a big ol' dependency like lens to give you a few optics that you can then grab and do optics things with. And you don't need lens either: you can use microlens or another smaller library, or write a few little functions, and suddenly you have very concise, composable access to just the data you need, and a whole vocabulary of cool combinators to grab from as your use cases evolve (and you eventually end up bringing in lens.) And that is only possible because the abstractions of optics can be represented with a few type aliases (or profunctors, more on that later,) that is: it's already there in the language, we don't need to agree on a library. And this very concrete need, not needing to bring in big dependencies, makes it a very cost-effective abstraction: you don't need to invest a lot of your dependency budget, but you can get a lot of possibilities of re-combination out of it.

Providing some baby optics

After reading this excellent blog post about writing one's own lenses, as well as the microlens README, the relude implementation and last but not least kmett's own wiki on the matter, I realized that, to provide the kind of basic optics that my library could benefit from (i.e. monomorphic lenses and prisms... or something close to that,) I literally only needed a couple of type aliases:

{-# LANGUAGE RankNTypes #-}
module Almanac.Internal.Lens where

-- | General lens: can change the type of the container.
-- from: https://hackage.haskell.org/package/lens-5.1/docs/Control-Lens-Lens.html#t:Lens
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t

-- | Monomorphic (simple) 'Lens': can't change the type when setting
type Lens' s a = Lens s s a a

-- | General Traversal
-- from: https://hackage.haskell.org/package/lens-5.1/docs/Control-Lens-Type.html#t:Traversal
type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t

-- | Monomorphic 'Traversal'
type Traversal' s a = Traversal s s a a

And to "create" lenses, I could generalize the process with a simple helper function:

-- | Create a 'Lens'' from a getter and setter
simpleLens :: (s -> a) -> (s -> a -> s) -> Lens' s a
simpleLens getter setter f s = setter s <$> f (getter s)

The types in my library are either big records composed of further records, or sum types, so lenses for the former make sense -- for the famous/infamous looks.like.java nested access uses cases. For the case where one wants to focus on one of different options in a sum type, the optics literature would posit a Prism: however, if you go looking, you'll find that a bona-fide Prism is defined in terms of type classes from profunctors:

type Prism s t a b =
    forall p f. (Choice p, Applicative f) =>
    p a (f b) -> p s (f t)

Which would allow one to use all combinators that can be used on Prisms... but it seemed like for my prospective use case, focused more on reading/getting than in writing/setting the pseudo-prisms that are actually Traversals as proposed by microlens were more than enough. With the above simpleLens helper and the "Traversals misused as Prisms" concession, I was ready to provide a few optics. For example:

eventL :: Lens' ExactEvent Event
eventL =
  simpleLens get set
  where
    get = event
    set e evt' = e{event=evt'}

exactitudeMomentsL :: Lens' ExactEvent [UTCTime]
exactitudeMomentsL =
  simpleLens get set
  where
    get = exactitudeMoments
    set e exc' = e{exactitudeMoments = exc'}

_LunarPhaseInfo :: Traversal' Event LunarPhaseInfo
_LunarPhaseInfo f (LunarPhase info) = LunarPhase <$> f info
_LunarPhaseInfo _ evt = pure evt

Allow writing code such as:

  it "finds all lunar phases in November 2021" $ do
    let nov2021 = UTCTime (fromGregorian 2021 11 1) 0
        dec2021 = UTCTime (fromGregorian 2021 12 1) 0
        q = mundane
              (Interval nov2021 dec2021)
              [QueryLunarPhase]
        expectedPhases =
          [
            (WaningCrescent,"2021-11-01T13:28:27.314121723175Z"),
            (NewMoon,"2021-11-04T21:14:36.684200763702Z"),
            (WaxingCrescent,"2021-11-08T02:31:28.868464529514Z"),
            (FirstQuarter,"2021-11-11T12:46:02.566146254539Z"),
            (WaxingGibbous,"2021-11-15T07:27:48.519482016563Z"),
            (FullMoon,"2021-11-19T08:57:27.984892129898Z"),
            (WaningGibbous,"2021-11-23T12:50:27.58442312479Z"),
            (LastQuarter,"2021-11-27T12:27:40.648325085639Z")
          ] & map (second mkUTC)
    exactPhases <- runQuery q >>= eventsWithExactitude
    let digest = (summarize <$> exactPhases) ^.. traversed . _Just
        summarize evt =
          let phase      = evt ^? eventL._LunarPhaseInfo.lunarPhaseNameL
              firstExact = evt ^? exactitudeMomentsL._head
          in (,) <$> phase <*> firstExact
    digest `shouldBe` expectedPhases

That is: run the query, and try to find all phases for which we were able to calculate moments of exactitude (not all events are guaranteed to get their moments of exactitude calculated -- a transit may be happening, but not become exact in the examined interval); for all of those, get the name of the phase. The alternative is a ton of pattern matching. Arguably, one still needs to know the "shape" of things (what data constitutes an event, and a lunar phase,) but the resulting code is concise, reusable in smaller blocks, and can be put together with existing combinators and optics into existing types (like the _Just or _head prisms) -- vs. you having to write your own pseudo-optics by pattern matching every time you want to "look into" a particular path in the data: this kind of boilerplate evaporates.

Granted, a previous incarnation of the above code in specific is less dense:

extractMoonPhaseInfo :: Seq ExactEvent -> [(LunarPhaseName, UTCTime)]
extractMoonPhaseInfo evts =
  fmap summarize evts & toList & catMaybes
  where
    summarize (ExactEvent (LunarPhase LunarPhaseInfo{lunarPhaseName}) (firstExact:_)) =
      Just (lunarPhaseName, firstExact)
    summarize _ = Nothing

-- setup is the same ...
-- it "....
        exactPhases <- runQuery q >>= eventsWithExactitude
        let digest = extractMoonPhaseInfo exactPhases
--      digest `shouldBe` ...

But, in my view, it's also less modular: I needed a separate helper function to isolate the deep pattern-matching, and the building blocks (i.e. "here's how you get the phase name", and "here's how you get the first moment of exactitude") were less obvious candidates for use in other situations in the very same test suite, which meant having to figure out ad-hoc "optics" to look into the bits of data that I cared about for each test case, as opposed to just composing existing optics.

So, with a couple of type aliases, and some elbow grease (didn't want to introduce a fancy TemplateHaskell internal module to call simpleLens for me) to provide the obvious lenses and "prisms", I can now allow the deep-nested access in the "dialect" of optics that some users prefer (others can continue using the less esoteric approach of pattern matching and judicious helper functions; and whomever chooses this, doesn't have to carry a big ol' lens dependency that they're not using.)

Practical needs met, I still felt like the matter of "can't really provide real Prisms" hid some interesting discoveries, so I went looking for some literature on this whole optics thing.

Down the profunctors rabbit hole

Reading the lens package haddocks didn't really get me very far: there's a nice symmetry to the definitions of Lens and Traversal reproduced above, and Prism, with its weird Choice constraint, looked almost offensively out of place. Fortunately, I had heard in passing that even though the most popular library, lens, uses a representation of optics called the van Laarhoven encoding, all optics could also be represented as profunctors without losing the "you can get them for free out of existing concepts" elegance, so I grabbed a couple of papers and articles:

It was that last paper that really laid everything in a manner comprehensible to me: they first define some optics in the more naïve, "data" encoding, and then they introduce the notion of Profunctor as a generalization of functions:

-- | A @Profunctor a b@ is a "transformer" that knows how to "read" and "write"
-- into a value.
class Profunctor p where
  dimap :: (a' -> a) -> (b -> b') -> p a b -> p a' b'

The instance of functions as profunctors somewhat cemented the "intuition" of profunctors for me:

-- | f can be understood as a preprocessor (which is why it's contravariant:
-- has to output whatever h expects,) and g is a post-processor
-- (which is why it's covariant, it takes what h produces)
instance Profunctor (->) where
  dimap f g h = f >>> h >>> g

In that a dimap operation on a profunctor h, given a function f that can produce inputs to h, and a function g that can consume outputs from h, gives us a new profunctor that "wraps" the original one. The paper does an excellent job in pacing this and all subsequent definitions, I can't do it justice here without reproducing the whole thing, so please go read it!

And then, to finally land on these very symmetrical definitions of Lens, Traversal and Prism, which, being profunctors, can compose with each other (We'll define Cartesian and CoCartesian later):

type Optic p a b s t = p a b -> p s t

-- | 'Adapter' is @Iso@ in @Control.Lens@
type AdapterP a b s t 
  = forall p. Profunctor p 
  => Optic p a b s t

-- | 'Cartesian' in the paper is the same as @Strong@ in @profunctors@
type LensP  a b s t 
  = forall p. Cartesian p 
  => Optic p a b s t

-- | 'CoCartesian' == @Choice@ from @profunctors@
type PrismP a b s t 
  = forall p. CoCartesian p 
  => Optic p a b s t

-- | 'Monoidal' == @Traversing@ (?)
type TraversalP a b s t 
  = forall p. (Cartesian p, CoCartesian p, Monoidal p) 
  => Optic p a b s t

Which rely on the following family of profunctors:

-- | Strength with respect to product types.
-- @profunctors@ calls this @Strong@,
-- also says it's the "generalizing Star of a strong Functor"
class Profunctor p => Cartesian p where
  first :: p a b -> p (a,c) (b,c)
  second :: p a b -> p (c,a) (c,b)

-- | Known in @profunctors@ as @Choice@,
-- "generalizing CoStar of a Functor that's strong in Either"
class Profunctor p => CoCartesian p where
  left :: p a b -> p (Either a c) (Either b c)
  right :: p a b -> p (Either c a) (Either c b)

class Profunctor p => Monoidal p where
  par :: p a b -> p c d -> p (a, c) (b, d)
  empty :: p () ()

That is: all of these, and more, are optics with different constraints for the profunctors involved; and, being profunctors, an Optic itself can be seen as a lifting of a "transformer" of components a to b, p a b, into a "transformer" of whole structures s to t, p s t. And they combine nicely to produce new optics like affine traversals (where a Lens and Prism meet,) to solve concrete needs such as "how to get the first element of an optional pair". I put together code from the paper as I was reading along, plus my very poorly named/thought out exploratory examples, in a gist, if you want to play with it and check out some examples.

As I was putting together the gist above, it's very interesting to see how some operators from the Control.Category and Control.Arrow modules can be used to write some profunctor instances: a certain rhyming that intimates that in the same vein that Arrow aims to generalize at a very deep level some patterns of programming, Profunctor can be seen as building upon that same ethos (one can even say that "Arrow is just a Strong Category, anyway", though that's arguable.)

An extended example

One train of thought that I want to hop onto for a bit, is the paper's demonstration of the modularity of profunctor optics, vs. the less generally applicable "concrete" optics, which I think embodies the essence of these kind of "high-yield" abstractions.

Let's say we want to write a concrete Lens into the first component of a pair:

-- | Concrete lens
data Lens a b s t = Lens {view :: s -> a, update :: (b,s) -> t}

-- | Act on the first component
_1 :: Lens a b (a,c) (b,c)
_1 =
  Lens v u
  where
    v (a, c)= a
    u (b, (a,c)) = (b,c)

Which works fine. However, let's say that we're now dealing with a pair whose first component is itself a pair. We want something like _1_1 :: Lens a b ((a,c),d) ((b,c),d). Since the concrete representation of Lens is not a function (or a Category,) we can't simply say that _1_1 = _1 . _1. So we must give up and pattern match once again:

_1_1 :: Lens a b ((a,c),d) ((b,c),d)
_1_1 =
  Lens v u
  where
    v ((a,c),d) = a
    u (b, ((a,c),d)) = ((b,c),d)

The van Laarhoven encoding doesn't suffer from this:

-- | Almost the same definition as from Control.Lens, but with @s t a b@
-- changed to @a b s t@ to agree with the profunctor optics paper:
type LensVL a b s t = forall f. Functor f => (a -> f b) -> s -> f t

-- | little helper to build lenses 
lens :: (s -> a) -> (s -> b -> t) -> LensVL a b s t
lens sa sbt afb s = sbt s <$> afb (sa s)

_1VL :: LensVL a b (a,c) (b,c)
_1VL = 
  lens v u
  where
    v (a,c) = a
    u (a,c) b = (b,c)

_1_1VL :: LensVL a b ((a,c),d) ((b,c),d)
_1_1VL = _1VL . _1VL

And neither does the profunctor encoding:

-- | 'Cartesian' here == 'Strong' in @profunctors@
class Profunctor p => Cartesian p where
  first  :: p a b -> p (a,c) (b,c)
  second :: p a b -> p (c,a) (c,b)

type LensP a b s t = forall p. Cartesian p => Optic p a b s t

-- | Using left-to-right composition and 'fanout' from Control.Category/Arrow,
-- plus 'dimap' from 'Profunctor':
_1P :: LensP a b (a,c) (b,c)
_1P = first >>> dimap (fst &&& id) (second snd)

_1_1P :: LensVL a b ((a,c),d) ((b,c),d)
_1_1P = _1P . _1P

Things get even more interesting once one gets prisms into the mix. Let's say we want to have a prism into an optional value:

data Prism a b s t = Prism {match :: s -> Either t a, build :: b -> t}

the :: Prism a b (Maybe a) (Maybe b)
the =
  Prism m b
  where
    m Nothing = Left Nothing
    m (Just a) = Right a
    b b' = Just b'

If we wished to use the and _1 together with this "concrete" encoding, as we've seen before when trying to compose _1 after itself, we can't use the existing functions that we wrote for each sub-problem, and have to write the combination anew, by pattern matching and building up to the components of a new data type, the AffineTraversal:

-- | Thanks to: https://github.com/hablapps/DontFearTheProfunctorOptics/blob/master/ProfunctorOptics.md#profunctor-affine
-- and: https://artyom.me/lens-over-tea-5
data AffineTraversal a b s t 
  = AffineTraversal { preview :: s -> Either t a, set :: (b,s) -> t}

_the_1 :: AffineTraversal a b (Maybe (a,c)) (Maybe (b,c))
_the_1 =
  AffineTraversal p s
  where
    p Nothing = Left Nothing
    p (Just (a,c)) = Right a
    s (b, Just (a,c)) = Just (b,c)
    s (b, Nothing) = Nothing
    
_1_the :: AffineTraversal a b (Maybe a, c) (Maybe b, c)
_1_the =
  AffineTraversal p s
  where
    p (Nothing, c) = Left (Nothing, c)
    p (Just a, c) = Right a
    s (b, (Just a, c)) = (Just b,c)
    s (b, (Nothing,c)) = (Nothing, c)

In the case of profunctor optics, we can get to affine traversals by simple composition, the new optic arising unladen as yet another "Optic with certain constraints" type alias:

class Profunctor p => CoCartesian p where
  left :: p a b -> p (Either a c) (Either b c)
  right :: p a b -> p (Either c a) (Either c b)

type PrismP a b s t 
  = forall p. CoCartesian p 
  => Optic p a b s t

theP :: PrismP a b (Maybe a) (Maybe b)
theP = right >>> dimap (maybe (Left Nothing) Right) (either id Just)

-- | optic into the first component of an optional pair
-- >>> the_1P (^2) (Just (3, True))
-- Just (9,True)
the_1P :: (Cartesian p, CoCartesian p) => Optic p a b (Maybe (a, c)) (Maybe (b, c))
the_1P = theP . _1

-- | optic onto the optional first component of a pair:
-- >>> _1_theP (^2) (Just 2, False)
-- (Just 4,False)
_1_theP :: (Cartesian p, CoCartesian p) => Optic p a b (Maybe a, c) (Maybe b, c)
_1_theP = _1 . theP

If we want to put a name to the resulting optic:

-- | Optic with 0 or 1 targets.
type AffineTraversalP a b s t 
  = forall p. (Cartesian p, CoCartesian p)
  => Optic p a b s t

-- | optic into the first component of an optional pair
-- >>> the_1P (^2) (Just (3, True))
-- Just (9,True)
the_1P :: AffineTraversalP a b (Maybe (a, c)) (Maybe (b, c))
the_1P = theP . _1 

-- | optic onto the optional first component of a pair:
-- >>> _1_theP (^2) (Just 2, False)
-- (Just 4,False)
_1_theP :: AffineTraversalP a b (Maybe a, c) (Maybe b, c)
_1_theP = _1 . theP

In the van Laarhoven encoding, we can also easily compose a Prism and a Lens:

type PrismVL a b s t 
  = forall p f. (CoCartesian p, Applicative f) 
  => p a (f b) -> p s (f t)

prism :: (s -> Either t a) -> (b -> t) -> PrismVL a b s t
prism seta bt = dimap seta (either pure (fmap bt)) . right

theVL :: PrismVL a b (Maybe a) (Maybe b)
theVL =
  prism m b
  where
    m Nothing = Left Nothing
    m (Just a) = Right a
    b b' = Just b'

the_1VL :: Applicative f => (a -> f b) -> Maybe (a, c) -> f (Maybe (b, c))
the_1VL = theVL . _1VL

_1_theVL :: Applicative f => (a -> f b) -> (Maybe a, c) -> f (Maybe b,c)
_1_theVL = _1VL . theVL

However, if were to put a name to the resulting optic, as described much better elsewhere, we would be forced, given the Applicative constraint inherited from the traditional definition of Prism, to recognize it as a Traversal:

type TraversalVL a b s t = forall f. Applicative f => (a -> f b) -> s -> f t

the_1VL :: TraversalVL a b (Maybe (a, c)) (Maybe (b, c))
the_1VL = theVL . _1VL

_1_theVL :: TraversalVL a b (Maybe a, c) (Maybe b,c)
_1_theVL = _1VL . theVL

Which isn't quite right, as it's slightly overpowered: a Traversal can have many targets that it can act upon sequentially (hence the Applicative), but we really only need to target zero or one components of a value that we may act upon or update. If we had an alternative formulation of Prism, with the controversial Pointed class:

class Pointed p where
  point :: a -> p a

type PrismVL' a b s t 
  = forall p f. (CoCartesian p, Functor f, Pointed f) 
  => p a (f b) -> p s (f t)

prism' :: (s -> Either t a) -> (b -> t) -> PrismVL' a b s t
prism' seta bt = dimap seta (either point (fmap bt)) . right

theVL' :: PrismVL' a b (Maybe a) (Maybe b)
theVL'=
  prism' m b
  where
    m Nothing = Left Nothing
    m (Just a) = Right a
    b b' = Just b'

_the_1VL' :: (Functor f, Pointed f) => (a -> f b) -> Maybe (a, c) -> f (Maybe (b, c))
_the_1VL' = theVL' . _1VL

_1_theVL' :: (Functor f, Pointed f) => (a -> f b) -> (Maybe a, c) -> f (Maybe b, c)
_1_theVL' = _1VL . theVL'

And if we were to put a name to the resulting optic:

type AffineTraversalVL a b s t 
  = forall f. (Functor f, Pointed f) 
  => (a -> f b) -> s -> f t

_the_1VL' :: AffineTraversalVL a b (Maybe (a, c)) (Maybe (b, c))
_the_1VL' = theVL' . _1VL

_1_theVL' :: AffineTraversalVL a b (Maybe a, c) (Maybe b, c)
_1_theVL' = _1VL . theVL'

I find that quite neat: just like Pointed is right there between Functor and Applicative, an AffineTraversal, which can focus on a part of a whole that may not be there, is right there between acting upon one target either reading or setting a part of a whole (Lens) and one of mutually exclusive alternatives which can also construct the whole (Prism) (and not beyond, all the way to Traversal, which can act over many targets at once.) It's interesting, though, how in both the van Laarhoven encoding and the profunctor encoding, a hierarchy arises and one can use a Traversal, say, to do the job of an AffineTraversal or a Prism, which are "below" in the hierarchy -- much like one can use a power tool to open a can of tomato sauce: possible, but some of the power is being "wasted," and one could make a (conceptual) mess. Just because I think it's pretty, the also extremely excellent Glassery article shows several optics in their hierarchical relationship as a diagram

The paper of course doesn't cover all possible bases -- it stays true to its mission of focusing on profunctor optics; they hint at the existence of Affine Traversals but don't land on the concept by name, and they intimate in passing an impossibility with Costar and Choice that I asked on Reddit about, because it seemed to contradict another intimation found in the profunctors library

Coming down from the profunctors trip

Apart from providing a more solid foundation to my notion of the biggest selling point for optics being the modularity they provide to other types, and how this kind of very generic but very applicable concept can dispense with loads of boilerplate, it also does an excellent job in providing a practical equivalence between "concrete" ("data") encodings of optics, and profunctor optics. The "what you needa know about yoneda" paper does a great job in proving equivalence between the profunctor and van laarhoven encodings, as does this talk by Bartosz Milewski. I even found code in Control.Lens to transform between representations!

One somewhat abstract lesson here is: it's interesting how the story of concrete encodings being easy to grok but not very helpful once one wants to compose optics with each other contrasts with the more "rarefied" encodings that do allow composability: the van Laarhoven encoding uses existing type classes to arm each optics representation with power coming from more general concepts (Functor for focusing on one component, like Lenses; Applicative for focusing on many,) but it suffers from some legacy issues by engaging the existing type class hierarchy going up from there: though it can go very far by not using anything that's not in base, it eventually has to rely on Profunctor anyway for Prism and others; the Profunctor encoding builds upon a different hierarchy with Profunctor at its base, which is conceptually extremely clean, but in the current state of affairs, requires pulling in the heavy profunctors package.

Another, more concrete lesson, is that just like my "pattern match every single time" motivating story can get tedious, concrete optics buckle under the weight of their lack of generality; the more "abstract" encodings provide a vocabulary to elide boilerplate tasks -- this is a conclusion drawn by the profunctor optics paper, too, and they point to other interesting work in this same vein, like the Scrap your Boilerplate concept: purely mechanical work on data shouldn't pollute most business logic!

Also, by seeing how Traversal relates to Prism and AffineTraversal, I feel mostly okay about my library exporting Traversals where it should be exporting Prisms -- though if profunctors ever land in base, or if a "transformer" arises in my library as I refine it and thus necessitates pulling in the profunctors package, I'd like to refactor my pseudo-Prisms: I like the notion of the power of the abstraction being commensurate to the use case!

Libraries

Apart from vitrea, which is more of an academic foray into the category theoretical implications of the profunctors encoding, and the very excellent optics library which includes indexed optics, I've found a couple implementations that use profunctors, by well-regarded haskellers:

Further reading

Once again, the Profunctor Optics paper by Pickering, Gibbons and Wu is a fantastic resource, but these others, in no particular order, also served in writing this article (and, no doubt, as I learn much more about what optics can bring to the table: )