module System.Console.Haskeline.Command.Undo where

import System.Console.Haskeline.Command
import System.Console.Haskeline.LineState
import System.Console.Haskeline.Monads

import Control.Monad

data Undo = Undo {Undo -> [InsertMode]
pastUndo, Undo -> [InsertMode]
futureRedo :: [InsertMode]}

type UndoT = StateT Undo

runUndoT :: Monad m => UndoT m a -> m a
runUndoT :: forall (m :: * -> *) a. Monad m => UndoT m a -> m a
runUndoT = forall (m :: * -> *) s a. Monad m => s -> StateT s m a -> m a
evalStateT' Undo
initialUndo

initialUndo :: Undo
initialUndo :: Undo
initialUndo = Undo {pastUndo :: [InsertMode]
pastUndo = [InsertMode
emptyIM], futureRedo :: [InsertMode]
futureRedo = []}


saveToUndo :: Save s => s -> Undo -> Undo
saveToUndo :: forall s. Save s => s -> Undo -> Undo
saveToUndo s
s Undo
undo
    | Bool -> Bool
not Bool
isSame = Undo {pastUndo :: [InsertMode]
pastUndo = InsertMode
toSaveforall a. a -> [a] -> [a]
:Undo -> [InsertMode]
pastUndo Undo
undo,futureRedo :: [InsertMode]
futureRedo=[]}
    | Bool
otherwise = Undo
undo
  where
    toSave :: InsertMode
toSave = forall s. Save s => s -> InsertMode
save s
s
    isSame :: Bool
isSame = case Undo -> [InsertMode]
pastUndo Undo
undo of
                InsertMode
u:[InsertMode]
_ | InsertMode
u forall a. Eq a => a -> a -> Bool
== InsertMode
toSave -> Bool
True
                [InsertMode]
_ -> Bool
False

undoPast, redoFuture :: Save s => s -> Undo -> (s,Undo)
undoPast :: forall s. Save s => s -> Undo -> (s, Undo)
undoPast s
ls u :: Undo
u@Undo {pastUndo :: Undo -> [InsertMode]
pastUndo = []} = (s
ls,Undo
u)
undoPast s
ls u :: Undo
u@Undo {pastUndo :: Undo -> [InsertMode]
pastUndo = (InsertMode
pastLS:[InsertMode]
lss)}
        = (forall s. Save s => InsertMode -> s
restore InsertMode
pastLS, Undo
u {pastUndo :: [InsertMode]
pastUndo = [InsertMode]
lss, futureRedo :: [InsertMode]
futureRedo = forall s. Save s => s -> InsertMode
save s
ls forall a. a -> [a] -> [a]
: Undo -> [InsertMode]
futureRedo Undo
u})

redoFuture :: forall s. Save s => s -> Undo -> (s, Undo)
redoFuture s
ls u :: Undo
u@Undo {futureRedo :: Undo -> [InsertMode]
futureRedo = []} = (s
ls,Undo
u)
redoFuture s
ls u :: Undo
u@Undo {futureRedo :: Undo -> [InsertMode]
futureRedo = (InsertMode
futureLS:[InsertMode]
lss)}
            = (forall s. Save s => InsertMode -> s
restore InsertMode
futureLS, Undo
u {futureRedo :: [InsertMode]
futureRedo = [InsertMode]
lss, pastUndo :: [InsertMode]
pastUndo = forall s. Save s => s -> InsertMode
save s
ls forall a. a -> [a] -> [a]
: Undo -> [InsertMode]
pastUndo Undo
u})



saveForUndo :: (Save s, MonadState Undo m)
                => Command m s s
saveForUndo :: forall s (m :: * -> *).
(Save s, MonadState Undo m) =>
Command m s s
saveForUndo s
s = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall s. Save s => s -> Undo -> Undo
saveToUndo s
s)
    forall (m :: * -> *) a. Monad m => a -> m a
return s
s

commandUndo, commandRedo :: (MonadState Undo m, Save s) => Command m s s
commandUndo :: forall (m :: * -> *) s.
(MonadState Undo m, Save s) =>
Command m s s
commandUndo = forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
update forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Save s => s -> Undo -> (s, Undo)
undoPast
commandRedo :: forall (m :: * -> *) s.
(MonadState Undo m, Save s) =>
Command m s s
commandRedo = forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
update forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Save s => s -> Undo -> (s, Undo)
redoFuture