posts/lens.md

   1 ---
   2 title: 🔭 Lenses and extensions
   3 date: 2018-06-12
   4 ---
   5
   6 Recently I found myself needing to change a field in a record nested a couple of layers deep.
   7 I was working with `haskell-lsp` messages, of which there are several flavours:
   8
   9 ```haskell
  10 data RequestMessage m req resp = ...
  11 data ResponseMessage a = ...
  12 data NotificationMessage m a =
  13   NotificationMessage { jsonrpc :: Text, method :: m, params :: a }
  14 ```
  15
  16 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:
  17
  18 ```haskell
  19 foo :: NotificationMessage m a -> NotificationMessage m a
  20 foo x = x { params = spiceUp (params x) }
  21 ```
  22
  23 However we've already hit our first problem. We would need to write this method for each type of message:
  24
  25 ```haskell
  26
  27 fooNotification :: NotificationMessage m a -> NotificationMessage m a
  28 fooNotification x = x { params = spiceUp (params x) }
  29
  30 fooRequest :: RequestMessage m req resp -> RequestMessage m req resp
  31 fooRequest x = x { params = spiceUp (params x) }
  32
  33 ...
  34 ```
  35
  36 The implementations are entirely identical which is a painful waste and we need to declare all these functions with different names.
  37 Thankfully, as you might expect, this common functionality of grabbing some `params` is abstracted to a class, the `HasParams` class:
  38
  39 ```haskell
  40 class HasParams s a where
  41   getParams :: s -> a
  42   setParams :: a -> s -> s
  43
  44 instance HasParams (RequestMessage m req resp) req where
  45   getParams = params
  46   setParams x p = x { params = p }
  47
  48 instance HasParams (NotificationMessage m a) req where
  49   getParams = params
  50   setParams x p = x { params = p }
  51 ```
  52
  53 You may be wondering how this works when there's the duplicate record field params, but this can be remedied with the [DuplicateRecordFields](https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields) extension.
  54 We also need [MultiParamTypeClasses](https://ghc.haskell.org/trac/haskell-prime/wiki/MultiParamTypeClasses).
  55 But now, we can rewrite foo to be nice and polymorphic:
  56
  57 ```haskell
  58 foo :: HasParams s a => s -> s
  59 foo x = setParams x (spiceUp (getParams x))
  60 ```
  61
  62 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:
  63
  64 ```
  65 message -> params -> document -> uri
  66 ```
  67
  68 So we just need to create another class to represent types that have documents right?
  69
  70 ```haskell
  71 instance HasDocument s where
  72   getDocument :: s -> Document
  73   setDocument :: s -> Document -> Document
  74
  75 instance HasDocument MyParams where
  76   getDocument = document
  77   setDocument x d = x { document = d }
  78 ```
  79
  80 Now we can chain these type class requirements together:
  81
  82 ```haskell
  83 foo :: (HasParams a b, HasDocument b) => s -> s
  84 foo x = setParams x newParams
  85   where oldParams = getParams x
  86         oldDoc    = getDocument oldParams
  87         newDoc    = spiceUp oldDoc
  88         newParams = setDocument oldParams newDoc
  89 ```
  90
  91 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).
  92
  93 ```haskell
  94 instance HasDocument s d where
  95   getDocument :: s -> d
  96   setDocument :: s -> d -> d
  97
  98 instance HasUri s u where
  99   getUri :: s -> u
 100   setUri :: s -> u -> u
 101
 102 foo :: (HasParams a p, HasDocument p d, HasUri d u) => a -> a
 103 foo x = setParams x newParams
 104   where oldParams = getParams x
 105         oldDoc    = getDocument oldParams
 106         oldUri    = getUri oldDoc
 107         newUri    = spiceUp newUri
 108         newDoc    = setUri oldDoc newUri
 109         newParams = setDoc oldParams newDoc
 110 ```
 111
 112 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.
 113
 114 ## Lenses
 115
 116 ```haskell
 117 foo :: (HasParams a p, HasDocument p d, HasUri d u) => a -> a
 118 foo x = (params . document . uri) .~ newUri $ x
 119   where newUri = spiceUp (x ^. params . textDocument . uri)
 120 ```
 121
 122 Lenses give a natural way of accessing record fields kind of in an object-orientated dot-notation style.
 123 The gist is this: I lied earlier, the actual definition of the messages in `haskell-lsp` is more like this:
 124
 125 ```haskell
 126 {-# LANGUAGE TemplateHaskell #-}
 127 data NotificationMessage m a =
 128   NotificationMessage { _jsonrpc :: Text, _method :: m, _params :: a }
 129 makeLenses ''NotificationMessage
 130 ```
 131
 132 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:
 133
 134 ```haskell
 135 jsonrpc :: Simple Lens NotificationMessage Text
 136 method :: Simple Lens NotificationMessage m
 137 params :: Simple Lens NotificationMessage a
 138 ```
 139
 140 `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'`.
 141 You can now use one of the `Lens` with `^.` to access fields:
 142
 143 ```haskell
 144 x ^. params
 145 ```
 146
 147 Set fields with `~.`:
 148
 149 ```haskell
 150 params ~. newParams $ x
 151 ```
 152
 153 And even chain them magically with regular function composition:
 154
 155 ```haskell
 156 params.document.uri .~ spiceUp (x ^. params . textDocument . uri) $ x
 157 ```
 158
 159 There's a good tutorial on how [the magic actually works](https://hackage.haskell.org/package/lens-tutorial-1.0.1/docs/Control-Lens-Tutorial.html). For now though, lets focus on making these work with our classes.
 160
 161 ```haskell
 162 class HasParams s a where
 163   params :: Lens' s a
 164 class HasTextDocument s a where
 165   textDocument :: Lens' s a
 166 class HasUri s a where
 167   uri :: Lens' s a
 168 ```
 169
 170 And then our `data`s simply conform to these types:
 171
 172 ```haskell
 173 instance HasParams (NotificationMessage m a) a where ...
 174 instance HasParams (RequestMessage m a) a where ...
 175 ```
 176
 177 In `haskell-lsp` these are also generated via [Template Haskell](https://artyom.me/lens-over-tea-6).
 178 But there's a slight difference, that adds an extra sprinkle of type safety.
 179
 180 ## Functional dependencies
 181
 182 Say we had this normal implementation of `HasParams` for a specific type of `NotificationMessage`:
 183
 184 ```haskell
 185 class HasParams a p where
 186   params :: a -> p
 187
 188 instance HasParams (NotificationMessage String Int) Int where
 189   params (NotificationMessage _ _ p) = p
 190 ```
 191
 192 Nothing is stopping us from writing this on top of this:
 193
 194 ```haskell
 195 instance HasParams (NotificationMessage String Int) String where
 196   params (NotificationMessage _ m _) = m
 197 ```
 198
 199 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.
 200
 201 To prevent this happening with lenses, the actual definition ends up looking like this:
 202
 203 ```haskell
 204 {-# LANGUAGE FunctionalDependencies #-}
 205 class HasParams s a | s -> a where
 206   params :: Lens' s a
 207 class HasTextDocument s a | s -> a where
 208   textDocument :: Lens' s a
 209 class HasUri s a | s -> a where
 210   uri :: Lens' s a
 211 ```
 212
 213 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`:
 214
 215 ```haskell
 216 instance HasParams (NotificationMessage String Int) Int
 217 ```
 218
 219 Then `(NotificationMessage String Int)` is guaranteed to always return an `Int` in `params`.
 220
 221 ## Flexible contexts
 222
 223 But I digress. Back to our `foo` function, which is actually meant to swap file URIs, we had:
 224
 225 ```haskell
 226 swapFile :: (HasParams a b, HasTextDocument b c, HasUri c d) => a -> a
 227 swapFile x = (params.textDocument.uri) .~ (swapUri oldUri) $ x
 228   where oldUri = x ^. params . textDocument . uri
 229 ```
 230
 231 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`.
 232
 233 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.
 234
 235 What we want to do is force this type variable to, well, not be a variable. Like this:
 236
 237 ```haskell
 238 swapFile :: (HasParams a b, HasTextDocument b c, HasUri c Uri) => a -> a
 239 ```
 240
 241 Doing this gives us some error:
 242
 243 > Non type-variable argument in the constraint: HasUri c Uri (Use FlexibleContexts to permit this)
 244 > In the type signature:
 245 > swapFile :: (HasParams a b, HasTextDocument b c, HasUri c Uri) => a -> a
 246
 247 But the error also gives us the solution - enable FlexibleContexts.
 248
 249 ```haskell
 250 {-# LANGUAGE FlexibleContexts #-}
 251 ```
 252
 253 And just like that, we now have a safe, succint function that will work on any type that contains a uri in this configuration.
 254
 255 ```haskell
 256 swapFile :: (HasParams a b, HasTextDocument b c, HasUri c Uri) => a -> a
 257 swapFile x = (params.textDocument.uri) .~ (swapUri oldUri) $ x
 258   where oldUri = x ^. params . textDocument . uri
 259         swapUri uri = uri ++ "/extra/path"
 260 ```