我怎样才能在状态monad中正确添加“撤消”功能?

时间:2014-12-26 23:44:41

标签: haskell state-monad

假设我有一个State 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])

我的方法的缺点:

  • tailhead不安全
  • 必须明确使用recordDo之类的内容,但我想这是不可避免的,否则会出现一些不一致的问题。例如,可以通过inc' >> inc'recordDo (inc >> inc)将数字增加两个,这两种方法对堆栈有不同的影响。

因此,我正在寻找一些方法使其更加体面或更好地完成“可逆状态”的工作。

1 个答案:

答案 0 :(得分:2)

根据您的使用情况,可能值得考虑我称之为“分隔撤消”的内容:

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

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

还可以创建Undo monad变换器,其中上述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)