System/Console/Haskeline/Command/Undo.hs

    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 {pastUndo, futureRedo :: [InsertMode]}

    type UndoT = StateT Undo

    runUndoT :: Monad m => UndoT m a -> m a
    runUndoT = evalStateT' initialUndo

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

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

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

    redoFuture ls u@Undo {futureRedo = []} = (ls,u)
    redoFuture ls u@Undo {futureRedo = (futureLS:lss)}
                = (restore futureLS, u {futureRedo = lss, pastUndo = save ls : pastUndo u})

    saveForUndo :: (Save s, MonadState Undo m)
                    =>Command m s s
    saveForUndo s = do
        modify (saveToUndo s)
        return s

    commandUndo, commandRedo :: (MonadState Undo m, Save s) => Command m s s
    commandUndo = simpleCommand $ liftM Right . update . undoPast
    commandRedo = simpleCommand $ liftM Right . update . redoFuture