Modify state using a monadic function with lenses

1.3k Views Asked by At

My question is quite similar to How to modify using a monadic function with lenses? The author asked if something like this exists

overM :: (Monad m) => Lens s t a b -> (a -> m b) -> s -> m t

The answer was mapMOf

mapMOf :: Profunctor p =>
     Over p (WrappedMonad m) s t a b -> p a (m b) -> s -> m t

I'm trying to implement a function that modifies state in MonadState using a monadic function:

modifyingM :: MonadState s m => ASetter s s a b -> (a -> m b) -> m ()

Example without modifingM:

{-# LANGUAGE TemplateHaskell #-}

module Main where

import Control.Lens (makeLenses, use, (.=))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Lazy (StateT(StateT), execStateT)

data GameObject = GameObject
  { _num :: Int
  } deriving (Show)

data Game = Game
  { _objects :: [GameObject]
  } deriving (Show)

makeLenses ''Game

makeLenses ''GameObject

defaultGame = Game {_objects = map GameObject [0 .. 3]}

action :: StateT Game IO ()
action = do
  old <- use objects
  new <- lift $ modifyObjects old
  objects .= new

modifyObjects :: [GameObject] -> IO [GameObject]
modifyObjects objs = return objs -- do modifications

main :: IO ()
main = do
  execStateT action defaultGame
  return ()

This example works. Now I'd like to extract the code from action to a generic solution modifingM:

{-# LANGUAGE TemplateHaskell #-}

module Main where

import Control.Lens (makeLenses, use, (.=), ASetter)
import Control.Monad.State.Class (MonadState)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Lazy (StateT(StateT), execStateT)

data GameObject = GameObject
  { _num :: Int
  } deriving (Show)

data Game = Game
  { _objects :: [GameObject]
  } deriving (Show)

makeLenses ''Game

makeLenses ''GameObject

defaultGame = Game {_objects = map GameObject [0 .. 3]}

modifyingM :: MonadState s m => ASetter s s a b -> (a -> m b) -> m ()
modifyingM l f = do
  old <- use l
  new <- lift $ f old
  l .= new

action :: StateT Game IO ()
action = modifyingM objects modifyObjects

modifyObjects :: [GameObject] -> IO [GameObject]
modifyObjects objs = return objs -- do modifications

main :: IO ()
main = do
  execStateT action defaultGame
  return ()

This results in compile time errors:

Main.hs:26:14: error:
    • Couldn't match type ‘Data.Functor.Identity.Identity s’
                     with ‘Data.Functor.Const.Const a s’
      Expected type: Control.Lens.Getter.Getting a s a
        Actual type: ASetter s s a b
    • In the first argument of ‘use’, namely ‘l’
      In a stmt of a 'do' block: old <- use l
      In the expression:
        do { old <- use l;
             new <- lift $ f old;
             l .= new }
    • Relevant bindings include
        f :: a -> m b (bound at app/Main.hs:25:14)
        l :: ASetter s s a b (bound at app/Main.hs:25:12)
        modifyingM :: ASetter s s a b -> (a -> m b) -> m ()
          (bound at app/Main.hs:25:1)

Main.hs:31:10: error:
    • Couldn't match type ‘IO’ with ‘StateT Game IO’
      Expected type: StateT Game IO ()
        Actual type: IO ()
    • In the expression: modifyingM objects modifyObjects
      In an equation for ‘action’:
          action = modifyingM objects modifyObjects

What's the problem?


Edit 1: Assign new instead of old value.

Edit 2: Added example with solution of @Zeta that does not compile.

Edit 3: Remove example of second edit. It didn't compile due to wrong imports (see comment).

1

There are 1 best solutions below

9
On BEST ANSWER

You're using use on a ASetter, but use takes a Getter:

use  :: MonadState s m => Getting a s a        -> m a 
(.=) :: MonadState s m => ASetter s s a b -> b -> m ()

Unfortunately, ASetter and Getting are not the same:

type Getting r s a   = (a -> Const r a ) -> s -> Const r s 
type ASetter s t a b = (a -> Identity b) -> s -> Identity t 

We need to switch between Const and Identity arbitrarily. We need a Lens:

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t

Note that there is no f on the left-hand side. Next, we note that your lift is not necessary. After all, f already works in our target monad m; you had to use lift previously because modifyObjects was in IO and action was in StateT Game IO, but here we just have a single m:

modifyingM :: MonadState s m => Lens s s a a -> (a -> m b) -> m ()
modifyingM l f = do
  old <- use l
  new <- f old
  l .= old

That works! But it's likely wrong, since you probably want to set the new value in l .= old. If that's the case, we have to make sure that old and new have the same type:

--                                      only a here, no b
--                                       v v     v      v
modifyingM :: MonadState s m => Lens s s a a -> (a -> m a) -> m ()
modifyingM l f = do
  old <- use l
  new <- f old
  l .= new

Keep in mind that you need to lift modifyObjects though:

action :: StateT Game IO ()
action = modifyingM objects (lift . modifyObjects)

We could stop here, but just for some fun, let us have a look again at Lens:

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t

For any a -> f b you give me, I'll give you a new s -> f t. So if we just plug something in your objects, we have

> :t \f -> objects f
\f -> objects f
  :: Functor f => (GameObject -> f GameObject) -> Game -> f Game

Therefore, we just need some MonadState s m => (s -> m s) -> m () function, but that's easy to achieve:

import Control.Monad.State.Lazy (get, put) -- not the Trans variant!

modifyM :: MonadState s m => (s -> m s) -> m ()
modifyM f = get >>= f >>= put

Note that you need to use Control.Monad.State from mtl instead of Control.Monad.Trans.State. The latter only defines put :: Monad m => s -> StateT s m () and get :: Monad m => StateT s m s, but you want to use the MonadState variant from mtl.

If we put all things together, we see that modifyingM can be written as:

modifyingM :: MonadState s m => Lens s s a a -> (a -> m a) -> m ()
modifyingM l f = modifyM (l f)

Alternatively, we use the can use the lens functions, although that does not give us the insight that we can use l f:

modifyingM :: MonadState s m => Lens s s a a -> (a -> m a) -> m ()
modifyingM l f = use l >>= f >>= assign l