git.iko.soy/Haskell-HSE/haskell-lectures-2024
on main help sign in
196 lines 4.7 kB history raw
1# Lenses and optics
3```haskell
4import Control.Monad.Trans.State (State, state, runState)
5import Control.Monad.Identity (Identity (..))
6```
8Lenses! Profunctor optics! Some gibberish!
10Say we have the following datatype:
12```haskell
13data Person = Person { name :: String, age :: Int }
15twan = Person { name = "Twan van Laarhoven", age = 39 }
16```
18Getting the name of a person is straightforward:
20```haskell
21twanName = name twan
22```
24Updating it is less so:
26```haskell
27twanInAYear = twan { age = age twan + 1 } -- ugly
28```
30With nested fields, this is even worse:
32```haskell
33data Paper = Paper { title :: String, author :: Person }
35inAYear :: Paper -> Paper
36inAYear paper = paper { author = (author paper) { age = age (author paper) + 1 } }
37```
39We could write setters and use them:
41```haskell
42setName :: String -> Person -> Person
43setName name person = person { name = name }
45setAge :: Int -> Person -> Person
46setAge age person = person { age = age }
48setAuthor :: Person -> Paper -> Paper
49setAuthor author paper = paper { author = author }
51twanInAYear' = setAge (age twan + 1) twan
53inAYear' :: Paper -> Paper
54inAYear' paper =
55 let nowAuthor = author paper
56 in setAuthor (setAge (age nowAuthor + 1) nowAuthor) paper
57```
59This is still cumbersome. What if we write a generic `update` function?
61```haskell
62update :: (a -> b) -> (b -> a -> a) -> (b -> b) -> (a -> a)
63update get set f x = set (f (get x)) x
65inAYear'' :: Paper -> Paper
66inAYear'' = update author setAuthor (update age setAge (+ 1))
67```
69A lot better! It would be even better if we collected these functions together
70in a single datatype:
72```haskell
73data Lens a b =
74 Lens {
75 get :: a -> b,
76 set :: b -> a -> a,
77 modify :: (b -> b) -> a -> a
78 }
80fromGetSet :: (a -> b) -> (b -> a -> a) -> Lens a b
81fromGetSet = error "TODO"
83fromGetModify :: (a -> b) -> ((b -> b) -> a -> a) -> Lens a b
84fromGetModify = error "TODO"
85```
87```haskell
88(&) :: Lens a b -> Lens b c -> Lens a c
89l & l' = Lens {
90 get = get l' . get l,
91 set = \c a -> set l (set l' c (get l a)) a,
92 modify = modify l . modify l'
93 }
95at :: Int -> Lens [a] a
96at i = Lens { get = (!! i), set = error "TODO", modify = error "TODO" }
97```
99```haskell
100type StateLens a b = forall k . State b k -> State a k
102fromLens :: Lens a b -> StateLens a b
103fromLens l s = state $ \a -> let (b, k) = runState s (get l a) in (set l b a, k)
105toLens :: StateLens a b -> Lens a b
106toLens f = Lens { get = \a -> error "TODO",
107 set = \b a -> error "TODO",
108 modify = \f a -> error "TODO"
109 }
111(&&) :: StateLens b c -> StateLens a b -> StateLens a c
112l && l' = l' . l
113```
115```haskell
116-- fmap :: (b -> c) -> (a, b) -> (a, c)
117-- ^ polymorphic (strong) update
118-- (b -> c) -> [b] -> [c]
119-- get :: (a, b) -> b
120-- get :: [b] -> ???
121```
1231. `fmap` as a datatype
1242. get capability
1253. `Lens` to be special case of such datatype
127```haskell
128type UnfoldedLens a b = forall k . (b -> (b, k)) -> a -> (a, k)
130type PolyLens s t a b = forall k . (a -> (b, k)) -> s -> (t, k)
132(&&&) :: PolyLens s t a b -> PolyLens u v s t -> PolyLens u v a b
133l &&& l' = l' . l
135mapped0 :: Functor f => PolyLens (f a) (f b) a b
136mapped0 f fa = let x = fmap f fa in error "impossible"
137```
139```haskell
140type Traversal s t a b = forall f . Applicative f => (a -> f b) -> (s -> f t)
142mapped :: Traversable g => Traversal (g a) (g b) a b
143mapped h ga = traverse h ga
145type VLLens s t a b = forall f . Functor f => (a -> f b) -> (s -> f t)
147setVL :: VLLens s t a b -> b -> s -> t
148setVL l = modifyVL l . const
150modifyVL :: VLLens s t a b -> (a -> b) -> s -> t
151modifyVL l f = runIdentity . l (Identity . f)
153newtype Const k a = Const { runConst :: k } deriving Functor
155getVL :: VLLens s t a b -> s -> a
156getVL l = runConst . l Const
158lens :: (s -> a) -> (b -> s -> t) -> VLLens s t a b
159lens get set f s = fmap (`set` s) (f (get s))
160```
162Above: lens
164Below:
166```haskell
167data Prism a b = Prism { down :: a -> Maybe b, up :: b -> a }
169toLensP :: Prism a b -> Lens a (Maybe b)
170toLensP p = Lens { get = down p, set = \m a -> case m of { Nothing -> a, Just b -> up b }, modify = error "TODO" }
172fromLens :: Lens a (Maybe b) -> Prism a b
173fromLens l = Prism { down = get l, up b = set l b (error "Impossible") }
174```
176```haskell
177type Optic p s t a b = p a b -> p s t
179-- fmap :: Optic (->) (f a) (f b) a b
180-- fold :: Monoid m => (a -> m) -> (f a -> m) = Optic (->) (f a) m a m
181-- traverse :: Applicative f => (a -> f b) -> t a -> f (t b) = ...
183class Contravariant f where
184 dimap :: (b -> a) -> f a -> f b
186class Profunctor p where
187 pmap :: (a -> b) -> (c -> d) -> p b c -> p a d
189type OLens = forall p . Profunctor p => Optic p
191type OPrism = ...
193type OIso = ...
194```
196Above: profunctor-optics