Exercises for understanding lenses

April 25, 2019
« Previous post   Next post »

No matter how many blog posts and tutorials I read about lenses, it seems like there's no replacement for just using them to get an intuition. So here are some exercises I came up with. While they shouldn't be all that difficult, they build up from some basic knowledge about lenses up to the more advanced usages of the lens library.

Perhaps you've dabbled with lenses before, but got scared away by the complexity and size of the Control.Lens documentation. Maybe you can do some basic things with lenses but want to know how far you can push their capabilities. These exercises assume that you already have a vague idea of what lenses do and what they're used for, but perhaps that you need a little bit of reinforcement to really "get" it.

This isn't meant as a lens tutorial. Prerequisites are some basic knowledge of how to use Haskell, GHCI, and familiarity of the idea of lenses, if not the specifics.

For these exercises, you can use GHCI to check your answers. Boot up an REPL with stack repl --package lens and import Control.Lens.

Lenses

The basic operators here are ^., .~, and %~. If you're not a fan of funny-looking operators, Control.Lens provides more helpfully-named functions called view, set, and over (a.k.a. mapping); these three operators are just aliases for the named functions, respectively. For these exercises, we'll be using the operators.

Assume that we have the following datatypes:

{-# LANGUAGE TemplateHaskell #-}

import Data.Text
import Control.Lens

data User = User
  { _name     :: Text
  , _userid   :: Int
  , _metadata :: UserInfo
  }
  deriving (Show)

data UserInfo = UserInfo
  { _numLogins     :: Int
  , _associatedIPs :: [Text]
  }
  deriving (Show)

makeLenses ''User
makeLenses ''UserInfo

If you're not familiar with the makeLenses ''User part, we're using Template Haskell to automatically write lenses for each of the fields in User. So for instance, we'd have lenses called name, userid, and metadata (i.e. without the leading underscore) to access the data inside a User.

I.

Given the following data:

user1 = User
  { _name = "qiao.yifan"
  , _userid = 103
  , _metadata = UserInfo
    { _numLogins = 20
    , _associatedIPs =
      [ "52.39.193.61"
      , "52.39.193.75"
      ]
    }
  }

What do the following expressions return?

  1.    user1 ^. name
  2.    user1 ^. metadata.numLogins
  3.    user1 & metadata.numLogins .~ 0
  4.    user1 & metadata.associatedIPs %~ ("192.168.0.2" :)
  5.    metadata.numLogins %~ (+ 1) $ user1

II.

Look at the following expressions. Given the same data, which expressions will compile and run successfully? For the ones that don't, can you fix them so that they do work?

  1.    user1 & email .~ "qyifan@xingxin.com"
  2.    user1 & metadata .~ (UserInfo 17 [])
  3.    userid .~ -1 $ user1
  4.    metadata.associatedIPs .~ [ "50.193.0.23" ] & user1
  5.    user1 ^. numLogins.metadata

III.

Given the same data, write an expression using the lens operators to produce the specified effect.

  1. Get the associated IP addresses.
  2. Update the user so that the associated IP addresses are in reverse order.
  3. Update the user so that each word in the name is capitalized.
  4. Set the number of logins to 1.
  5. Remove all associated IP addresses except the first.

IV.

The basic Lens type is defined like so:

type Lens s t a b =
  forall f. Functor f => (a -> f b) -> s -> f t

This looks slightly weird, but the idea is that whichever operator we use can select a particular Functor f to get different behavior out of the lens itself. So for instance, the setting operator (.~) takes in a lens with a (simplified) type of:

(a -> Identity b) -> s -> Identity t

Knowing this,

  1. Implement the simplified version of (.~) below.

    infixr 4 .~
    (.~) :: ((a -> Identity b) -> s -> Identity t)
         -> b
         -> s
         -> t

    If you haven't seen Identity before, here's the Haddock documentation.

    You should be able to use your own implementation in place of (.~) and get the same results as some of the exercises above.

  2. Implement the simplified version of (%~) below.

    infixr 4 %~
    (%~) :: ((a -> Identity b) -> s -> Identity t)
         -> (a -> b)
         -> s
         -> t

    Again, you should be able to use your own implementation as a drop-in replacement for (%~).

  3. Instead of Identity, the getting operator (^.) uses Const, taking lenses like this:

    (a -> Const a b) -> s -> Const a t

    If you haven't seen Const before, here's the Haddock documentation.

    Implement the simplified version of (^.) below.

    infixl 8 ^.
    (^.) :: s
         -> ((a -> Const a b) -> s -> Const a t)
         -> a

    Once you have an implementation, you know the drill.

  4. Implement the name lens for User. That is, implement the following function:

    name' :: Functor f => (Text -> f Text) -> User -> f User

    Now try using it with the lens operators.

  5. Look at the type of a Lens again. Why do lenses compose left-to-right, instead of right-to-left, the way "normal" functions in Haskell do?

Prisms

Whereas you use Lenses to access data that is always going to be there, Prisms are used to access data that may or may not be there. The basic operator to get data here is (^?), instead of (^.). The setting operators are unchanged; if the data isn't there, the containing structure is just returned unchanged. (You can use (^.) with Prisms, but it requires a Monoid instance for the returned type; if the data isn't there, (^.) will just return mempty. Personally I think this behavior is confusing and try to avoid it. But it's important to know about.)

We'll use JSON data to look at Prisms, along with the JSON lenses from lens-aeson.

The most important Prism here is key, which lets us access a property on JSON object, which may or may not exist.

-- stack repl --package lens --package aeson \
--   --package lens-aeson --package aeson-qq

user1 = [aesonQQ|
  {
    "name": "qiao.yifan",
    "email": "qyifan@xingxin.com"
  }
|]

user2 = [aesonQQ|
  {
    "name": "ye.xiu",
    "metadata": {
      "num_logins": 27
    }
  }
|]

I.

Given the above data, what do the following expressions return? For example, if we have the expression

user1 ^? key "metadata".key "num_logins"._Integer

it will return Nothing. Using the same Prism on user2 will return Just 27.

  1.    user1 ^? key "email"._String
  2.    user2 ^? key "email"._String
  3.    user2 ^. key "email"._String

    Remember, Prisms can be used with (^.), it just requires a Monoid.

  4.    user2 ^? key "metadata".key "associated_ips"._Array
  5.    user2 ^. key "metadata".key "associated_ips"._Array
  6. Pure functions can be lifted into Getters using to.

    import qualified Data.Text as Text
    
    user1 ^? key "name"._String.to Text.toUpper
  7.    user1 & key "name"._String .~ "su.mucheng"
  8.    user2 & key "email"._String .~ "yxiu@xingxin.com"
  9.    user2 & key "name"._String %~ Text.reverse

II.

Look at the following expressions. Given the same data, which expressions will compile and run successfully? For the ones that don't, can you fix them so that they do work?

  1.    user2 ^. key "metadata".key "num_logins"._Integer
  2.    user1 & key "metadata".key "num_logins"._Integer .~ 25
  3.    user2 & key "metadata".key "num_logins" %~ (+ 1)
  4.    user1 ^. key "email"
  5.    user2 & key "name"._String .~ 50

III.

The signature of a Prism is very similar to the signature for a Lens, but with an Applicative constraint instead of a Functor constraint. Here's a simplified version of the Prism type alongside Lens:

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

type Lens s t a b =
  forall f. Functor f => (a -> f b) -> s -> f t
  1. Implement the simplified version of (^?) below.

    infixl 8 ^?
    (^?) :: s
         -> ((a -> Const (First a) b) -> s -> Const (First a) t)
         -> Maybe a

    Once you have an implementation, you know the drill.

  2. Control.Lens provides a prism called _Just for accessing a Maybe. Implement the simplified version of _Just below:

    _Just :: Applicative f => (a -> f b) -> Maybe a -> f (Maybe b)

    Now try it with the prism operator.

    (Hint: take a look at traverse.)

  3. Do your implementations of (.~) and (%~) from the Lenses section work on Prisms as well?

Folds and traversals

While Lenses and Prisms already give us a lot of convenience in working with data, the lens package actually gives us some more general tools in the form of Folds and Traversals. Where Lenses/Prisms are "pointers" to a single location in the data, Folds and Traversals instead point to many locations. In other words, you can use them to get a list of data.

This also means that any Lens or Prism is also a valid Fold or Traversal, since lists of zero or just one element(s) are just as valid as those with many.

While Folds are basically read-only and don't allow you to modify the passed-in data the way Lenses and Prisms do, Traversals allow you to modify all the pointed-to locations at once. Since these optics correspond to the capabilities of the Foldable and Traversable typeclasses, using these optics also allows you to, say, foldl, foldr, or foldMap over every element pointed to by a Fold, or traverse/sequenceA over all the elements pointed to by a Traversal.

The basic getting operator here is (^..), which gives back a list of all the pointed-to elements. Again, this is just an alias for toListOf, if you're not a fan of funky operators. The setting operators still work as usual on Traversals.

For folding, lens provides foldlOf, foldrOf, and foldMapOf, which behave analogously to their counterparts in Data.Foldable, but which use all the pointed-to elements rather than an explicit sequence. Since every Traversal is a Fold, you can use these basic functions on both. If you do have a Traversal, you then get access to some more basic functions, traverseOf and sequenceAOf, which again behave analogously to their counterparts in Data.Traversable.

If you have an optic that points to a Foldable/Traversable, you can compose them with folded/traversed optics to fold/traverse over each element.

We'll continue using JSON data for this part.

Assume that we have the following data:

users = [aesonQQ|
  {
    "users": [
      {
        "name": "qiao.yifan",
        "email": "qyifan@xingxin.com",
        "metadata": {
          "num_logins": 5
        }
      },
      {
        "name": "ye.xiu",
        "metadata": {
          "num_logins": 27,
          "associated_ips": [
            "52.49.1.233",
            "52.49.1.234"
          ]
        }
      },
      {
        "name": "su.mucheng",
        "email": "smucheng@xingxin.com",
        "metadata": {
          "associated_ips": [
            "51.2.244.193"
          ]
        }
      }
    ]
  }
|]

I.

What do the following expressions return? For example,

users ^.. key "users".values.key "name"._String

would return ["qiao.yifan", "ye.xiu", "su.mucheng"].

  1.    users ^.. key "users".values.key "email"._String
  2.    users ^.. key "users"._Array.traversed.key "email"._String
  3.    users ^.. key "users"._Array.folded.key "email"._String
  4. Pay attention to the operator.

    users ^. key "users".values.key "name"._String
  5. import qualified Data.Text as Text
    
    users & key "users".values.key "name"._String %~ Text.toUpper
  6.    users
       ^..key "users"
         .values
         .key "metadata"
         .key "associated_ips"
         ._Array
  7.    users
       ^..key "users"
         .values
         .key "metadata"
         .key "associated_ips"
         .values
         ._String
  8.    users &
         foldlOf
           (key "users".values.key "metadata".key "num_logins"._Integer)
           (+)
           0
  9. import Data.Monoid
    import qualified Data.Text as Text
    
    users &
      foldMapOf
        (key "users"._Array.folded.key "name"._String)
        (\x -> Any $ Text.length x <= 8)

II.

What do the following expressions return, and what side effects do they have, if any?

For example,

import Data.Text

users &
  traverseOf
    (key "users".values.key "name"._String)
    (\x -> print x *> fmap pack getLine)

would, for each username, print it out and prompt you for a replacement name, then return an IO containing the JSON with the updated names.

  1. import Data.IORef
    
    do ref <- newIORef 0
       users &
         traverseOf
           (key "users"
             ._Array
             .traversed
             .key "metadata"
             .key "num_logins"
             ._Integer)
           (\x -> modifyIORef' ref (+x) *> readIORef ref)
  2. import qualified Data.Text as Text
    import qualified Data.Text.IO as Text
    
    users &
      traverseOf
        (key "users".values.key "email"._String)
        (\x -> Text.putStrLn x *> pure (Text.reverse x))
  3. Assume that we have the following function:

    getAliasMay :: Text -> Maybe Text
    getAliasMay "ye.xiu" = Just "ye.qiu"
    getAliasMay _        = Nothing

    What does the following expression return?

    users &
      traverseOf
        (key "users".values.key "name"._String)
        getAliasMay
  4. What if we redefine getAliasMay this way?

    getAliasMay :: Text -> Maybe Text
    getAliasMay "ye.xiu" = Just "ye.qiu"
    getAliasMay x        = Just x

III.

Using folds/traversals, write an expression to do the following.

  1. Get all usernames with a 'u' in them.
  2. Figure out whether any users have the IP 51.2.244.193.
  3. Print out all the associated IP addresses. (You might want to use traverseOf_ instead of traverseOf.)
  4. Reimplement exercise I.8 (summing up the total logins), but using foldMap.
  5. Prompt the user for a prefix, and prepend said prefix to every username.

IV.

Look at the following expressions. Given the same data, which expressions will compile and run successfully? For the ones that don't, can you fix them so that they do work?

  1.    users & key "users"._Array.folded.key "name"._String .~ "<unknown>"
  2.    users & key "users"._Array.traversed.key "name"._String .~ "<unknown>"
  3.    users & key "users".values.key "email" %~ (<> ".cn")
  4. import Data.Monoid
    
    users &
      foldMapOf
        (key "users".values.key "metadata".key "num_logins")
        (\x -> All $ x > 1)
  5.    users ^.. key "users".traversed.key "metadata"

V.

If you've gotten this far, congratulations! You already know far more about using lenses than most. It's time once again to implement some of the basic functions to understand them. And again, once you have a working implementation, you know the drill: try using them in place of the ones from Control.Lens.

  1. Implement the simplified version of (^..) below:

    infixl 8 ^..
    (^..) :: s
          -> ((a -> Const (Endo [a]) b) -> s -> Const (Endo [a]) t)
          -> [a]

    If you haven't seen Endo before, here the Haddock documentation. Basically, it's a monoid on functions using function composition as the binary operator.

  2. Implement the simplified version of sequenceAOf below:

    sequenceAOf :: ((f b -> f b) -> s -> f t) -> s -> f t
  3. Implement the simplified version of traverseOf below:

    traverseOf :: ((a -> f b) -> s -> f t) -> (a -> f b) -> s -> f t
  4. Implement a function that composes with a lens that returns a list, and produces a traversal over the elements of the list. That is, implement this type signature:

    traversed :: Applicative f => (a -> f b) -> [a] -> f [b]

    Does this function look familiar?

  5. Do your implementations of (.~) and (%~) from the Lenses section still work on Traversals? What about (^?)?

Fancier operators

One last trick that lens has up its sleeve is the "fancy setting" operators. Analogous to the += operator in imperative languages, lens has +~:

λ> Just 4 & _Just +~ 20
>>> Just 24

As you'd expect, there are similar operators for other common updates:

  • +~

  • -~

  • *~

  • //~ — division; not /~, unfortunately

  • ^~, ^^~, **~ — different forms of exponentiation, equivalent to ^, ^^, and **

  • &&~, ||~

  • <>~ — monoidal update, i.e. <> or mappend. Sadly, this requires a Monoid constraint, not a Semigroup. Note that the value you provide is mappended to the right.

    λ> greeting = "Hello" :: Text
    λ> greeting & id <>~ "!!"
    >>> "Hello!!"

Note that these can be used alongside prisms and traversals as well.

λ> [2.0, 4.0, 6.0, 8.0] & traversed //~ 2.0
>>> [1.0, 2.0, 3.0, 4.0]

The pattern here is that the tilde signifies that this is a setting operator, while the specific operation is before the tilde. (A period is kind of a "basic" operator, as in (^.) and (.~).)

There are also operators that allow you to get the "old" and "new" values after an update.

λ> (20, "hello") & _1 <*~ 2
>>> (40, (40, "hello"))
λ> (20, "hello") & _1 <<*~ 2
>>> (20, (40, "hello"))

These are useful since you're often working with deeply nested data with lenses.

Here, a single < before the operator signifies that it returns the updated value, while a double << signifies that it returns the old value. This gets a little weird with the monoidal operator; <<>~ returns the updated value, not the old one, since one of the angle brackets is from the mappend.

Note that the old/new value operators only work with lenses, not with prisms or traversals, since with prisms or traversals, there's no guarantee that there is a value to return at all. (Once again, if you accidentally use these with prisms/traversals, it will use the Monoid instance, if available, to combine available values. This is probably not what you want.)

We'll reuse the data from the Lenses and Folds/Traversals sections.

{-# LANGUAGE TemplateHaskell #-}

import Data.Text

data User = User
  { _name     :: Text
  , _userid   :: Int
  , _metadata :: UserInfo
  }
  deriving (Show)

data UserInfo = UserInfo
  { _numLogins     :: Int
  , _associatedIPs :: [Text]
  }
  deriving (Show)

makeLenses ''User
makeLenses ''UserInfo

user1 = User
  { _name = "qiao.yifan"
  , _userid = 103
  , _metadata = UserInfo
    { _numLogins = 20
    , _associatedIPs =
      [ "52.39.193.61"
      , "52.39.193.75"
      ]
    }
  }

users = [aesonQQ|
  {
    "users": [
      {
        "name": "qiao.yifan",
        "email": "qyifan@xingxin.com",
        "metadata": {
          "num_logins": 5
        }
      },
      {
        "name": "ye.xiu",
        "metadata": {
          "num_logins": 27,
          "associated_ips": [
            "52.49.1.233",
            "52.49.1.234"
          ]
        }
      },
      {
        "name": "su.mucheng",
        "email": "smucheng@xingxin.com",
        "metadata": {
          "associated_ips": [
            "51.2.244.193"
          ]
        }
      }
    ]
  }
|]

I.

Given the above data, what do the following expressions return? For example,

user1 & metadata.associatedIPs <<<>~ ["127.0.0.1"]

would return

(["52.39.193.61", "52.39.193.75"], <updated json>)
  1.    user1 & metadata.numLogins +~ 1
  2.    users & key "users".values.key "name"._String <>~ ".test"
  3.    users & key "users".values.key "name"._String <<>~ ".test"

    Remember, the <* and <<* operators require a Monoid constraint for prisms and traversals.

  4.    user1 & userid ^~ 2

II.

Look at the following expressions. Given the above data, which of the expressions compile and run successfully? For the ones that don't, can you fix them so that they do?

  1.    users & key "users".values.key "name" <>~ ".dev"
  2.    user1 & metadata.numLogins //~ 2
  3.    users & key "users".values.key "metadata".key "num_logins" +~ 1
  4.    user1 & userid *~ 4

III.

Last set of exercises. Implement:

  1.    infixr 4 <<>~
       (<<>~) :: Monoid a
              => ((a -> (a, a)) -> s -> (a, t))
              -> a
              -> s
              -> (a, t)
  2.    infixr 4 <<<>~
       (<<<>~) :: Monoid a
               => ((a -> (a, a)) -> s -> (a, t))
               -> a
               -> s
               -> (a, t)
  3. Implement a version of (<<>~) that mappends to the left instead of the right.

If you've managed to get through all of those exercises successfully, congrats! You've got some serious chops. At this point, you should hopefully know enough about how lenses work to do a lot of productive stuff beyond just simple data access.

While this set of exercises should show you how to use lenses, and hopefully a little bit of why, frankly it's hard to know when to use lenses. Specifically, when not to use lenses; lens is a very complicated library that introduces both a lot of dependencies and a lot of cognitive overhead. It doesn't help that the type errors are pretty awful if you get your lenses wrong. Adding lens to every single project is probably not a good default; ask yourself whether you really need it before adding it in.

If you're looking for a smaller lens package without the massive dependency tree, take a look at microlens; it still provides the lens operators up to folds/traversals and some of the </<< variants, but without requiring you to compile a hundred Hackage packages.

What are you using lenses for? Did lenses allow you easily solve a thorny problem in your project? Talk to me!


You might also like

« Previous post   Next post »

Before you close that tab...