Skip to content

Latest commit

 

History

History
423 lines (393 loc) · 9.63 KB

putting-lenses-to-work.org

File metadata and controls

423 lines (393 loc) · 9.63 KB

Putting Lenses to Work

\setbeamertemplate{footline}{} \setbeamerfont{block body}{size=\small} \definecolor{orchid}{RGB}{134, 134, 220} \setbeamercolor{block title}{fg=white,bg=orchid} \setbeamercolor{bgcolor}{fg=white,bg=blue}

Overview

Overview

  1. Lens
  2. Prism
  3. Traversal & Fold
  4. Map
  5. State
  6. Other

Introduction

  • Practical use of lenses, inspired by work
  • Applied to the right problem, they are invaluable!

Lens

Lens

Lenses address some part of a “structure” that always exists

Tuple

view (^.)

### Lens.Tuple.view.operator

view

### Lens.Tuple.view.function

Tuple

set (.~)

### Lens.Tuple.set.operator

set

### Lens.Tuple.set.function

Records

  • Possibly the least interesting use of lens
  • For shallow use, barely different from access and update syntax
  • “Distinguished products”

Records

{-# LANGUAGE TemplateHaskell #-}

module Lenses where

import Control.Lens

data Record = Record
  { _field1 :: Int
  , _field2 :: Int
  }
makeLenses ''Record

Records

view

### Lens.records.view

set

### Lens.records.set

Records

Record lenses become quite useful when structure is deep

Records

With lens

v & foo.bar.baz +~ 1

Records

Without lens

let f = _foo v
    b = _bar f
    z = _baz b in
v { _foo = f {
      _bar = b {
        _baz = z + 1 } } }

Writing lenses by hand

my_1 :: Lens' (Integer, Integer) Int
my_1 f (p1, p2) =
  (\n -> (toInteger n, p2))
    <$> f (fromIntegral p1)

my_1 :: Functor f
     => (Int -> f Int)
     -> (Integer, Integer)
     -> f (Integer, Integer)

Common operators

\begin{center} \begin{tabular}{l@{\hspace{1em}}|@{\hspace{1em}}l@{\hspace{2em}}} view & \verb|v ^. l|
set & \verb|v & l .~ x| \ (set Just) & \verb|v & l ?~ mx| \ (incr) & \verb|v & l +~ n| \ (append) & \verb|v & l <>~ x| \ (apply) & \verb|v & l %~ f| \ (applyA) & \verb|v & l %%~ f| \end{tabular} \end{center}

Prism

Prism

Prisms address some part of a “structure” that may exist

ADTs

{-# LANGUAGE TemplateHaskell #-}

module Lenses where

import Control.Lens

data ADT = Alpha Int Int
         | Beta Record
         | Gamma String

makePrisms ''ADT

ADTs

view (present)

### Lens.ADTs.preview.present

view (absent)

### Lens.ADTs.preview.absent

ADTs

set (present)

### Lens.ADTs.setter.present

set (absent)

### Lens.ADTs.setter.absent

ADTs

With lens

v & _Beta.field1 +~ 1

ADTs

Without lens

case v of
  Beta z ->
    Beta (z { _field1 = _field1 z + 1 })
  _ -> v

Writing prisms by hand

my_Left :: Prism' (Either Int Int) Int
my_Left = prism' Left $
  either Just (const Nothing)

Traversal & Fold

Traversals

Traversals address many parts of a “structure” that may exist

Collections

preview

### Traversal.List.preview

set

### Traversal.List.set

Computations

preview

### Traversal.computations.digits.preview

set

### Traversal.computations.digits.set

Computations

set (flexible)

### Traversal.computations.digits.set-flexible

Monoids

  • “Viewing” a traversal combines the elements using Monoid
  • ^.. turns each element into a singleton list, so the Monoid result is a list of the elements

Monoids

Monoid

### Traversal.List.monoid

A list of elements

### Traversal.List.toListOf

Folds

allOf

### Traversal.List.allOf

Folds

\begin{center} \small \begin{tabular}{lll} \verb|allOf| & \verb|andOf| & \verb|anyOf|
\verb|asumOf| & \verb|concatMapOf| & \verb|concatOf| \ \verb|elemOf| & \verb|findMOf| & \verb|findOf| \ \verb|firstOf| & \verb|foldMapOf| & \verb|foldOf| \ \verb|foldl1Of| & \verb|foldl1Of’| & \verb|foldlMOf| \ \verb|foldlOf| & \verb|foldlOf’| & \verb|foldr1Of| \ \verb|foldr1Of’| & \verb|foldrMOf| & \verb|foldrOf| \end{tabular} \end{center}

More Folds

\begin{center} \small \begin{tabular}{lll} \verb|foldrOf’| & \verb|forMOf_| & \verb|forOf_|
\verb|lastOf| & \verb|lengthOf| & \verb|lookupOf| \ \verb|mapMOf_| & \verb|maximumByOf| & \verb|maximumOf| \ \verb|minimumByOf| & \verb|minimumOf| & \verb|msumOf| \ \verb|noneOf| & \verb|notElemOf| & \verb|notNullOf| \ \verb|nullOf| & \verb|orOf| & \verb|productOf| \ \verb|sequenceAOf_| & \verb|sequenceOf_| & \verb|sumOf| \ \verb|toListOf| & \verb|traverseOf_| & \end{tabular} \end{center}

Vocabulary review

\begin{center} \small \begin{tabular}{l|l|l|l|l} \textbf{Class} & \textbf{Read} & \textbf{Write} & \textbf{Count} & \textbf{Example} \ \hline\hline Getter & y & & 1 & \verb|to f|
Lens & y & y & 1 & \verb|_1| \ Iso & y & y & 1 & \verb|lazy| \ \hline Prism & y? & y? & 1? & \verb|only| \ \hline Fold & y? & & 0* & \verb|folded| \ Setter & & y? & 0* & \verb|mapped| \ Traversal & y? & y? & 0* & \verb|traverse| \end{tabular} \end{center}

Common operators

\begin{center} \begin{tabular}{l@{\hspace{1em}}|@{\hspace{1em}}l@{\hspace{2em}}} toListOf & \verb|v ^.. l|
preview & \verb|v ^? l| \ (demand) & \verb|v ^?! l| \end{tabular} \end{center}

Map

Map

at (present)

### Map.at.view.present

at (absent)

### Map.at.view.absent

Map

non (present)

### Map.at.non.present

non (absent)

### Map.at.non.absent

Map

ix view (present)

### Map.ix.view.present

ix view (absent)

### Map.ix.view.absent

Map

ix view (demand)

### Map.ix.view.demand

Map

ix set (present)

### Map.ix.set.present

ix set (absent)

### Map.ix.set.absent

Map

failing

### Map.ix.view.failing

State

State

use

### State.use

uses

### State.uses

State

preuse

### State.preuse

preuses

### State.preuses

State

set

### State.set

set (monadic)

### State.setM

State

over

### State.over

State

zoom

### State.zoom

Lens

multi-set

### State.multi-set-plain

Lens

stateful multi-set

### State.multi-set

Other

We didn’t cover…

\begin{center} \small \begin{tabular}{lll} \verb|ALens| & \verb|LensLike| & \verb|Writer|
\verb|lens-action| & \verb|lens-aeson| & \verb|thyme| \ Indexed lenses & Zippers & Exceptions \ Arrays & Vectors & \verb|FilePath| \ \verb|Numeric.Lens| & & \end{tabular} \end{center}

partsOf

indices

### Advanced.partsOf.indices

partsOf

filtered

### Advanced.partsOf.filtered

partsOf

each

### Advanced.partsOf.each

partsOf

set

### Advanced.partsOf.set

partsOf

multiple

### Advanced.partsOf.multiple

ViewPatterns

lambda

### Advanced.view-patterns.lambda

biplate

strings

### Advanced.biplate.strings

biplate

ints

### Advanced.biplate.ints

biplate

chars

### Advanced.biplate.chars

biplate

with partsOf

### Advanced.biplate.partsOf

biplate

filtered

### Advanced.biplate.filtered

biplate

head

### Advanced.biplate.head

Colophon