Recently I found myself needing to change a field in a record nested a couple of layers deep.
I was working with haskell-lsp messages, of which there are several flavours:
data RequestMessage m req resp = ...
data ResponseMessage a = ...
data NotificationMessage m a =
NotificationMessage { jsonrpc :: Text, method :: m, params :: a }
I wanted to change the params of the message. params is polymorphic/generic, so we don't know for certain what it's going to be. You can do this with plain old records like so:
foo :: NotificationMessage m a -> NotificationMessage m a
foo x = x { params = spiceUp (params x) }
However we've already hit our first problem. We would need to write this method for each type of message:
fooNotification :: NotificationMessage m a -> NotificationMessage m a
fooNotification x = x { params = spiceUp (params x) }
fooRequest :: RequestMessage m req resp -> RequestMessage m req resp
fooRequest x = x { params = spiceUp (params x) }
...
The implementations are entirely identical which is a painful waste and we need to declare all these functions with different names.
Thankfully, as you might expect, this common functionality of grabbing some params is abstracted to a class, the HasParams class:
class HasParams s a where
getParams :: s -> a
setParams :: a -> s -> s
instance HasParams (RequestMessage m req resp) req where
getParams = params
setParams x p = x { params = p }
instance HasParams (NotificationMessage m a) req where
getParams = params
setParams x p = x { params = p }
You may be wondering how this works when there's the duplicate record field params, but this can be remedied with the DuplicateRecordFields extension. We also need MultiParamTypeClasses. But now, we can rewrite foo to be nice and polymorphic:
foo :: HasParams s a => s -> s
foo x = setParams x (spiceUp (getParams x))
Looks good. I didn't really want the params field though, what I actually wanted was a URI field, which is nested several layers deep:
message -> params -> document -> uri
So we just need to create another class to represent types that have documents right?
instance HasDocument s where
getDocument :: s -> Document
setDocument :: s -> Document -> Document
instance HasDocument MyParams where
getDocument = document
setDocument x d = x { document = d }
Now we can chain these type class requirements together:
foo :: (HasParams a b, HasDocument b) => s -> s
foo x = setParams x newParams
where oldParams = getParams x
oldDoc = getDocument oldParams
newDoc = spiceUp oldDoc
newParams = setDocument oldParams newDoc
But as it turns out, you can have different types of documents, like versioned documents or file paths to documents, so document is polymorphic just like params. And we still need to go another layer deep to get the URI (which is also polymorphic).
instance HasDocument s d where
getDocument :: s -> d
setDocument :: s -> d -> d
instance HasUri s u where
getUri :: s -> u
setUri :: s -> u -> u
foo :: (HasParams a p, HasDocument p d, HasUri d u) => a -> a
foo x = setParams x newParams
where oldParams = getParams x
oldDoc = getDocument oldParams
oldUri = getUri oldDoc
newUri = spiceUp newUri
newDoc = setUri oldDoc newUri
newParams = setDoc oldParams newDoc
Things are starting to look a bit sad again. Not only do we have to write tons of repeated instances for each class, we also have this weird list where we change all the record fields at each level. This is where lenses come in.
Lenses
foo :: (HasParams a p, HasDocument p d, HasUri d u) => a -> a
foo x = (params . document . uri) .~ newUri $ x
where newUri = spiceUp (x ^. params . textDocument . uri)
Lenses give a natural way of accessing record fields kind of in an object-orientated dot-notation style.
The gist is this: I lied earlier, the actual definition of the messages in haskell-lsp is more like this:
{-# LANGUAGE TemplateHaskell #-}
data NotificationMessage m a =
NotificationMessage { _jsonrpc :: Text, _method :: m, _params :: a }
makeLenses ''NotificationMessage
Template Haskell provides metaprogramming (think macros on steroids - you can write code that codes code), which we makeLenses uses to automatically synthesize lenses for each field:
jsonrpc :: Simple Lens NotificationMessage Text
method :: Simple Lens NotificationMessage m
params :: Simple Lens NotificationMessage a
Simple Lens a b says that it can access type b from a. It's common enough that there's a type synonym for it, Lens'.
You can now use one of the Lens with ^. to access fields:
x ^. params
Set fields with ~.:
params ~. newParams $ x
And even chain them magically with regular function composition:
params.document.uri .~ spiceUp (x ^. params . textDocument . uri) $ x
There's a good tutorial on how the magic actually works. For now though, lets focus on making these work with our classes.
class HasParams s a where
params :: Lens' s a
class HasTextDocument s a where
textDocument :: Lens' s a
class HasUri s a where
uri :: Lens' s a
And then our datas simply conform to these types:
instance HasParams (NotificationMessage m a) a where ...
instance HasParams (RequestMessage m a) a where ...
In haskell-lsp these are also generated via Template Haskell.
But there's a slight difference, that adds an extra sprinkle of type safety.
Functional dependencies
Say we had this normal implementation of HasParams for a specific type of NotificationMessage:
class HasParams a p where
params :: a -> p
instance HasParams (NotificationMessage String Int) Int where
params (NotificationMessage _ _ p) = p
Nothing is stopping us from writing this on top of this:
instance HasParams (NotificationMessage String Int) String where
params (NotificationMessage _ m _) = m
And now we have two definitions for params. This makes no sense. Each concrete type of NotificationMessage a b should have exactly one type for params. The implementation doesn't matter, it could return something that isn't the params, just as long as its consistent.
To prevent this happening with lenses, the actual definition ends up looking like this:
{-# LANGUAGE FunctionalDependencies #-}
class HasParams s a | s -> a where
params :: Lens' s a
class HasTextDocument s a | s -> a where
textDocument :: Lens' s a
class HasUri s a | s -> a where
uri :: Lens' s a
What are these arrows doing here? These are functional dependencies. Here they say that a is determined by s. In other words, if we have an instance of HasParams:
instance HasParams (NotificationMessage String Int) Int
Then (NotificationMessage String Int) is guaranteed to always return an Int in params.
Flexible contexts
But I digress. Back to our foo function, which is actually meant to swap file URIs, we had:
swapFile :: (HasParams a b, HasTextDocument b c, HasUri c d) => a -> a
swapFile x = (params.textDocument.uri) .~ (swapUri oldUri) $ x
where oldUri = x ^. params . textDocument . uri
What could the signature of swapUri look like? Well, it has to take in the type variable d which doesn't make it very useful. swapUri should be Uri -> Uri.
Ideally HasUri should only take one type argument, and have its uri lens always return a Uri, but we're left with the type variable d instead because of how it was synthesized.
What we want to do is force this type variable to, well, not be a variable. Like this:
swapFile :: (HasParams a b, HasTextDocument b c, HasUri c Uri) => a -> a
Doing this gives us some error:
Non type-variable argument in the constraint: HasUri c Uri (Use FlexibleContexts to permit this)
In the type signature:
swapFile :: (HasParams a b, HasTextDocument b c, HasUri c Uri) => a -> a
But the error also gives us the solution - enable FlexibleContexts.
{-# LANGUAGE FlexibleContexts #-}
And just like that, we now have a safe, succint function that will work on any type that contains a uri in this configuration.
swapFile :: (HasParams a b, HasTextDocument b c, HasUri c Uri) => a -> a
swapFile x = (params.textDocument.uri) .~ (swapUri oldUri) $ x
where oldUri = x ^. params . textDocument . uri
swapUri uri = uri ++ "/extra/path"