Difference between revisions of "New monads/MonadUndo"
From HaskellWiki
m 
BrettGiles (talk  contribs) (copyright issue) 

Line 1:  Line 1:  
+  
+  {{Template:Nonstandard copyright}} 

[[Category:Code]] 
[[Category:Code]] 

From New monads, copied from [http://haskell.org/hawiki/MonadUndo old wiki]. 
From New monads, copied from [http://haskell.org/hawiki/MonadUndo old wiki]. 

Line 4:  Line 6:  
[http://haskell.org/hawiki/CaleGibbard_2fBSDLicense "CaleGibbard/BSDLicense"] 
[http://haskell.org/hawiki/CaleGibbard_2fBSDLicense "CaleGibbard/BSDLicense"] 

−  = MonadUndo = 

Here is a modified state monad transformer for keeping track of undo/redo states automatically. 
Here is a modified state monad transformer for keeping track of undo/redo states automatically. 
Revision as of 03:33, 5 November 2006
This page contains a nonstandard copyright. All contributions to HaskellWiki are considered to be released under a simple permissive license (see HaskellWiki:Copyrights for details). Please either remove the material or change the copyright.

From New monads, copied from old wiki.
Here is a modified state monad transformer for keeping track of undo/redo states automatically.
{# OPTIONS_GHC fglasgowexts #}
module MonadUndo (
UndoT, evalUndoT, execUndoT,
Undo, evalUndo, execUndo,
MonadUndo, undo, redo, history, checkpoint,
History, current, undos, redos
) where
import Control.Monad.State
import Control.Monad.Identity
data History s = History { current :: s, undos :: [s], redos :: [s] }
deriving (Eq, Show, Read)
blankHistory s = History { current = s, undos = [], redos = [] }
newtype Monad m => UndoT s m a = UndoT (StateT (History s) m a)
deriving (Functor, Monad, MonadTrans, MonadIO)
class (MonadState s m) => MonadUndo s m  m > s where
undo :: m Bool  undo the last state change, returns whether successful
redo :: m Bool  redo the last undo
history :: m (History s)  gets the current undo/redo history
checkpoint :: m ()  kill the history, leaving only the current state
instance (Monad m) => MonadState s (UndoT s m) where
get = UndoT $ do
ur < get
return (current ur)
put x = UndoT $ do
ur < get
put $ History { current = x, undos = current ur : undos ur
, redos = [] }
instance (Monad m) => MonadUndo s (UndoT s m) where
undo = UndoT $ do
ur < get
case undos ur of
[] > return False
(u:us) > do put $ History { current = u, undos = us
, redos = current ur : redos ur }
return True
redo = UndoT $ do
ur < get
case redos ur of
[] > return False
(r:rs) > do put $ History { current = r, undos = current ur : undos ur
, redos = rs }
return True
history = UndoT $ get
checkpoint = UndoT $ do
s < liftM current get
put $ blankHistory s
evalUndoT (UndoT x) s = evalStateT x (blankHistory s)
execUndoT (UndoT x) s = liftM current $ execStateT x (blankHistory s)
newtype Undo s a = Undo (UndoT s Identity a)
deriving (Functor, Monad, MonadState s, MonadUndo s)
evalUndo (Undo x) s = runIdentity $ evalUndoT x s
execUndo (Undo x) s = runIdentity $ execUndoT x s