我怎样才能在状态monad中正确添加"撤消"功能？

Question

假设我有一个状态monad,我想对状态进行一些操作,并且可能希望在将来撤消更改.我一般可以这样做得体面吗？

举一个具体的例子,让我们假设状态只是一个Int,操作就是将数字增加一个.

type TestM a = StateT a IO ()

inc :: TestM Int
inc = modify (+ 1)

但是,如果我想跟踪状态的所有历史记录,以防我想要撤消到某个先前的状态,我能想到的最好的方法是将状态包装在堆栈中:对状态的每次修改都会被推送到堆栈,以便我可以通过删除堆栈上的顶部元素来撤消更改.

-- just for showing what's going on
traceState :: (MonadIO m, MonadState s m, Show s) => m a -> m a
traceState m = get >>= liftIO . print >> m

recordDo :: TestM a -> TestM [a]
recordDo m = do
    x <- gets head
    y <- liftIO $ execStateT m x
    modify (y:)

inc' :: TestM [Int]
inc' = recordDo inc

undo' :: TestM [Int]
undo' = modify tail

-- inc 5 times, undo, and redo inc
manip' :: TestM [Int]
manip' = mapM_ traceState (replicate 5 inc' ++ [undo',inc'])

main :: IO ()
main = do
    v1 <- execStateT (replicateM_ 5 (traceState inc)) 2
    v2 <- execStateT (replicateM_ 5 (traceState inc')) [2]
    v3 <- execStateT manip' [2]
    print (v1,v2,v3)

正如所料,这是输出:

2
3
4
5
6
[2]
[3,2]
[4,3,2]
[5,4,3,2]
[6,5,4,3,2]
[2]
[3,2]
[4,3,2]
[5,4,3,2]
[6,5,4,3,2]
[7,6,5,4,3,2]
[6,5,4,3,2]
(7,[7,6,5,4,3,2],[7,6,5,4,3,2])

我的方法的缺点:

• tail并且head不安全
• 一个人必须使用recordDo明确的东西,但我想这是不可避免的,否则会出现一些不一致的问题.例如由两个增加的数量可以通过进行inc' >> inc'或recordDo (inc >> inc)与这两种方法具有在堆栈上不同的影响.

因此,我正在寻找一些方法来使它更体面或更好地完成"可逆状态"的工作.

Answer 1

根据您的用例，可能值得考虑我称之为“分隔撤消”的东西：

{-# LANGUAGE FunctionalDependencies, FlexibleContexts #-}
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans.Maybe

undo :: (MonadState s m, MonadPlus m) => m a -> m a -> m a
undo dflt k = do
    s <- get
    k `mplus` (put s >> dflt)

undoMaybe :: (MonadState s m) => m a -> MaybeT m a -> m a
undoMaybe dflt k = do
    s <- get
    r <- runMaybeT k
    maybe (put s >> dflt) return r

undoMaybe_ :: (MonadState s m) => MaybeT m () -> m ()
undoMaybe_ = undoMaybe (return ())

执行的undo x k意思是“执行k，如果失败，则撤消状态并执行x”。函数的undoMaybe工作方式类似，但仅允许嵌套块失败。您的示例可以表示为：

type TestM a = StateT a IO ()

inc :: (MonadState Int m) => m ()
inc = modify (+ 1)

-- just for showing what's going on
traceState :: (MonadIO m, MonadState s m, Show s) => m a -> m a
traceState m = get >>= liftIO . print >> m

inc' :: (MonadIO m, MonadState Int m) => m ()
inc' = traceState inc

-- inc 5 times, undo, and redo inc
manip' :: TestM Int
manip' = replicateM 4 inc' >> undoMaybe_ (inc' >> traceState mzero) >> inc'

main :: IO ()
main = do
    v1 <- execStateT (replicateM_ 5 (traceState inc)) 2
    putStrLn ""
    v3 <- execStateT manip' 2
    print (v1,v3)

主要优点是永远不会使堆栈下溢。缺点是您无法访问堆栈并且撤消始终是分隔的。

人们还可以创建一个Undomonad 转换器，将上面的内容undo变为mplus. 每当使用 恢复失败的计算时mplus，状态也会恢复。

newtype Undo m a = Undo (m a)
    deriving (Functor, Applicative, Monad)

instance MonadTrans Undo where
    lift = Undo

instance (MonadState s m) => MonadState s (Undo m) where
    get = lift get
    put = lift . put
    state = lift . state

instance (MonadPlus m, MonadState s m) => MonadPlus (Undo m) where
    mzero = lift mzero
    x `mplus` y = do
        s <- get
        x `mplus` (put s >> y)