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

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

undo :: UndoStack a -> Maybe (a,UndoStack a)
undo :: 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' -> (a, UndoStack a) -> Maybe (a, UndoStack a)
forall a. a -> Maybe a
Just (a
a,Maybe Int -> [a] -> [a] -> [a] -> UndoStack a
forall a. Maybe Int -> [a] -> [a] -> [a] -> UndoStack a
U Maybe Int
on [a]
u [a]
tu' (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
tr))
			[] -> Maybe (a, UndoStack a)
forall a. Maybe a
Nothing

redo :: UndoStack a -> Maybe (a,UndoStack a)
redo :: 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' -> (a, UndoStack a) -> Maybe (a, UndoStack a)
forall a. a -> Maybe a
Just (a
b,Maybe Int -> [a] -> [a] -> [a] -> UndoStack a
forall a. Maybe Int -> [a] -> [a] -> [a] -> UndoStack a
U Maybe Int
on [a]
u (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
tu) (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
tr'))
       [a
a] -> (a, UndoStack a) -> Maybe (a, UndoStack a)
forall a. a -> Maybe a
Just ([a] -> a
forall a. [a] -> a
head [a]
u,Maybe Int -> [a] -> [a] -> [a] -> UndoStack a
forall a. Maybe Int -> [a] -> [a] -> [a] -> UndoStack a
U Maybe Int
on [a]
u (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
tu) [])
       [] -> Maybe (a, UndoStack a)
forall a. Maybe a
Nothing