Saturday, May 4, 2013

Program imperatively using Haskell lenses

Haskell gets a lot of flack because it has no built-in support for state and mutation. Consequently, if we want to bake a stateful apple pie in Haskell we must first create a whole universe of stateful operations. However, this principled approach has paid off and now Haskell programmers enjoy more elegant, concise, and powerful imperative code than you can find even in self-described imperative languages.


Lenses


Your ticket to elegant code is the lens library. You define your data types as usual, but you prefix each field with an underscore. For example, I can define a Game:
data Game = Game
    { _score :: Int
    , _units :: [Unit]
    , _boss  :: Unit
    } deriving (Show)
... full of Units:
data Unit = Unit
    { _health   :: Int
    , _position :: Point
    } deriving (Show)
... whose locations are represented by Points:
data Point = Point
    { _x :: Double
    , _y :: Double
    } deriving (Show)
We prefix these fields with an underscore because we will not be using them directly. Instead, we will use them to build lenses, which are much more pleasant to work with.

We can build these lenses in two ways. Our first option is to define lenses manually using the lens convenience function from Control.Lens. For example, we can define a score lens to replace the _score field accessor:
import Control.Lens

score :: Lens' Game Int
score = lens _score (\game v -> game { _score = v })
A Lens is like a map which you use to navigate complex data types. We use the above score lens to navigate from our Game type to its _score field.

The type reflects where we begin and end: Lens' Game Int means we must begin on a value of type Game and end on a value of type Int (the score, in this case). Similarly, our other lenses will clearly indicate their starting and ending points in their types:
units :: Lens' Game [Unit]
units = lens _units (\game v -> game { _units = v })

boss :: Lens' Game Unit
boss = lens _boss (\game v -> game { _boss = v })

health :: Lens' Unit Int
health = lens _health (\unit v -> unit { _health = v })

position :: Lens' Unit Point
position = lens _position (\unit v -> unit { _position = v })

x :: Lens' Point Double
x = lens _x (\point v -> point { _x = v })

y :: Lens' Point Double
y = lens _y (\point v -> point { _y = v })
However, we don't have to write out all this boilerplate if we're lazy. Our second option is to use Template Haskell to define all these lenses for us:
{-# LANGUAGE TemplateHaskell #-}

import Control.Lens

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

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

data Point = Point
    { _x :: Double
    , _y :: Double
    } deriving (Show)

makeLenses ''Game
makeLenses ''Unit
makeLenses ''Point
Just remember that Template Haskell requires these makeLenses declarations to go after your data types.


Initial State


The next thing we need is a test initial game state:
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 }
            }
        , Unit
            { _health = 8
            , _position = Point { _x = 0.0, _y = 2.1 }
            }
        ]
    , _boss = Unit
        { _health = 100
        , _position = Point { _x = 0.0, _y = 0.0 }
        }
    }
We've enlisted three valiant heroes to slay the dungeon boss. Let the battle begin!


First Steps


Now we can use our lenses! Let's create a routine for our warriors to strike at the boss:
import Control.Monad.Trans.Class
import Control.Monad.Trans.State

strike :: StateT Game IO ()
strike = do
    lift $ putStrLn "*shink*"
    boss.health -= 10
strike prints an evocative sound to the console, then decrements the boss's health by 10 hit points.

strike's type indicates that it operates within the StateT Game IO monad. You can think of this as a DSL where we layer our pure game state (i.e. StateT Game) on top of side effects (i.e. IO) so that we can both mutate our game and also print cute battle effects to the console. All you have to remember is that any time we need side effects, we will use lift to invoke them.

We'll test out strike in ghci. In order to run strike, we must supply it with an initialState:
>>> execStateT strike initialState 
*shink*
Game {_score = 0, _units = [Unit {_health = 10, _position = Poin
t {_x = 3.5, _y = 7.0}},Unit {_health = 15, _position = Point {_
x = 1.0, _y = 1.0}},Unit {_health = 8, _position = Point {_x = 0
.0, _y = 2.1}}], _boss = Unit {_health = 90, _position = Point {
_x = 0.0, _y = 0.0}}}
execStateT takes our stateful code and an initial state, and then runs that code to produce a new state. ghci automatically shows the return value as a convenience so we can inspect the newly returned state. The output is a bit of a mess, but if you strain your eyes you can see that the boss now only has 90 health.

We can view this more easily by storing the new state in a variable:
>>> newState <- execStateT strike initialState 
*shink*
... and then we can query newState for the part we actually care about:
>>> newState^.boss.health
90

Composition


This syntax very strongly resembles imperative and object-oriented programming:
boss.health -= 10
What is going on here? Haskell is decidely not a multi-paradigm language, yet we have what appears to be multi-paradigm code.

Amazingly, nothing on that line is a built-in language feature!
  • boss and health are just the lenses we defined above
  • (-=) is an infix function
  • (.) is function composition from the Haskell Prelude!
Wait, (.) is function composition? Really?

This is where the lens magic comes in. Lenses are actually ordinary functions, and our "multi-paradigm" code is actually functions all the way down!

In fact, Lens' a b is actually a type synonym for a certain type of higher-order function:
type Lens' a b =
    forall f . (Functor f) => (b -> f b) -> (a -> f a)
You don't need to understand the details of that. Just remember that Lens' a b is a higher-order function that accepts a function of type (b -> f b) as an argument, and returns a new function of type (a -> f a). The Functor part is the theoretically-inspired "magic".

Armed with that knowledge, let's make sure the types check out by expanding out the Lens' type synonyms for boss and health
boss :: Lens' Game Unit
-- expands to:
boss :: (Functor f) => (Unit -> f Unit) -> (Game -> f Game)

health :: Lens' Unit Int
-- expands to:
health :: (Functor f) => (Int -> f Int) -> (Unit -> f Unit)
Now let's review the definition of function composition:
(.) :: (b -> c) -> (a -> b) -> (a -> c)
(f . g) x = f (g x)
Notice that if we specialize our type variables to:
a ~ (Int  -> f Int)
b ~ (Unit -> f Unit)
c ~ (Game -> f Game)
... then this has exactly the right type to compose our two lenses:
(.) :: ((Unit -> f Unit) -> (Game -> f Game))
    -> ((Int  -> f Int ) -> (Unit -> f Unit))
    -> ((Int  -> f Int ) -> (Game -> f Game))
If we put the Lens' type synonyms back in, we get:
(.) :: Lens' Game Unit -> Lens' Unit Int -> Lens' Game Int

boss . health :: Lens' Game Int
So function composition is also lens composition! In fact, lenses form a category where (.) is the category's composition operator and the identity function id is also the identity lens:
(.) :: Lens' x y -> Lens' y z -> Lens' x z

id  :: Lens' x x
What's so beautiful about this is that Haskell lets us remove the spaces around the function composition operator so that it looks exactly like object-oriented accessor notation!

Categories make it really easy to connect and group components on the fly. For example, if I anticipate that I will be modifying the Boss's health frequently, I can just define a composite lens:
bossHP :: Lens' Game Int
bossHP = boss.health
... and now I can use it wherever I previously used boss.health:
strike :: StateT Game IO ()
strike = do
    lift $ putStrLn "*shink*"
    bossHP -= 10
... or similarly use it as an accessor:
>>> newState^.bossHP
90

Traversals


Lenses are grounded in some really elegant theory, and as a result they get a lot of things right that imperative languages normally don't!

For example, let's say that our boss is a dragon and breathes fire, which damages all heroes. Using lenses, I can decrement the entire party's health using a single instruction:
fireBreath :: StateT Game IO ()
fireBreath = do
    lift $ putStrLn "*rawr*"
    units.traversed.health -= 3
This makes use of a new lens!
traversed :: Traversal' [a] a
traversed lets us "dig in" to the values in a list so that we can manipulate them as a single unit instead of manually looping over the list. However, this time the type is a Traversal' instead of a Lens'.

A Traversal is a like a Lens' except weaker:
type Traversal' a b =
    forall f . (Applicative f) => (b -> f b) -> (a -> f a)
If you compose Lens' with a Traversal', you get the weaker of the two: a Traversal'. This works no matter which order you compose them in:
(.) :: Lens' a b -> Traversal' b c -> Traversal' a c

(.) :: Traversal' a b -> Lens' b c -> Traversal' a c
units                  :: Lens'      Game [Unit]
units.traversed        :: Traversal' Game  Unit
units.traversed.health :: Traversal' Game  Int
In fact, we don't need to figure this out. The compiler will infer the correct type all by itself:
>>> :t units.traversed.health
units.traversed.health
  :: Applicative f =>
     (Int -> f Int) -> Game -> f Game
That's exactly the right type to be a Traversal' Game Int!

Actually, why not just compose these lenses into a single lens:
partyHP :: Traversal' Game Int
partyHP = units.traversed.health

fireBreath :: StateT Game IO ()
fireBreath = do
    lift $ putStrLn "*rawr*"
    partyHP -= 3
Let's also use partyHP lens to retrieve the new party hitpoints:
>>> newState <- execStateT fireBreath initialState 
*rawr*
>>> newState^.partyHP

<interactive>:3:11:
    No instance for (Data.Monoid.Monoid Int)
      arising from a use of `partyHP'
    Possible fix:
      add an instance declaration for (Data.Monoid.Monoid Int)
    In the second argument of `(^.)', namely `partyHP'
    In the expression: newState ^. partyHP
    In an equation for `it': it = newState ^. partyHP
Oops! This is a type error because there is no single health to get! This is why a Traversal' is weaker than a Lens': traversals may point to multiple values, so they do not support a well-defined way to get just one value. The type system saved us from a potential bug!

Instead, we must specify that we actually want a list of values using the toListOf function:
toListOf :: Traversal' a b -> a -> [b]
This gives the desired result:
>>> toListOf partyHP newState 
[7,12,5]
... and there's an infix operator equivalent to toListOf: (^..):
>>> initialState^..partyHP
[10,15,8]
>>> newState^..partyHP
[7,12,5]
Now we can clearly see at a glance that fireBreath worked the way we intended.

Now I want to get really fancy. I want to define a traversal over a geographic area. Can I do that?
around :: Point -> Double -> Traversal' Unit Unit
around center radius = filtered (\unit ->
    (unit^.position.x - center^.x)^2
  + (unit^.position.y - center^.y)^2
  < radius^2 )
Sure I can! Now I can limit the dragon's fire breath to a circular area!

Edit: filtered is apparently not a theoretically valid traversal because it does not preserve the number of elements. See this /r/haskell thread for details.
fireBreath :: Point -> StateT Game IO ()
fireBreath target = do
    lift $ putStrLn "*rawr*"
    units.traversed.(around target 1.0).health -= 3
Notice how expressive that code is: we want to decrement the health of all units around the target. That code conveys our intention much more clearly than the equivalent mainstream imperative code and it leaves much less room for error.

Anyway, back to breathing fire. First, let's see where the units are located:
> initialState^..units.traversed.position
[Point {_x = 3.5, _y = 7.0},Point {_x = 1.0, _y = 1.0},Point {_x
 = 0.0, _y = 2.1}]
Hmmm, the latter two units are close by, so I will aim the fireball in between them:
>>> newState <- execStateT (fireBreath (Point 0.5 1.5)) initialState 
*rawr*
>>> (initialState^..partyHP, newState^..partyHP)
([10,15,8],[10,12,5])
Nailed it!


Zooming


We can do more unique things with lenses, like zoom in on subsets of our global state:
retreat :: StateT Game IO ()
retreat = do
    lift $ putStrLn "Retreat!"
    zoom (units.traversed.position) $ do
        x += 10
        y += 10
As before, we can combine these lenses into a single lens if we want to reuse it later on:
partyLoc :: Traversal' Game Point
partyLoc = units.traversed.position

retreat :: StateT Game IO ()
retreat = do
    lift $ putStrLn "Retreat!"
    zoom partyLoc $ do
        x += 10
        y += 10
Let's try it out:
>>> initialState^..partyLoc
[Point {_x = 3.5, _y = 7.0},Point {_x = 1.0, _y = 1.0},Point {_x
 = 0.0, _y = 2.1}]
>>> newState <- execStateT retreat initialState 
Retreat!
>>> newState^..partyLoc
[Point {_x = 13.5, _y = 17.0},Point {_x = 11.0, _y = 11.0},Point
 {_x = 10.0, _y = 12.1}]
Let's look at the type of zoom in the context of this particular example:
zoom :: Traversal a b -> StateT b IO r -> StateT a IO r
zoom has some nice theoretical properties. For example, we'd expect that if we zoom using two successive lenses, it should behave the same as zooming using the composite lens:
zoom lens1 . zoom lens2 = zoom (lens1 . lens2)
... and if we zoom in on the empty lens, we end up back where we started:
zoom id = id
In other words, zoom defines a functor, and those equations are the functor laws!


Combining commands


So far I've only shown a single command at a time, but now let's take all of these concepts and imperatively assemble a battle from them:
battle :: StateT Game IO ()
battle = do
    -- Charge!
    forM_ ["Take that!", "and that!", "and that!"] $ \taunt -> do
        lift $ putStrLn taunt
        strike

    -- The dragon awakes!
    fireBreath (Point 0.5 1.5)
    
    replicateM_ 3 $ do
        -- The better part of valor
        retreat

        -- Boss chases them
        zoom (boss.position) $ do
            x += 10
            y += 10
Let's try it out!
>>> execStateT battle initialState 
Take that!
*shink*
and that!
*shink*
and that!
*shink*
*rawr*
Retreat!
Retreat!
Retreat!
Game {_score = 0, _units = [Unit {_health = 10, _position = Poin
t {_x = 33.5, _y = 37.0}},Unit {_health = 12, _position = Point 
{_x = 31.0, _y = 31.0}},Unit {_health = 5, _position = Point {_x
 = 30.0, _y = 32.1}}], _boss = Unit {_health = 70, _position = P
oint {_x = 30.0, _y = 30.0}}}
I guess people really aren't joking when they say Haskell is the finest imperative language.


Conclusions


This really just scratches the surface of the lens library, which is one of the crown jewels of the Haskell ecosystem. You can use lenses for pure programming, too, and compress very powerful and complex computations into very readable and elegant code. When I have more time I will write even more about this amazing library.

45 comments:

  1. Excellent article! But "This really just scratches the surface of the lens library" -- uggggh!

    ReplyDelete
    Replies
    1. Ha, I actually didn't even realize that was a pun!

      Delete
  2. Note: the actual limited use of `filtered` that you are making here is perfectly fine.

    The criterion you are filtering on isn't affected by the action you are taking.

    ReplyDelete
    Replies
    1. To expand on this, the subexpression (around target 1.0) is an outlaw traversal, but larger subexpression ((around target 1.0).health) is a valid traversal, so in that sense there is nothing wrong with your code. Because the target and health are disjoint lenses, the danger of around has been diffused, and this is almost always how the filter function ends up being used in practice.

      There is a lawful way to write this sort of program (i.e. so that all lensy subexpressions are law abiding) but it is so awkward t do that I cannot realistically recommend it. What I personally might do instead is rewrite around so the the code ends up instead as (around target 1.0 health) and while this isn't technically any safer, at least there is a place in the precondition for the around function for me to comment that the two lens arguments must be disjoint lenses.

      Delete
  3. lens seem to be pure. i don’t get it in this case. where is new /old state stored?

    ReplyDelete
    Replies
    1. The stateful lens operators all use `StateT` to access old state and store new state updates. The pure equivalents of these operators (such as `(+~)`) can be used as ordinary functions, such as:

      (_1 +~ 2) (3, 4) == (5, 4)

      Delete
  4. Hello, Gabriel.
    When I just started learning Haskell at 2010 there was obvious (to me) that the main library for doing IO right way is the pipes of You (because of its simplicity and beauty).
    The other main library for working with records of data was/is lens of Edward.
    Since that year I've read a lot of Haskell books (and papers), but still far away from the full understanding of all the details of the mentioned libs.
    I don't want to hurry/rush, just want to say that learning Haskell is really challenging and completely refactors the way my mind works solving programming problems.
    Suddenly I realized, that spent a lot of time before (2010) to gain enouth imperative-experience in order to be able to quickly learn the next imperative language just for a month or so without problems.
    But, with Haskell the situation is different - it is a complete paradigm shift (I was not given any mention about FP in my University and started learn it at the already mentioned year).
    Of cause, learning FP brought to my attention a lot of interesting libs for Java/C++/JS which I use at work, but still [almost except Clojure] have no any experience with Haskell.

    What I dream of ???
    At the beginning of learning C++ I gave a wonderful book of Bjarne and found a lot of usefull stuff that changed my mind about programming from it. Then there was other good books, but Stroustroup's one is actual even today.
    In Haskell the situation is different - the language and ecosystem is much more dynamic/evolving. The really important stuff is usually spread across small articles, blogs, mail-threads.
    So, my dream here is to have (some day) detailed books about the 2 mentioned libraries, which will be really helpful.
    Of cause, I know that the best learning about pipes is, probably, your tutorial. I started reading it slowly several month ago, but, by the end - you've already released the next version of the pipes and I'm going to start reading it from scrach again soon.

    My questions are:
    - What can you suggest about lens ?
    - What is your experience with FP/Haskell, how did you come to doing the stuff you do ?

    ReplyDelete
    Replies
    1. I'll split this into two comments because it is long:

      I plan on writing a Haskell programming book once I finish my PhD so that you won't have to comb over blog posts and mailing threads to learn these things.

      The `pipes` API is pretty stable at this point. Most of the research right now is in the derived libraries like `pipes-parse`. The only thing that has really changed since version 3.0 is how to do folds.

      Right now there are no real good lens tutorials. That's why I wrote this tutorial to try to fill in the gaps.

      My experience in programming in Haskell is as a graduate student in bioinformatics. I actually began programming in C, but my professor kept changing the requirements of my projects every few days, and I could not keep up with him using C because it has really brittle support for data structures and it is very vulnerable to bugs when developing really rapidly.

      At that time I sort of understood Haskell a little bit so I decided I wasn't going to get any better until I actually dived in tried to write an entire project using Haskell. So I forced myself to switch to Haskell and rewrote the entire project in Haskell. It took a week to switch the code base over to Haskell, but it was worth it. Once I figured out what I was doing the increase in productivity from using Haskell was very large and now I'm almost done with my degree.

      There are several things that greatly increase productivity when programming in Haskell.

      First, the strong type system catches mistakes very well. This increases you productivity in multiple ways because:

      (A) You spend MUCH less time fixing bugs and maintaining old code

      (B) You spend MUCH less time writing tests (the type system is like having lots and lots of unit tests for free)

      (C) You can refactor much more easily, which means that you become MUCH braver about exploring alternative approaches to an algorithm or adding new features. It's much easier to say "Yes" to your boss when you have a strong type system because adding new features rarely breaks existing code.

      Also, Haskell does not have implicit ANYTHING (i.e. no implicit state, no implicit error handling, no implicit side effects), which makes it very easy to read code and understand existing code. This helps a lot when I have to go back and read my old code after not working on a particular section for a month or two because I need very little context to understand what a given code segment does. Contrast this with other languages where the logic for any feature is spread out all over the code base and it often takes half an hour or more to load all the little bits into your mind's cache before you can begin working on it.

      Delete
    2. Another feature of programming in Haskell is that it forces you to do things the right way the first time. It strongly discourages you from doing the lazy or hacky thing, so the code you write lasts for a while without any modifications. This is also the reason why people say that Haskell makes you a better programmer, because it forces you to learn the right way of doing everything and you take that with you when you program in other languages. This is true not just for programming style, but also for algorithms and design patterns. Haskell libraries generally feature the state of the art in computer science because the community is top notch, so by programming in Haskell you learn the state of the art very quickly.

      Lastly, Haskell permits a very high level of abstraction. When I was translating my C base to Haskell code, I would have C code that was 300 lines long become a 15-liner in Haskell. This makes it significantly easier to reason about the code and find logical mistakes. Generally I find that the strong type system catches all the low-level bugs, and the high-level of abstraction catches all the high-level "business logic" bugs.

      My recommendation for you is that if you are interested in Haskell then set aside the time to complete an entire hobby project in Haskell from start to finish. You will learn much faster this way. The moment I actually forced myself to code difficult projects in Haskell was when my proficiency with the language increased very rapidly.

      Delete
    3. Thank you, Gabriel, very much for the really informative and motivating answer.
      I clearly understand that there are no other way learning something (Haskell, C++, Java, even car driving) without practice.
      Of cause, that's not so easy to find a time for doing some real [hobby] project since I'm a full-time software developer and have to do my day-to-day work mostly in C++/JS/Java(with one little utility in Clojure).
      But, from time to time, there are some small periods of free time, small tasks that could be done not-for-production (like testing data generation using templates, parsing and analyzing logs and so on). Usually I try distinct tools for doing this job (from R-statistics to AWK, batch scrips, Ruby and even Haskell). What I'm planning to do is - to start using Haskell more extensively here in order to "FORM a HABIT".
      Reading books/articles/blogs about Haskell is already such my habit (and I'm not going to give it up).
      I even created a small tex/pdf presentation about Haskell fundamentals (motivated by the series of posts about Monads using Kleisli-category by Mike Vanier, who is definitely have a talent of explaining things) in 2011 and presented it 3 times since then (and hope to do it 4-th).
      But, this is just an exception. I like reading much more than writing and, probably, not going to write more about haskell before understand it better myself.

      Thank you, Gabriel, again and best wishes.

      Delete
    4. You're welcome! Also, I'm glad that you take the time to teach others! There is no better time to teach than when the solution is fresh on your mind after having learned it the first time.

      Delete
    5. That is exactly what my teacher of math-analysis told me in 2011. We are still communicating with him weekly even after 10 years since my graduation. That was, frankly speaking, his idea for me to prepare such talk about Haskell and monads. Unfortunately, the fist time I presented it to more than a hundred of his first-second year students, I felt that no one follows me after half an hour. But later, when I gave the same talk to my colleagues at work - everything went well (they were able to keep a track of things).

      Delete
  5. "it has no built-in support for state and mutation"

    Haskell has great support for state and mutation, through monads. http://www.yellosoft.us/5min/

    ReplyDelete
    Replies
    1. Yeah. I meant more from the library side. Monads are fantastic! :)

      Delete
  6. This comment has been removed by the author.

    ReplyDelete
  7. Hi Gabriel,

    I was wondering if you knew of any easy way to make new infix functions in the form of (-=). Something for strings would be neat. I've had a look at how (-=) is defined here: ( http://hackage.haskell.org/packages/archive/lens/3.9.0.2/doc/html/src/Control-Lens-Setter.html ) but I got stuck trying to make "State.modify" work.

    Cheers,
    Anthony

    ReplyDelete
    Replies
    1. Yeah, I do. If you can explain what you want your new function to do I can walk you through how you would derive the implementation using lenses. Also, Lens already has a modify-like infix function called `%=` at:

      http://hackage.haskell.org/packages/archive/lens/3.9.0.2/doc/html/Control-Lens-Setter.html#v:-37--61-

      Delete
    2. Thanks, Gabriel. :)

      The function (%=) works well. Say I wanted to do something like:

      testString %= (++ testSuffix)

      It works, but it might be clearer if it were something like

      testString ++= testSuffix

      If the point is for it to look more like imperative code, it's worth considering that the traditional imperative code would be something like:

      testString = testString ++ testSuffix

      Anyway, how would one define (++=) as above?

      In any case (%=) seems pretty versatile, so would you recommend just using that and living with the "lens %= function" syntax?

      Delete
    3. You can write:

      testString ++= suffix = testString %= (++ suffix)

      ... and that will do what you asked for.

      Delete
    4. Oh. I didn't think about pattern matching it. That's embarrassing. Thanks again. :)

      Delete
    5. Just one more question:

      If I have this

      first :: a -> a -> a
      first x y = x

      and then I do this

      xLens %= (first x)

      This captures assignment. Then I can make a more natural infix version of this:

      xLens +=+ x = xLens %= (first x)

      I know (+=+) is a silly thing to call assignment, I've just run out of symbols. Is there some other operator which already does this? It seems like an appropriate thing to have kicking around. Unless there's some problem with this kind of approach that I'm not seeing.

      Delete
    6. What you described is the .= operator:

      xLens .= x

      ... which is equivalent to:

      xLens %= (\_ -> x)

      The `first` function you described exists in the Prelude and is known as `const`:

      const :: a -> b -> a
      const a b = a

      Delete
    7. Cheers, (.=) makes sense, I'll do that. :)

      Delete
  8. Gabriel, Thanks for this tutorial. I started learning Haskell last year and after about 80 project Euler problems, I thought that Haskell was the greatest language ever. Then I decided to start writing a nosql db in haskell and my enthusiasm was diminishing rapidly until I saw this tutorial which clearly explained lens.
    Most haskell tutorials I have seen use examples that take as much effort to understand as the concepts they are trying to teach. Your example did not get in the way of the concepts that you were teaching making it one of the best I have seen in the Haskell world. I wish that others would copy you. I intend to if I get good enough to write something usefull.

    ReplyDelete
    Replies
    1. Thank you! I really appreciate that!

      Let me advise you of one thing: don't wait until you are good enough to start writing tutorials, too. This is the mistake that every Haskell programmer makes and the reason why there are no good Haskell tutorials! :)

      You should make a habit of writing from the beginning, because if you don't exercise that skill early on you won't be able to write well when you become expert. The whole reason I got better at tutorials is that I practiced doing so even while I was a beginner. I would just submit everything I wrote to /r/haskell and they would tear it apart week after week. At first I would get defensive and be a bit ashamed, but after doing this over and over again and learning from their criticisms my writing style and skills improved.

      Also, writing will help improve your own understanding of the language. Nothing teaches yourself better than teaching others.

      Delete
  9. Just another "Thank you for this article" from me ... made me start using lenses :)

    ReplyDelete
  10. Great post!
    Don't forget your book, your write looks very nice to read!!!!

    ReplyDelete
    Replies
    1. Thank you!

      I haven't forgotten about the book at all. A lot of these blog posts are practice for the book, except the book will be more detailed.

      Delete
  11. This is a really fantastic tutorial. Now I can start using lenses right away without having to have spent hours learning the theory behind them. It's amazing that these imperative-like constructs have been built using purely functional concepts, such as functors. Though it looks like there is some serious Haskell wizardry going on under the covers. If this library catches on, it could deeply impact how we write Haskell, especially when we deal with nested record data types (and perhaps in many other ways, too; I'm still very new to all this).
    Thank you so much. I really hope you write a book.
    If you know of similar tutorials that show how to use other combinators, let me know. I'd also like to know if there are other neat tricks in addition to "traversed" and "zoom".

    ReplyDelete
    Replies
    1. Yes. I totally agree that it makes working with nested record data types so much easier.

      I'm definitely writing up a book once I finish my thesis (really soon).

      For additional tricks and example, consult the lens wiki on the Github repository here:

      https://github.com/ekmett/lens/wiki/_pages

      A good start is this page:

      https://github.com/ekmett/lens/wiki/Examples

      ... and also check out the examples directory:

      https://github.com/ekmett/lens/tree/master/examples

      Delete
    2. Thanks for your reply! I'll check out the links.

      Delete
  12. First off, a very great article. I had a lot to learn about this. I am curious however, that how can you use the lift function before defining what it is? i.e. you have't declared (StateT Game) an instance of class MonadTrans t. It is only when you define it as an instance, then you provide the implementation for the lift method. Is this somehow done automatically? Did I miss something?

    ReplyDelete
    Replies
    1. `StateT` already implements the `MonadTrans` type class. The `transformers` library that we get `StateT` from also provides this `MonadTrans` instance for `StateT`. You can find the code in this module:

      http://hackage.haskell.org/package/transformers-0.3.0.0/docs/src/Control-Monad-Trans-State-Lazy.html

      That module is in turn re-exported by `Control.Monad.Trans.State`, which is why that `MonadTrans` instance was in scope.

      Delete
  13. Gabriel, thanks a lot for this fantastic tutorial. Could you please also write another one showing how to use uniplate/biplate generics using the lens package?

    ReplyDelete
    Replies
    1. I do have a lens tutorial for the pure lend operations and I will throw in uniplate/biplate.

      Delete
    2. Could you please point me to the tutorial you have in mind?

      Delete
    3. Sorry, I meant to say that I had begun writing the tutorial but it is not complete yet.

      Delete
  14. Great article. But is there any way to do something like this?

    strike :: StateT Game IO ()
    strike = do
    lift $ putStrLn "*shink*"
    boss.health -= player.damage

    assuming we have defined

    data Player = Player {_health, _damage :: Int }

    and included it in the Game record?

    ReplyDelete
    Replies
    1. Using existing operators, you would have to do this:

      d <- use (player.damage)
      boss.health .= d

      However, there is nothing preventing you from defining your own operator for this purpose:

      l1 -== l2 = do
      d <- use l1
      l1 .= l2

      Delete
  15. How can this be used with https://github.com/ekmett/structs ?

    ReplyDelete
    Replies
    1. My understanding is that you can use lenses for this but you pay an efficiency price when they refer to mutable references. You can use them, but you usually end up having to touch the mutable reference twice for every lens-based operation.

      Delete
  16. This is very cool, your blog is always very easy to read.

    Now I wonder, all your "actions" are of Type Game -> Game, effectively meaning that an action like (fireBreath) is issued by the game world, and not the Boss.

    Now I'm curious if it's possible like you would in C++ or similar, to assign specific actions to your units, This means that a Unit has control of itself, and you could effectively isolate off illogical actions, like the players using fireBreath, (or in more complicated situations, like requiring a spell book, before you can cast a spell from it!)

    An interesting situation is that in a multiplayer game someone might try to manipulate network packets, to modify what kind of attack the player is issuing, if all attacks are part of the world, its theoretical that a player (without runtime checks) could issue a spell he does not have. (For example, spells would have a global Enum value, instead of the boss and player having their own Enums)

    ReplyDelete
  17. Gabriel, thanks for this fantastic write up!

    Inspired from your blog post I have ported all your Haskell code into PureScript to get a better understanding of using states and lenses in PureScript: https://github.com/sectore/program-imperatively-using-purescript

    It is just fun :)

    -Jens

    ReplyDelete