Usage of lens for concise update of records

Question

I'm new to Haskell. I'm developing a game-like simulation. I try to use lenses to update the state of the world.

Current iteration of code works, but looks clumsy. I am trying to improve it, e.g. I would like to:

1. Get rid of direct enumeration of q1 and so on, with usage of quantityPolymorph and others in them. Problem is that partial application won't help since the function which gets applied is "in the middle" of arguments;
2. Get rid of incrementQuantity. I'd like something like fmap (+1), but since Quantity is not an instance of Functor, I can't do that. I can't make Quantity an instance because it has kind *. Is there a more concise way, w/o lambda?
3. Update world with just lenses, if possible. It looks like simple dispatching and I think it might be possible to move away from direct specification of what lens (i.e. quantityPolymorpth) should be called for which argument (f).

Important note: however the updateWorld never emits Nothing at the moment, I want to keep it returning a Maybe because later at some point it will return Nothings as well.

How can I refactor my code? Are there other things amiss with it?

The source follows.

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TemplateHaskell #-}

import Control.Lens
import Control.Monad
import System.Random

data Quantity = Quantity Integer deriving (Show)

instance Random Quantity where
    randomR (Quantity lo, Quantity hi) g =
        let rand = randomR (lo, hi) g
            (r, g1) = rand
        in (Quantity r, g1)
    random g =
        let rand = random g
            (r, g1) = rand
        in (Quantity r, g1)

instance Eq Quantity where
    (==) (Quantity q1) (Quantity q2) = q1 == q2

instance Ord Quantity where
    (<=) (Quantity q1) (Quantity q2) = q1 <= q2

instance Num Quantity where
    (+) (Quantity q1) (Quantity q2) = Quantity (q1 + q2)
    (*) (Quantity q1) (Quantity q2) = Quantity (q1 * q2)
    (-) (Quantity q1) (Quantity q2) = Quantity (q1 - q2)
    abs (Quantity q) = Quantity (abs q)
    signum (Quantity q) = Quantity (signum q)
    fromInteger i = Quantity i
-------------------------------

data QuantityHolder = QuantityHolder { _quantityPolymorph  :: Quantity
                                     , _quantityTeamPlayer :: Quantity
                                     , _quantityLoneWolf   :: Quantity
                                     } deriving (Show)

$(makeLenses ''QuantityHolder)
-------------------------------

data Fighter = TeamPlayer
             | LoneWolf
             | Polymorph
    deriving (Show, Eq, Ord)
-------------------------------

data World = World {
    _quantities :: QuantityHolder
} deriving (Show)

$(makeLenses ''World)

incrementQuantity (Quantity q) = Quantity (q + 1)

updateWorld :: Maybe World -> Fighter -> Maybe World
updateWorld (Just w) f =
    case f of
        Polymorph ->
            Just $ q1 w
        TeamPlayer ->
            Just $ q2 w
        LoneWolf ->
            Just $ q3 w
    where q1 = over quantities . over quantityPolymorph $ incrementQuantity
          q2 = over quantities . over quantityTeamPlayer $ incrementQuantity
          q3 = over quantities . over quantityLoneWolf $ incrementQuantity

Answer 1

updateWorld of @Changaco can still be improved. I'll show it gradually so you can see what's going on.

Firstly, we can eliminate duplication in case statement and use lens composition to eliminate second over:

quantity Polymorph = quantityPolymorph
quantity TeamPlayer = quantityTeamPlayer
quantity LoneWolf = quantityLoneWolf

updateWorld :: Fighter -> World -> World
updateWorld fighter w = increment (quantity fighter) w where
        increment field = over (quantities . field) (+1)

Then we can go pointfree. Pointfree is all about readability so don't do it whenever you feel readability is harmed. With coding experience more and more code will become readable for you.

updateWorld = increment . quantity where
    increment field = over (quantities . field) (+1)

Then we replace over with a more specialized version of it from Control.Lens.Setter:

updateWorld = increment . quantity where
    increment field = (quantities . field) +~ 1

Now it seems beneficial to inline increment. I'll do in 2 steps. First, I make the actual parameter of increment explicit:

updateWorld field = increment $ quantity field where
    increment field = (quantities . field) +~ 1

Then I inline:

updateWorld :: Fighter -> World -> World
updateWorld field = (quantities . quantity field) +~ 1

Another way to improve could be to use a Map or an Array for QuantityHolder:

data World = World { _quantities :: M.Map Fighter Quantity }

Below is full source using Map:

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Lens
import System.Random
import qualified Data.Map as M
import Data.Maybe

newtype Quantity = Quantity Integer
    deriving (Eq,Num,Ord,Random,Show)

data Fighter = TeamPlayer
             | LoneWolf
             | Polymorph
               deriving (Eq,Ord,Show)

data World = World { _quantities :: M.Map Fighter Quantity }
    deriving (Show)
$(makeLenses ''World)

atFighter i = at i . iso fromJust Just

updateWorld :: Fighter -> World -> World
updateWorld field = (quantities . atFighter field) +~ 1

But it really depends on the usage scenarios you plan for World.

Also note that lens interact with state monad transformer pretty well, so you may consider

updateWorldS :: Fighter -> State World Quantity
updateWorldS field = (quantities . atFighter field) <+= 1

Note that World is not passed in explicitly any more. And the type is more general than that, so you can combine state with IO and other monads should you wish:

updateWorldS :: MonadState World m => Fighter -> m Quantity

If you want to be able to report any extra value from updateWorld you can use the existing state monad:

updateWorldS :: Fighter -> State World Bool
updateWorldS field = (quantities . atFighter field) <+= 1 >> return errorBool where
      errorBool = False -- or True

Or MonadPlus if you don't want to just report failure without extra info:

updateWorldS field = (quantities . atFighter field) <+= 1 >> when errorBool mzero where
      errorBool = False

Or MonadError if you want to supply an error value (of any type):

updateWorldS4 field = (quantities . atFighter field) <+= 1 >> when errorBool (throwError "Game over")

Answer 2

Get rid of direct enumeration of q1 and so on, with usage of quantityPolymorph and others in them. Problem is that partial application won't help since the function which gets applied is "in the middle" of arguments

That's not a problem, you can do partial application in any order, it's just more verbose.

Get rid of incrementQuantity. I'd like something like fmap (+1), but since Quantity is not an instance of Functor, I can't do that. I can't make Quantity an instance because it has kind *. Is there a more concise way, w/o lambda?

You don't need fmap, a simple (+1) works. If I'm not mistaken, under the hood the compiler uses fromInteger to convert the 1 literal to a Quantity.

---

Here is what I have:

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Lens
import System.Random

newtype Quantity = Quantity Integer
    deriving (Eq,Num,Ord,Random,Show)

data QuantityHolder = QuantityHolder { _quantityPolymorph  :: Quantity
                                     , _quantityTeamPlayer :: Quantity
                                     , _quantityLoneWolf   :: Quantity
                                     } deriving (Show)
$(makeLenses ''QuantityHolder)

data Fighter = TeamPlayer
             | LoneWolf
             | Polymorph
               deriving (Eq,Ord,Show)

data World = World { _quantities :: QuantityHolder }
    deriving (Show)
$(makeLenses ''World)

updateWorld :: Fighter -> World -> World
updateWorld fighter w =
    case fighter of
        Polymorph -> increment quantityPolymorph w
        TeamPlayer -> increment quantityTeamPlayer w
        LoneWolf -> increment quantityLoneWolf w
    where increment field = over quantities . over field $ (+1)

I didn't really look into the lens stuff.

Note the use of GeneralizedNewtypeDeriving to get rid of the boring instance declarations.

A main function to do a simple test:

main = do
    let w = World $ QuantityHolder 0 0 0
    print $ updateWorld Polymorph $ updateWorld LoneWolf w