使用镜片（lenses）和单子（monad）函数修改状态

Question

我的问题与如何使用 Lens 修改一个单子函数？非常相似。作者问是否存在这样的东西。

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

答案是 mapMOf。

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

我正在尝试实现一个函数，使用单子函数修改MonadState中的状态:

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

没有修改M的例子：

{-# 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 ()

这个例子可以运行。现在我想从action中提取代码，创建一个通用的解决方案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 ()

这会导致编译时出现错误：

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

什么问题？

---

编辑1： 分配新的值而不是旧的值。 编辑2： 添加了@Zeta的解决方案示例，该示例无法编译。 编辑3： 删除第二次编辑示例。由于错误的导入（请参见评论），它无法编译。

- maiermic

---

你可以摆脱编辑，抱歉，我错过了你使用的是 Control.Monad.Trans.State (StateT,put,get) 而不是 Control.Monad.State (StateT,put,get)。 - Zeta

@Zeta 我已经删除了编辑示例。 - maiermic

Answer 1

您正在对一个 ASetter 使用 use，但是 use 需要一个 Getter。

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

不幸的是，ASetter和Getting不是同一个东西：

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 

我们需要随意在 Const 和 Identity 之间切换。我们需要一个 Lens：

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

请注意左侧没有f。接下来，我们注意到您的lift是不必要的。毕竟，在我们的目标单子m中，f已经起作用；之前您必须使用lift是因为modifyObjects在IO中，而action在StateT Game IO中，但在这里我们只有一个单子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

可以这么做！但是很可能是错误的，因为您可能想在l .= old中设置新值。如果是这种情况，则必须确保old和new具有相同的类型：

--                                      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

请记住，您需要 lift modifyObjects：

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

---

尽管我们可以到此为止，但为了一点趣味，让我们再次看一下“Lens”：

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

对于任何给定的 a -> f b，我都会给你一个新的 s -> f t。所以如果我们只是在你的对象中插入一些东西，我们就有了：

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

因此，我们只需要一些 MonadState s m => (s -> m s) -> m () 函数，但这很容易实现：

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

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

注意，您需要使用 mtl 中的 Control.Monad.State，而不是 Control.Monad.Trans.State。后者只定义了 put :: Monad m => s -> StateT s m () 和 get :: Monad m => StateT s m s，但您需要使用来自 mtl 的 MonadState 变量。

将所有内容组合在一起，我们可以得出 modifyingM 的编写方式：

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

另外，我们可以使用镜头函数，但这并不像我们可以使用lf那样给我们洞察力：

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

- Zeta

---

抱歉，可能我们同时发布了。我很抱歉 :/ - Netwave

没关系，这就是修订的作用。我完全忽略了糟糕的格式。 - Zeta

@Zeta 谢谢，我更新了我的示例。我喜欢分配新值当然 blush。我尝试在我的示例中使用您建议的解决方案，但它导致编译时错误（请参见编辑2）。 - maiermic

@maiermic 我放弃了 Lens 部分，因为我需要更仔细地检查它。但是另一个错误源于 action 中缺少 lift。如果你喜欢 >>= 风格，你可以使用 use l >>= f >>= assign l。 - Zeta

@maiermic，你使用了Control.Monad.Trans.State.Lazy，而我使用了Control.Monad.State.Lazy。前者有put和get变体，只适用于StateT，而后者使用MonadState。 - Zeta