使用带镜头的monadic函数修改状态

mai*_*mic 2 monads haskell lenses

我的问题非常类似于如何使用带镜头的monadic功能进​​行修改?作者问这样的事情是否存在

overM :: (Monad m) => Lens s t a b -> (a -> m b) -> s -> m t
Run Code Online (Sandbox Code Playgroud)

答案是mapMOf

mapMOf :: Profunctor p =>
     Over p (WrappedMonad m) s t a b -> p a (m b) -> s -> m t
Run Code Online (Sandbox Code Playgroud)

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

modifyingM :: MonadState s m => ASetter s s a b -> (a -> m b) -> m ()
Run Code Online (Sandbox Code Playgroud)

示例没有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 ()
Run Code Online (Sandbox Code Playgroud)

这个例子有效.现在我想将代码从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 ()
Run Code Online (Sandbox Code Playgroud)

这会导致编译时错误:

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
Run Code Online (Sandbox Code Playgroud)

有什么问题?


编辑1:分配new而不是old值.

编辑2:添加了无法编译的@Zeta解决方案示例.

编辑3:删除第二次编辑的示例.它由于错误导入而无法编译(请参阅注释).

Zet*_*eta 6

你正在使用usea ASetter,但use需要Getter:

use  :: MonadState s m => Getting a s a        -> m a 
(.=) :: MonadState s m => ASetter s s a b -> b -> m ()
Run Code Online (Sandbox Code Playgroud)

不幸的是,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 
Run Code Online (Sandbox Code Playgroud)

我们需要之间进行切换ConstIdentity随意.我们需要一个Lens:

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
Run Code Online (Sandbox Code Playgroud)

请注意,f左侧没有.接下来,我们注意到您lift没有必要.毕竟,f已经在我们的目标monad中工作m; 您必须使用lift,因为以前modifyObjectsIOactionStateT 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
Run Code Online (Sandbox Code Playgroud)

这样可行!但它可能是错的,因为您可能想要设置l .= old.如果是这种情况,我们必须确保oldnew具有相同的类型:

--                                      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
Run Code Online (Sandbox Code Playgroud)

请记住,您需要lift modifyObjects:

action :: StateT Game IO ()
action = modifyingM objects (lift . modifyObjects)
Run Code Online (Sandbox Code Playgroud)

我们可以在这里停下来,但为了一些乐趣,让我们再看看镜头:

type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
Run Code Online (Sandbox Code Playgroud)

对于a -> f b你给我的任何人,我会给你一个新的s -> f t.因此,如果我们只是在您的对象中插入一些内容,

> :t \f -> objects f
\f -> objects f
  :: Functor f => (GameObject -> f GameObject) -> Game -> f Game
Run Code Online (Sandbox Code Playgroud)

因此,我们只需要一些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
Run Code Online (Sandbox Code Playgroud)

请注意,您需要使用Control.Monad.Statefrom mtl而不是Control.Monad.Trans.State.后者只定义put :: Monad m => s -> StateT s m ()get :: Monad m => StateT s m s,但你想使用MonadState变体mtl.

如果我们把所有东西放在一起,我们会看到它modifyingM可以写成:

modifyingM :: MonadState s m => Lens s s a a -> (a -> m a) -> m ()
modifyingM l f = modifyM (l f)
Run Code Online (Sandbox Code Playgroud)

或者,我们使用可以使用镜头功能,虽然这并没有给我们提供我们可以使用的见解l f:

modifyingM :: MonadState s m => Lens s s a a -> (a -> m a) -> m ()
modifyingM l f = use l >>= f >>= assign l
Run Code Online (Sandbox Code Playgroud)