A short workshop on optics

Optics.hs

#!/usr/bin/env cabal
{- cabal:
build-depends: base, containers, lens
-}

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}

import Control.Lens hiding (_1, _Left, preview, review, view)
import Control.Lens qualified as Lens
import Data.Map.Strict (Map)

-- @lens@ is a library that lots of people hate, but no one can come up with a
-- better solution. I think it is a complex beast that, once you get to know,
-- you really miss in other languages: it's a steep learning curve, but the
-- results are so much more elegant than the alternatives.

-- We are only going to look at 'Lens', 'Prism', and 'Traversal': three of the
-- potentially type-changing optics that can describe both getting and
-- setting data (in some way). There are others in this category (e.g. 'Iso'),
-- others that aren't (e.g. 'Review'), but these are the three you'll probably
-- see more than anything else.

-- Each of these optics has four parameters:
--
--     'Lens'      s t a b
--     'Prism'     s t a b
--     'Traversal' s t a b
--
-- Each also comes with a two-parameter version:
--
--     'Lens''      s a = Lens      s s a a
--     'Prism''     s a = Prism     s s a a
--     'Traversal'' s a = Traversal s s a a
--
-- In the four parameter version, @s@ and @t@ describe the /source/ and
-- /target/ types. Each type of optic focuses on some number of values inside*
-- the @s@ structure of type @a@. If I transform all those @a@ values into @b@
-- values, the resulting type will be @t@. Here's an example:

_1 :: Lens (a, x) (b, x) a b
_1 = Lens._1

-- So, if I change the @a@ in @(a, x)@ to a @b@, then the result will be
-- @(b, x)@. Most of the time, it's not much more complicated than this. For
-- example, we can target every element of a list:

elements :: Traversal [a] [b] a b
elements = traversed

-- ... or one side of an 'Either':

_Left :: Prism (Either a x) (Either b x) a b
_Left = Lens._Left

-- It's very common to work with types that aren't polymorphic in this way,
-- though, which is why the two-parameter (non-type-changing) versions exist.

data User
  = User
      { _name      :: String
      , _age       :: Int
      , _likesDogs :: Bool
      }

makeLenses ''User
-- name      :: Lens' User String
-- age       :: Lens' User Int
-- likesDogs :: Lens' User Bool

-- At this point, we can start to build up an extremely rough intuition for
-- optics in the following way:
--
--     Optic s t a b <~> (a -> b) -> (s -> t)
--
-- Indeed, if we call 'over' with any of our optics, this is exactly the type
-- signature we get back!

modifyFst :: (a -> b) -> (a, x) -> (b, x)
modifyFst = over _1

modifyLeft :: (a -> b) -> Either a x -> Either b x
modifyLeft = over _Left

modifyElements :: (a -> b) -> [a] -> [b]
modifyElements = over traversed

-- There's even a shorthand for @over . const@, which is conveniently called
-- 'set':

setFst :: b -> (a, x) -> (b, x)
setFst = set _1

setLeft :: b -> Either a x -> Either b x
setLeft = set _Left

setElements :: b -> [a] -> [b] -- Equivalent to @map . const@
setElements = set traversed

-- We will see reasonably soon that this intuition is far from perfect, but it
-- does explain some of the unintuitive behaviour of lenses. For example,
-- optics compose, but perhaps not in the order you'd imagine:

everyone'sDogLikingStatus :: Traversal' [User] Bool
everyone'sDogLikingStatus = traversed . likesDogs

-- At first glance, we might think these types ought to work out roughly as:
--
--     likesDogs ::  User  -> Bool
--     traversed :: [User] -> User
--
-- If that were the case, then this composition would be the wrong way round!
-- However, if we instead look at these types as:
--
--     likesDogs :: (Bool -> Bool) -> ( User  ->  User )
--     traversed :: (User -> User) -> ([User] -> [User])
--
-- @likesDogs@ turns a function on @Bool@ into a function on @User@, and
-- @traversed@ turns a function on @User@ into a function on @[User]@, so
-- @traversed . likesDogs@ turns a function on @Bool@ into a function on
-- @[User]@!

-- EXERCISES
-- * Write an implementation for @Traversal' [(x, User)] Int@
-- * Write an implementation for @Traversal' (x, [User]) Int@



-- In actual fact, that intuition breaks down when we consider the /second/
-- reason we might want to use optics. What if, as well as setting, we also
-- wanted to /get/ data? Well, it turns out they can do that too!

getFst :: (a, x) -> [a]
getFst = toListOf _1

getLeft :: Either a b -> [a]
getLeft = toListOf _Left

getElements :: [a] -> [a]
getElements = toListOf traversed

-- So, if we want to know whether everyone likes dogs, we can now use our
-- traversal: @and . toListOf (everyone'sDogLikingStatus) :: [User] -> Bool@.
-- To go even further, the @lens@ library contains a /lot/ of helper functions for
-- common operations, so we could just write...

doesEveryoneLikeDogs :: [User] -> Bool
doesEveryoneLikeDogs = andOf (traversed . likesDogs)

-- EXERCISES:
--
-- * Using 'filtered' and 'lengthOf', count the number of adults in a list.
-- * Using 'ix', return the name of the third user in the list.



-- This is all very good, but there's a pain point here: to get data out, we
-- seem to need to return it as a list. That's a bit of a nuisance, right?
-- Well, the reason is that 'toListOf' is a function that will work for all
-- three types of optic we care about: @Lens@, @Prism@, and @Traversal@.
-- Another example of a function that works for all three is @preview@:

preview :: Traversal' s a -> s -> Maybe a
preview = Lens.preview

-- When our optic targets more than one value (like 'traversed'), this function
-- will return 'Just' the first result, or 'Nothing' if there are no results.
-- What about '_1', though, where I absolutely know that value will /always/ be
-- there? Do I still have to mess around with 'Maybe'?
--
-- The answer is no:

view :: Lens' s a -> s -> a
view = Lens.view

-- Notice the types here: 'preview' works for all three, but its type says
-- 'Traversal''. This is because every 'Lens' is also a 'Traversal', and so
-- is every 'Prism'. However, a 'Lens' is not a 'Prism', and a 'Prism' is not a
-- 'Lens'. In fact, when you compose a 'Lens' and a 'Prism' together, you
-- get... a 'Traversal'!

leftFst :: Traversal' (Either (x, y) z) x
leftFst = _Left . _1

-- We talk about /strength/ of optics. A 'Lens' can /weaken/ to a 'Traversal',
-- as can a 'Prism', but we can't /strengthen/ an optic in the same way.
--
-- For a /really/ rough rule of thumb (though, again, we've already seen
-- counter-examples, so we'll expand on this in a bit):
--
-- * A 'Lens' focuses on exactly one thing that is always present.
-- * A 'Prism' focuses on exactly one thing that either is or isn't present.
-- * A 'Traversal' focuses on any number of things that are or aren't present.
--
-- We can see how the definition of 'Traversal' here is broad enough to
-- encompass both of the others, and so it is a /weaker/ assertion to make
-- about an optic.
--
-- The contents page for @lens@ on Hackage has a really helpful flowchart,
-- whose arrows we can read as "is a" or "can weaken to".

-- EXERCISES:
--
-- * What type of optic gets you the name of a 'User'?
-- * What type of optic gets you the 'Just' value of a 'Maybe'?
-- * What type of optic gets you the @x@ in an @Either x Void@?

-- One tiny last note about prisms: you might ask why 'ix' isn't a 'Prism';
-- doesn't it focus on exactly one thing that either is or isn't present? The
-- reason is that the interesting difference between a 'Prism' and a
-- 'Traversal' is the 'review' function:

review :: Prism' s a -> a -> s
review = Lens.review

-- A 'Prism' describes the opposite transformation as well! With something like
-- '_Left', it's easy to see how we can implement @a -> Either a x@. With
-- something like '_1' or 'traversed', however, it's impossible. The same is
-- true for 'ix', which is why 'ix' isn't a 'Traversal'.
--
-- In everyday work code, you're not going to see anywhere near as many 'Prism'
-- optics as 'Traversal' optics, so this is general trivia more than crucial
-- information. For now, feel free to replace any mention of 'Prism' with
-- 'Traversal' in your head: it shouldn't meaningfully change much.



-- So, to recap:
--
-- * A 'Lens' focuses a singular inner value, which we can always /get/ and
--   /set/, but we can't necessarily construct the outer value from the inner
--   value.
--
-- * A 'Prism' focuses a singular inner value which may or may not be present,
--   which we can possibly /get/ and always /set/ (because we can transform the
--   new inner value into the outer value with 'review').
--
-- * A 'Traversal' focuses on some number of inner values, which we can
--   possibly /get/ and possibly /set/ (if they're present).



-- This is more than enough information to be productive with optics. As a
-- quick tour of the practical applications of optics, here are some of my
-- favourite optics and combinators:

-- | There's also a 'Nothing', though you probably won't see it a lot in
-- regular work code...
_Just :: Prism' (Maybe x) x
_Just = Lens._Just

-- | Does this 'Traversal' focus any element that matches the given element?
-- There's also 'sumOf', 'firstOf', 'findOf', 'noneOf'.... you name it.
elemOf :: Eq a => Traversal' s a -> a -> s -> Bool
elemOf = Lens.elemOf

-- | Does this 'Traversal' target anything? In other words, if I 'preview' this
-- 'Traversal', will I get a 'Just'? See also 'hasn't'!
has :: Traversal' s a -> s -> Bool
has = Lens.has

-- | What's at this key in this 'Map'? The interesting difference between 'at'
-- (whose type is way more general than this) and 'ix' is that 'at' allows you
-- to /delete/ things in the 'Map' (or other container structure) by setting
-- the value to 'Nothing'. There's even a shorthand function for this: 'sans'.
at :: Ord k => k -> Lens' (Map k v) (Maybe v)
at = Lens.at

-- If we know the thing we care about is on /both/ branches of an 'Either',
-- then we can use 'choosing' to get a 'Lens', rather than two 'Traversal'
-- optics instead.
choosing :: Lens' s a -> Lens' t a -> Lens' (Either s t) a
choosing = Lens.choosing

-- Anyone who has spent any amount of time with optics will also have seen the
-- infamous operators. There's actually a very consistent naming convention to
-- them, but we won't get too much into it. For now, the important ones are:

-- | @user ^. likesDogs@
(^.) :: s -> Lens' s a -> a
s ^. l = view l s

-- | @listOfUsers ^? ix 3 . name@
(^?) :: s -> Traversal' s a -> Maybe a
s ^? l = preview l s

-- | @listOfUsers ^.. traversed . age@
(^..) :: s -> Traversal' s a -> [a]
s ^.. l = toListOf l s

-- | Note this /is/ type-changing, but polymorphism prevents me from writing
-- 'Traversal s t a b' here. In reality, it ought to be 'ASetter', but that's a
-- problem for a different workshop.
--
-- @listOfUsers & traversed . likesDogs .~ True@
(.~) :: Traversal' s a -> a -> s -> s
l .~ x = set l x

-- | Note this /is/ type-changing, but polymorphism prevents me from writing
-- 'Traversal s t a b' here. In reality, it ought to be 'ATraversal', but
-- that's a problem for a different workshop.
--
-- @listOfUsers & traversed . age %~ \x -> x + 1@
(%~) :: Traversal' s a -> (a -> a) -> s -> s
l %~ x = over l x

-- You'll more than likely only see these on your travels, but know there are
-- many more. What if I want to add something to the target of an optic? Well,
-- you could use '(+~)'. Monoidally append some value? '(<>~)'. Change
-- someone's name /and/ get the old name at the same time? '(<<.~)'. Whether
-- you use these is a question of empathy for your teammates and collaborators,
-- though.



-- At first glance, optics are quite magical. We use the same "value" to get
-- /and/ set, and we can compose with normal function composition! So, we can
-- do some reverse engineering. If we know they compose with function
-- composition, then we know that they must be functions with "matching" input
-- and output types. We saw an example of such a function earlier:
--
--     (a -> b) -> (s -> t)
--
-- However, we said this wouldn't work because it doesn't allow us to /get/
-- data! Well, the trick here is an ever so slight change in signature:
--
--     (a -> f b) -> (s -> f t)
--
-- In situ:
--
--     type Lens s t a b = forall f. Functor f => (a -> f b) -> (s -> f t)
--     type Traversal s t a b = forall f. Applicative f => (a -> f b) -> (s -> f t)
--
-- This is quite neat: with 'Functor', we only have 'fmap', which means:
-- * First, we need to break the @s@ down into @a@ and "the rest".
-- * Then, we apply the function @a -> f b@ to @a@ to get @f b@.
-- * Then, we 'fmap' over @f b@ to add the rest back in!
--
-- Because we don't have @Applicative f@, a 'Lens' absolutely /must/ target
-- exactly one thing, or we wouldn't be able to get an @f t@ out!
-- 
-- Compare this to 'Traversal': because we can use 'pure', we can apply the
-- optic to no targets, and because we can use '(<*>)', we can apply the optic
-- to multiple targets. This is why a 'Traversal' makes a weaker assertion than
-- a 'Lens'. Interestingly, when we compose the two, we end up with:
--
--     forall f. (Functor f, Applicative f) => (a -> f b) -> (s -> f t)
--
-- Because 'Applicative', applies 'Functor', we drop the 'Functor' constraint,
-- and end up with... a 'Traversal'!
--
-- 'Prism' is a bit of an unfortunate outlier here, as there isn't such a clean
-- way to describe it in the van Laarhoven (i.e. @lens@) format. Other formats
-- exist (profunctor optics being the main one) which have cleaner definitions
-- here, and in fact the @lens@ definition borrows some of that machinery for
-- 'Prism', but we're not going to worry about that today. For now, just note
-- that all these things compose, and optic @x@ can weaken to optic @y@ if the
-- constraint on the @f@ in @x@ is implied by the constraint on @f@ in @y@.

-- EXERCISES
-- * Implement the '_1' 'Lens' by hand
-- * Implement the 'traversed' 'Traversal' by hand



-- EXERCISES
--
-- * Write an optic for the 'Metadata' type to change the description of the
--   "test" logical model to a given value.
--
-- * Write an optic for the 'Metadata' type to focus any function with a custom
--   name.
--
-- * Write equivalent functions without optics, and hopefully concede that,
--   while it might not be the easiest thing to get the hang of, it really is a
--   lot better than the alternative.