# Линзы

## Как часто с вами случалось это?

``````
data Point = Point {x :: Int, y :: Int}
data Unit = Unit {pos :: Point, health :: Int}
data Game = Game {player :: Unit}
``````

## Как часто с вами случалось это?

``````
data Point = Point {x :: Int, y :: Int}
data Unit = Unit {pos :: Point, health :: Int}
data Game = Game {player :: Unit}

updatePlayerX game newX = newGame
where
newPos = (pos.player \$ game) {x = newX}
newPlayer = (player game) {pos = newPos}
newGame = game {player = newPlayer}
``````

## А это?

``````
case class Point(x: Int, y: Int)
case class Unit(pos: Point, health: Int)
case class Game(player: Unit)

val newGame = game.copy(
player = game.player.copy(
pos = game.player.pos.copy(
x = newX
)
)
)
``````

## А, может, это?

``````
-record(point, {x :: integer(), y :: integer()}).
-record(unit,  {pos :: point(), health :: integer()}).
-record(game,  {player :: unit()}).

NewPos = Game#game.player#player.pos#point{x = NewX},
NewPlayer = Game#game.player#player{pos = NewPos},
NewGame = Game#game{player = NewPlayer}.
``````

## Подсказка для тех, кто не в теме

``````
struct point {int x; int y;};
struct unit {point pos; int health;};
struct game {unit player;};

game.player.pos.x = new_x;
``````

## Глубина глубин

• Геттеры компонуются
• Сеттеры не компонуются
• Компонуются пары геттер+сеттер

## Первый подход

``````
data Lens s a = Lens
{ view :: s -> a
, set :: a -> s -> s }
``````

## Первый подход

``````
healthLens :: Lens Unit Int
healthLens = Lens health (\a s -> s { health = a })
``````

## Первый подход

``````
λ> let p = Player { health = 10, pos = Point 1 2 }
λ> set healthLens 100 p
Player {pos = Point {x = 1, y = 2}, health = 100}
``````

## Первый подход

``````
over :: (a -> a) -> s -> s

...

λ> let p = Player { health = 10, pos = Point 1 2 }
λ> over healthLens (+10) p
Player {pos = Point {x = 1, y = 2}, health = 20}
``````

## Первый подход

``````
healthLens :: Lens Unit Int
healthLens = Lens health
(\a s -> s { health = a })
(\f s -> s { health = f (health s) })
``````

## Первый подход

``````
data Lens s a = Lens
{ view :: s -> a
, over :: (a -> a) -> s -> s }

set :: Lens s a -> a -> s -> s
set l a s = over l (const a) s
``````

## Улучшаем линзы

``````
data Lens s a = Lens
{ view :: s -> a
, over :: (a -> a) -> s -> s
, overIO :: (a -> IO a) -> s -> IO s }
``````

## Время обобщать

``````
overF :: Functor f => (a -> f a) -> s -> f s
``````

На самом деле это всё, что нужно

## Настоящая линза

``````
type Lens s a = Functor f => (a -> f a) -> s -> f s
``````

Не забудьте RankNTypes

## Придумываем over

``````
over :: Lens s a -> (a -> a) -> s -> s
over l f s = _
``````

## Придумываем over

``````
over :: (Functor f => (a -> f a) -> (s -> f s)) ->
(a -> a) -> s -> s
over l f s = _
``````

## Волшебный Identity

``````
newtype Identity a = Identity { runIdentity :: a }

instance Functor Identity where
fmap f (Identity a) = Identity (f a)
``````

## Придумываем over дальше

``````
over :: (Functor f => (a -> f a) -> (s -> f s)) ->
(a -> a) -> s -> s
over l f s = _ \$ l (Identity . f)
``````

Теперь наша дыра имеет тип (s -> f s) -> s

## Придумываем over дальше

``````
over :: (Functor f => (a -> f a) -> (s -> f s)) ->
(a -> a) -> s -> s
over l f s = runIdentity \$ l (Identity . f) s
``````

## Сложности с view

• Тип линзы (a -> f a) -> s -> f s
• А нужен тип s -> a

## Functors to the rescue

``````
newtype Const a b = Const { getConst :: a }

instance Functor (Const a) where
fmap _ (Const a) = Const a
``````

## Functors to the rescue

``````
λ> let boolBox = fmap (&& False) (Const "hello")
λ> :t boolBox
Const [Char] Bool
λ> getConst boolBox
"hello"
λ> getConst \$ fmap (\_ -> 1.2 :: Double) boolBox
"hello"
``````

## view

``````
view :: Lens s a -> s -> a
view l s = _ \$ l Const
``````

Type hole: (s -> f s) -> a

## view

``````
view :: Lens s a -> s -> a
view l s = _ \$ l Const s
``````

Type hole: f s -> a

## Финальный view

``````
view :: Lens s a -> s -> a
view l s = getConst \$ l Const s
``````

## Линза для health

``````
healthLens :: Lens Unit Int
healthLens f unit =
fmap
(\newHealth -> unit { health = newHealth })
(f (health unit))
``````

## Заветная цель

``````
λ> let g = Game \$ Unit {pos = Pos 100 200, health = 345}
λ> view (playerLens.posLens) g

Pos {x = 100, y = 200}

λ> over (playerLens.posLens.xLens) (+344) g

Game {player = Unit
{ pos = Pos {x = 444, y = 200}
, health = 345}}
``````

## Вишенка

``````
infixr 9 .~
(.~) :: s -> Lens s a -> (a -> a) -> s
(.~) s l = (flip (over l)) s

...

λ> g.~playerLens.posLens.xLens \$ (+344)

Game {player = Unit
{ pos = Pos {x = 444, y = 200}
, health = 345}}
``````