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 :: forall a. Maybe Int -> UndoStack a
undoStack Maybe Int
on = forall a. Maybe Int -> [a] -> [a] -> [a] -> UndoStack a
U (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
n -> forall a. Ord a => a -> a -> a
max Int
0 Int
n forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
on) [] [] []

otake :: Maybe Int -> [a] -> [a]
otake Maybe Int
on [a]
l = case Maybe Int
on of
	        Maybe Int
Nothing -> [a]
l
		Just Int
n -> forall a. Int -> [a] -> [a]
take Int
n [a]
l

doit :: UndoStack a -> a -> (UndoStack a -> c) -> c
doit :: forall a c. UndoStack a -> a -> (UndoStack a -> c) -> c
doit (U Maybe Int
on [a]
u [a]
tu [a]
tr) a
a UndoStack a -> c
c = seq :: forall a b. a -> b -> b
seq (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
u') forall a b. (a -> b) -> a -> b
$ UndoStack a -> c
c (forall a. Maybe Int -> [a] -> [a] -> [a] -> UndoStack a
U Maybe Int
on [a]
u' (forall a. [a] -> [a]
tail [a]
u') [])
    where u' :: [a]
u' = forall {a}. Maybe Int -> [a] -> [a]
otake Maybe Int
on (a
aforall a. a -> [a] -> [a]
:forall a. Int -> [a] -> [a]
take Int
1 [a]
trforall a. [a] -> [a] -> [a]
++[a]
u)

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

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