UndoStack.hs

module UndoStack(UndoStack,undoStack,doit,undo,redo) where
--import EitherUtils(mapMaybe)

data UndoStack a = U (Maybe Int) [a] [a] [a]
--                   depth limit undos temp-undos temp-redos
undoStack:: Maybe Int -> UndoStack a
undoStack on = U (fmap (\n -> max 0 n + 1) on) [] [] []

otake on l = case on of
	        Nothing -> l
		Just n -> take n l

doit :: UndoStack a -> a -> (UndoStack a -> c) -> c
doit (U on u tu tr) a c = seq (length u') $ c (U on u' (tail u') [])
    where u' = otake on (a:take 1 tr++u)

undo :: UndoStack a -> Maybe (a,UndoStack a)
undo (U on u tu tr) = case tu of
			a:tu' -> Just (a,U on u tu' (a:tr))
			[] -> Nothing

redo :: UndoStack a -> Maybe (a,UndoStack a)
redo (U on u tu tr) = 
     case tr of
       a:b:tr' -> Just (b,U on u (a:tu) (b:tr'))
       [a] -> Just (head u,U on u (a:tu) [])
       [] -> Nothing