Hedi-0.1.1: Line oriented editorSource codeContentsIndex
Undo
Description
This code has been taken from http://haskell.org A Monad transformer UndoT on a state supporting undo , redo and hput to push the last state on history. Redo stack is blanked on hput
Synopsis
data History s = History {
current :: s
undos :: [s]
redos :: [s]
}
type HStateT s m = StateT (History s) m
class (Monad m, MonadState (History s) (HStateT s m)) => HCtx m s
newtype Monad m => UndoT s m a = UndoT (HStateT s m a)
undo :: HCtx m s => UndoT s m Bool
redo :: HCtx m s => UndoT s m Bool
hput :: HCtx m s => s -> UndoT s m ()
blank :: s -> History s
evalUndoT :: Monad m => UndoT s m a -> s -> m a
execUndoT :: Monad m => UndoT s m a -> s -> m s
Documentation
data History s Source
State stacks wrapping states in time
Constructors
History
current :: slast state putted
undos :: [s]the history of putted states (reversed) without the redos
redos :: [s]history of the undo
show/hide Instances
Show s => Show (History s)
type HStateT s m = StateT (History s) mSource
a state monad transformer with the state history
class (Monad m, MonadState (History s) (HStateT s m)) => HCtx m s Source
facility to write signatures context
newtype Monad m => UndoT s m a Source
a wrapper around HStateT to derive his classes and add an instance
Constructors
UndoT (HStateT s m a)
show/hide Instances
Monad m => MonadState s (UndoT s m)
MonadTrans (UndoT s)
Monad m => Monad (UndoT s m)
Monad m => Functor (UndoT s m)
MonadIO m => MonadIO (UndoT s m)
undoSource
:: HCtx m s
=> UndoT s m BoolFalse if the undo stack was empty
tries to get back one step the state
redoSource
:: HCtx m s
=> UndoT s m BoolFalse if the redo stack was empty
tries to get back the undo operation
hputSource
:: HCtx m s
=> sthe new state to put
-> UndoT s m ()monading
push the old state in the undo stack and set the new state (alternative to put)
blank :: s -> History sSource
an History of one state
evalUndoTSource
:: Monad m
=> UndoT s m aa UndoT action
-> sthe initial state
-> m athe result
run the UndoT monad transformer spitting out the computation result in the inner monad
execUndoTSource
:: Monad m
=> UndoT s m aa UndoT action
-> sthe initial state
-> m sthe final state
run the UndoT monad transformer spitting out the final state in the inner monad
Produced by Haddock version 2.3.0