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 :: UndoT m a -> m a
runUndoT = Undo -> UndoT m a -> m a
forall (m :: * -> *) s a. Monad m => s -> StateT s m a -> m a
evalStateT' Undo
initialUndo

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


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

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

redoFuture :: 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)}
            = (InsertMode -> s
forall s. Save s => InsertMode -> s
restore InsertMode
futureLS, Undo
u {futureRedo :: [InsertMode]
futureRedo = [InsertMode]
lss, pastUndo :: [InsertMode]
pastUndo = s -> InsertMode
forall s. Save s => s -> InsertMode
save s
ls InsertMode -> [InsertMode] -> [InsertMode]
forall a. a -> [a] -> [a]
: Undo -> [InsertMode]
pastUndo Undo
u})



saveForUndo :: (Save s, MonadState Undo m)
                => Command m s s
saveForUndo :: Command m s s
saveForUndo s
s = do
    (Undo -> Undo) -> CmdM m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (s -> Undo -> Undo
forall s. Save s => s -> Undo -> Undo
saveToUndo s
s)
    Command m 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 :: Command m s s
commandUndo = (s -> m (Either Effect s)) -> Command m s s
forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand ((s -> m (Either Effect s)) -> Command m s s)
-> (s -> m (Either Effect s)) -> Command m s s
forall a b. (a -> b) -> a -> b
$ (s -> Either Effect s) -> m s -> m (Either Effect s)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM s -> Either Effect s
forall a b. b -> Either a b
Right (m s -> m (Either Effect s))
-> (s -> m s) -> s -> m (Either Effect s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Undo -> (s, Undo)) -> m s
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
update ((Undo -> (s, Undo)) -> m s)
-> (s -> Undo -> (s, Undo)) -> s -> m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Undo -> (s, Undo)
forall s. Save s => s -> Undo -> (s, Undo)
undoPast
commandRedo :: Command m s s
commandRedo = (s -> m (Either Effect s)) -> Command m s s
forall s (m :: * -> *).
(LineState s, Monad m) =>
(s -> m (Either Effect s)) -> Command m s s
simpleCommand ((s -> m (Either Effect s)) -> Command m s s)
-> (s -> m (Either Effect s)) -> Command m s s
forall a b. (a -> b) -> a -> b
$ (s -> Either Effect s) -> m s -> m (Either Effect s)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM s -> Either Effect s
forall a b. b -> Either a b
Right (m s -> m (Either Effect s))
-> (s -> m s) -> s -> m (Either Effect s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Undo -> (s, Undo)) -> m s
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
update ((Undo -> (s, Undo)) -> m s)
-> (s -> Undo -> (s, Undo)) -> s -> m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Undo -> (s, Undo)
forall s. Save s => s -> Undo -> (s, Undo)
redoFuture