Instead of keeping a list of Put/Undo/Redo commands, it may be easier to keep a pair of stacks of states, representing past states (which can be restored when you 'Undo') and "future" states (which are restored when you 'Redo'). That is, you can think of the state as a list of values with a "current" position; put and get operate on the current position, and undo/redo let you move back/forward in the list. (In other words - a list zipper!) In fact, you can find this code already implemented on the Haskell wiki: http://haskell.org/haskellwiki/New_monads/MonadUndo Doesn't look like it's on Hackage though. -Brent On Thu, Apr 15, 2010 at 12:15:09AM +0200, edgar klerks wrote:
Hi All,
I wanted to write the statemonad in a different way, because I want to track mutations to the state. And also to be able to undo an done or redo an undone mutation. Therefore I wrote a small dsl with an evaluator, which finds out the current state.
The problem is, I don't know how to create a get and put function for my monad. I have a function which evaluate the state and gives back the current State.
Can someone help me a bit along? I have the feeling I do something wrong, but I am not sure what.
With kind regards,
Edgar
{-# LANGUAGE GADTs,DeriveFunctor #-} import Control.Monad import Data.Maybe
data StateCmd a where Put :: a -> StateCmd a Undo :: StateCmd a Redo :: StateCmd a deriving (Show, Functor)
newtype State s a = State { unState :: ([StateCmd s],a) } deriving Show
joinState :: State s a -> State s b -> State s b joinState (State (xs, a)) (State (ys, b)) = State (xs ++ ys, b)
instance Monad (State s) where return a = State $ ([], a) (>>=) = bindState
-- m a -> ( a -> m b) -> m b bindState st@(State (_,a)) f = st `joinState` st' where st' = f a
unPut :: StateCmd a -> Maybe a unPut (Put a) = Just a unPut _ = Nothing
test = State $ ([Put 4, Undo, Redo, Undo, Put 5, Undo, Redo, Put 6, Undo, Redo, Undo], ())
getCurrent = fromJust.unPut.head.snd.(foldr current' ([],[])).reverse.fst.unState where current' x (ul,cl) = case x of Put n -> (ul, Put n : cl) Undo -> (head cl : ul, tail cl) Redo -> (tail ul, head ul : cl) _______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners