Lens Examples

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
{-# LANGUAGE TemplateHaskell, Rank2Types #-}

import Control.Applicative
import Control.Lens
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
import Data.Traversable
import Safe hiding (at)

data Game = Game
    { _score :: Int
    , _units :: [Unit]
    , _boss  :: Unit
    } deriving (Show)

-- eachUnit :: Traversal' Game Unit
eachUnit :: (Applicative f) => (Unit -> f Unit) -> (Game -> f Game)
eachUnit f (Game n us b) = fmap (\us' -> Game n us' b) (traverse f us)

data Unit = Unit
    { _health   :: Int
    , _position :: Point
    } deriving (Show)

data Point = Point
    { _x :: Double
    , _y :: Double
    } deriving (Show)
makeLenses ''Unit
makeLenses ''Game
makeLenses ''Point

initialState :: Game
initialState = Game
    { _score = 0
    , _units =
        [ Unit { _health = 10, _position = Point { _x = 3.5, _y = 7.0 } }
        , Unit { _health = 15, _position = Point { _x = 1.0, _y = 1.0 } }
        ]
    , _boss = Unit { _health = 100, _position = Point { _x = 0.0, _y = 0.0 } }
    }

-- Change 'game1' to other games to test them out
main = evalStateT game1 initialState

-- Let's start off with your original question
game1 :: StateT Game IO ()
game1 = do
    s1 <- use score  -- Retrieve the current value of 'score'
    lift $ print s1  -- Outputs: 0

    score += 10      -- Update 'score' using imperative syntax

    s2 <- use score  -- Retrieve the updated value of 'score'
    lift $ print s2  -- Outputs: 10

-- Technically, you asked to define an incrementScore function
incrementScore :: (Monad m) => StateT Game m ()
incrementScore = score += 10

game2 :: StateT Game IO ()
game2 = do
    incrementScore
    incrementScore
    s <- use score
    lift $ print s  -- Outputs: 20

-- We can copy some other C tricks, too
game3 :: StateT Game IO ()
game3 = do
    s <- score <+= 10  -- Return the assigned value, like C does
    lift $ print s

-- Accessor syntax works
game4 :: StateT Game IO ()
game4 = do
    boss.health     .= 5  -- '=' is reserved, so we use '.=' instead
    boss.position.x .= 5  -- Accessors work any number of layers deep
    boss.position.y .= 6  -- Fun fact: the '.' is actually function composition
    b <- use boss
    lift $ print b

-- This is where things start getting cool
game5 :: StateT Game IO ()
game5 = do
    eachUnit.health     -= 1  -- Decrement each unit's health
    eachUnit.position.x .= 0  -- Set each unit's x position to 0
    us <- use units
    lift $ print us

-- Helper function that lets us combine two lenses into one
pair :: Lens' a b -> Lens' a c -> Lens' a (b, c)
pair l1 l2 = lens
    (\a -> (view l1 a, view l2 a))
    (\a (b, c) -> (set l1 b . set l2 c) a)

-- Work with things simultaneously
game6 :: StateT Game IO ()
game6 = do
    pair (boss.health) score .= (999, 10)  -- Set two things at once
    game <- get                            -- Equivalent to 'use id'
    lift $ print game

-- Zoom in on local part of the state
game7 :: StateT Game IO ()
game7 = do
    zoom boss $ do
        position.x .= 50.4
        health     .= -20
    zoom eachUnit $ do
        health     .= 999
    game <- get
    lift $ print game

-- We can even zoom in on individual units
game8 :: StateT Game IO ()
game8 = do
    zoom (elementOf eachUnit 0) $ do  -- zoom in on the 1st unit
        health .= 0
        unit <- get  -- This will return the unit we zoomed in on
        lift $ print unit

-- Work with a subset of units
game9 :: StateT Game IO ()
game9 = do
    (taking 1 eachUnit.health) .= 100  -- Would have been a better example
    us <- use units                    -- if I made more than 2 units
    lift $ print us

-- Fold data
game10 :: StateT Game IO ()
game10 = do
    xs <- gets (toListOf (eachUnit.position.x))
    lift $ print xs
17:32: Warning: Redundant bracket
Found:
(Unit -> f Unit) -> (Game -> f Game)
Why not:
(Unit -> f Unit) -> Game -> f Game
94:6: Warning: Use &&&
Found:
\ a -> (view l1 a, view l2 a)
Why not:
view l1 Control.Arrow.&&& view l2
110:21: Error: Redundant do
Found:
do health .= 999
Why not:
health .= 999
117:9: Error: Redundant do
Found:
do zoom (elementOf eachUnit 0) $
do health .= 0
unit <- get
lift $ print unit
Why not:
zoom (elementOf eachUnit 0) $
do health .= 0
unit <- get
lift $ print unit