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 :: Lens s a -> (a -> a) -> s -> s
over l f s = _
over :: (Functor f => (a -> f a) -> (s -> f s)) ->
(a -> a) -> s -> s
over l f s = _
newtype Identity a = Identity { runIdentity :: a }
instance Functor Identity where
fmap f (Identity a) = Identity (f a)
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 :: (Functor f => (a -> f a) -> (s -> f s)) ->
(a -> a) -> s -> s
over l f s = runIdentity $ l (Identity . f) s
newtype Const a b = Const { getConst :: a }
instance Functor (Const a) where
fmap _ (Const a) = Const a
λ> let boolBox = fmap (&& False) (Const "hello")
λ> :t boolBox
Const [Char] Bool
λ> getConst boolBox
"hello"
λ> getConst $ fmap (\_ -> 1.2 :: Double) boolBox
"hello"
view :: Lens s a -> s -> a
view l s = _ $ l Const
Type hole: (s -> f s) -> a
view :: Lens s a -> s -> a
view l s = _ $ l Const s
Type hole: f s -> a
view :: Lens s a -> s -> a
view l s = getConst $ l Const s
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}}