Come posso aggiungere in modo decente una funzionalità di "annullamento" alle monadi di stato?

Question

Dire che ho una monade di stato, e voglio fare alcune manipolazioni sullo stato e potrei voler annullare la modifica in futuro. In generale, come posso farlo decentemente?

Per fare un esempio concreto, supponiamo che lo stato sia solo un Int e che la manipolazione sia solo per aumentare il numero di uno.

type TestM a = StateT a IO() 

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

tuttavia, se voglio tenere traccia di tutta la storia degli Stati in caso voglio disfare a uno stato precedente, il meglio che posso pensare è per avvolgere gli stati in una pila: ogni modifica lo stato verrà inserito nello stack in modo da poter annullare le modifiche mediante il rilascio dell'elemento superiore nello stack.

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

Come previsto, ecco l'output:

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

Lo svantaggio del mio approccio:

• tail e head sono sicuri
• One devono usare qualcosa come recordDo esplicitamente , ma immagino che questo sia inevitabile perché altrimenti ci sarà qualche problema di incoerenza. Ad esempio, l'aumento del numero di due può essere effettuato tramite inc' >> inc' o recordDo (inc >> inc) e questi due approcci hanno effetti diversi sullo stack.

Quindi sono in cerca di alcuni modi per renderlo più decente o qualcosa che faccia il lavoro di "stato reversibile" meglio.

Answer 1

A seconda del caso d'uso, potrebbe essere opportuno prendere in considerazione qualcosa che io chiamerei "undo delimitato":

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

esecuzione undo x k significa "esecuzione k, e se fallisce, annullare lo stato e eseguire invece x ". La funzione undoMaybe funziona in modo simile, ma consente l'errore solo il blocco nidificato. Il tuo esempio potrebbe essere espresso come:

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) 

Il vantaggio principale è che non puoi mai sottovalutare lo stack. Lo svantaggio è che non è possibile accedere allo stack e che l'annullamento è sempre delimitato.

Si potrebbe anche creare un trasformatore monad Undo che laddove il precedente undo diventa mplus. Ogni volta che un calcolo fallito viene ripristinato con mplus, viene ripristinato anche lo stato.

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)