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 = Undo -> StateT Undo 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 {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 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 :: 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)} = (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 :: 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)} = (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 :: forall s (m :: * -> *). (Save s, MonadState Undo m) => 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) s -> CmdM m s forall a. a -> CmdM m a 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 = (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 :: forall (m :: * -> *) s. (MonadState Undo m, Save s) => 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