{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE ViewPatterns       #-}

-- | An implementation of restricted, linear undo, as described in:
--
-- >    T. Berlage, "A selective undo mechanism for graphical user interfaces
-- >    based on command objects", ACM Transactions on Computer-Human
-- >    Interaction 1(3), pp. 269-294, 1994.
--
-- Implementation based on a proposal by sjw.
--
-- From Berlage:
--
-- >    All buffer-mutating commands are stored (in abstract form) in an
-- >    Undo list. The most recent item in this list is the action that
-- >    will be undone next. When it is undone, it is removed from the Undo
-- >    list, and its inverse is added to the Redo list. The last command
-- >    put into the Redo list can be redone, and again prepended to the
-- >    Undo list. New commands are added to the Undo list without
-- >    affecting the Redo list.
--
-- Now, the above assumes that commands can be _redone_ in a state other
-- than that in which it was orginally done. This is not the case in our
-- text editor: a user may delete, for example, between an undo and a
-- redo. Berlage addresses this in S2.3. A Yi example:
--
-- >    Delete some characters
-- >    Undo partialy
-- >    Move prior in the file, and delete another _chunk_
-- >    Redo some things  == corruption.
--
-- Berlage describes the /stable execution property/:
--
-- >    A command is always redone in the same state that it was originally
-- >    executed in, and is always undone in the state that was reached
-- >    after the original execution.
--
-- >    The only case where the linear undo model violates the stable
-- >    execution property is when _a new command is submitted while the
-- >    redo list is not empty_. The _restricted linear undo model_ ...
-- >    clears the redo list in this case.
--
-- Also some discussion of this in: /The Text Editor Sam/, Rob Pike, pg 19.
--

module Yi.Buffer.Undo (
    emptyU
  , addChangeU
  , deleteInteractivePointsU
  , setSavedFilePointU
  , isAtSavedFilePointU
  , undoU
  , redoU
  , URList             {- abstractly -}
  , Change(AtomicChange, InteractivePoint)
   ) where

import           Data.Binary              (Binary (..))
import qualified Data.Sequence as S
import           GHC.Generics             (Generic)
import           Yi.Buffer.Implementation

data Change = SavedFilePoint
            | InteractivePoint
            | AtomicChange !Update
-- !!! It's very important that the updates are forced, otherwise
-- !!! we'll keep a full copy of the buffer state for each update
-- !!! (thunk) put in the URList.
            deriving (Int -> Change -> ShowS
[Change] -> ShowS
Change -> String
(Int -> Change -> ShowS)
-> (Change -> String) -> ([Change] -> ShowS) -> Show Change
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Change] -> ShowS
$cshowList :: [Change] -> ShowS
show :: Change -> String
$cshow :: Change -> String
showsPrec :: Int -> Change -> ShowS
$cshowsPrec :: Int -> Change -> ShowS
Show, (forall x. Change -> Rep Change x)
-> (forall x. Rep Change x -> Change) -> Generic Change
forall x. Rep Change x -> Change
forall x. Change -> Rep Change x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Change x -> Change
$cfrom :: forall x. Change -> Rep Change x
Generic)
instance Binary Change

-- | A URList consists of an undo and a redo list.
data URList = URList !(S.Seq Change) !(S.Seq Change)
            deriving (Int -> URList -> ShowS
[URList] -> ShowS
URList -> String
(Int -> URList -> ShowS)
-> (URList -> String) -> ([URList] -> ShowS) -> Show URList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URList] -> ShowS
$cshowList :: [URList] -> ShowS
show :: URList -> String
$cshow :: URList -> String
showsPrec :: Int -> URList -> ShowS
$cshowsPrec :: Int -> URList -> ShowS
Show, (forall x. URList -> Rep URList x)
-> (forall x. Rep URList x -> URList) -> Generic URList
forall x. Rep URList x -> URList
forall x. URList -> Rep URList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URList x -> URList
$cfrom :: forall x. URList -> Rep URList x
Generic)
instance Binary URList

-- | A new empty 'URList'.
-- Notice we must have a saved file point as this is when we assume we are
-- opening the file so it is currently the same as the one on disk
emptyU :: URList
emptyU :: URList
emptyU = Seq Change -> Seq Change -> URList
URList (Change -> Seq Change
forall a. a -> Seq a
S.singleton Change
SavedFilePoint) Seq Change
forall a. Seq a
S.empty

-- | Add an action to the undo list.
-- According to the restricted, linear undo model, if we add a command
-- whilst the redo list is not empty, we will lose our redoable changes.
addChangeU :: Change -> URList -> URList
addChangeU :: Change -> URList -> URList
addChangeU Change
InteractivePoint (URList Seq Change
us Seq Change
rs) = Seq Change -> Seq Change -> URList
URList (Seq Change -> Seq Change
addIP Seq Change
us) Seq Change
rs
addChangeU Change
u (URList Seq Change
us Seq Change
_) = Seq Change -> Seq Change -> URList
URList (Change
u Change -> Seq Change -> Seq Change
forall a. a -> Seq a -> Seq a
S.<| Seq Change
us) Seq Change
forall a. Seq a
S.empty

deleteInteractivePointsU :: URList -> URList
deleteInteractivePointsU :: URList -> URList
deleteInteractivePointsU (URList Seq Change
us Seq Change
rs) = Seq Change -> Seq Change -> URList
URList (Seq Change -> Seq Change
go Seq Change
us) Seq Change
rs
    where
    go :: Seq Change -> Seq Change
go (Seq Change -> ViewL Change
forall a. Seq a -> ViewL a
S.viewl -> Change
InteractivePoint S.:< Seq Change
x) = Seq Change -> Seq Change
go Seq Change
x
    go Seq Change
x = Seq Change
x

-- | Add a saved file point so that we can tell that the buffer has not
-- been modified since the previous saved file point.
-- Notice that we must be sure to remove the previous saved file points
-- since they are now worthless.
setSavedFilePointU :: URList -> URList
setSavedFilePointU :: URList -> URList
setSavedFilePointU (URList Seq Change
undos Seq Change
redos) =
  Seq Change -> Seq Change -> URList
URList (Change
SavedFilePoint Change -> Seq Change -> Seq Change
forall a. a -> Seq a -> Seq a
S.<| Seq Change
cleanUndos) Seq Change
cleanRedos
  where
  cleanUndos :: Seq Change
cleanUndos = (Change -> Bool) -> Seq Change -> Seq Change
forall a. (a -> Bool) -> Seq a -> Seq a
S.filter Change -> Bool
isNotSavedFilePoint Seq Change
undos

  cleanRedos :: Seq Change
cleanRedos = (Change -> Bool) -> Seq Change -> Seq Change
forall a. (a -> Bool) -> Seq a -> Seq a
S.filter Change -> Bool
isNotSavedFilePoint Seq Change
redos

  isNotSavedFilePoint :: Change -> Bool
  isNotSavedFilePoint :: Change -> Bool
isNotSavedFilePoint Change
SavedFilePoint = Bool
False
  isNotSavedFilePoint Change
_              = Bool
True

-- | This undoes one interaction step.
undoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, S.Seq Update))
undoU :: Mark
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
undoU Mark
m = Mark
-> Seq Update
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
forall syntax.
Mark
-> Seq Update
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
undoUntilInteractive Mark
m Seq Update
forall a. Monoid a => a
mempty (URList
 -> BufferImpl syntax -> (BufferImpl syntax, (URList, Seq Update)))
-> (URList -> URList)
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URList -> URList
undoInteractive

-- | This redoes one iteraction step.
redoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, S.Seq Update))
redoU :: Mark
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
redoU = (URList
 -> BufferImpl syntax -> (BufferImpl syntax, (URList, Seq Update)))
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
forall t.
(URList -> t -> (t, (URList, Seq Update)))
-> URList -> t -> (t, (URList, Seq Update))
asRedo ((URList
  -> BufferImpl syntax -> (BufferImpl syntax, (URList, Seq Update)))
 -> URList
 -> BufferImpl syntax
 -> (BufferImpl syntax, (URList, Seq Update)))
-> (Mark
    -> URList
    -> BufferImpl syntax
    -> (BufferImpl syntax, (URList, Seq Update)))
-> Mark
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mark
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
forall syntax.
Mark
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
undoU

-- | Prepare undo by moving one interaction point from undoes to redoes.
undoInteractive :: URList -> URList
undoInteractive :: URList -> URList
undoInteractive (URList Seq Change
us Seq Change
rs) = Seq Change -> Seq Change -> URList
URList (Seq Change -> Seq Change
remIP Seq Change
us) (Seq Change -> Seq Change
addIP Seq Change
rs)

-- | Remove an initial interactive point, if there is one
remIP :: S.Seq Change -> S.Seq Change
remIP :: Seq Change -> Seq Change
remIP Seq Change
xs = case Seq Change -> ViewL Change
forall a. Seq a -> ViewL a
S.viewl Seq Change
xs of
  Change
InteractivePoint S.:< Seq Change
xs' -> Seq Change
xs'
  ViewL Change
_ -> Seq Change
xs

-- | Insert an initial interactive point, if there is none
addIP :: S.Seq Change -> S.Seq Change
addIP :: Seq Change -> Seq Change
addIP Seq Change
xs = case Seq Change -> ViewL Change
forall a. Seq a -> ViewL a
S.viewl Seq Change
xs of
  Change
InteractivePoint S.:< Seq Change
_ -> Seq Change
xs
  ViewL Change
_ -> Change
InteractivePoint Change -> Seq Change -> Seq Change
forall a. a -> Seq a -> Seq a
S.<| Seq Change
xs

-- | Repeatedly undo actions, storing away the inverse operations in the
--   redo list.
undoUntilInteractive :: Mark -> S.Seq Update -> URList -> BufferImpl syntax
                     -> (BufferImpl syntax, (URList, S.Seq Update))
undoUntilInteractive :: Mark
-> Seq Update
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
undoUntilInteractive Mark
pointMark Seq Update
xs ur :: URList
ur@(URList Seq Change
cs Seq Change
rs) BufferImpl syntax
b = case Seq Change -> ViewL Change
forall a. Seq a -> ViewL a
S.viewl Seq Change
cs of
  ViewL Change
S.EmptyL -> (BufferImpl syntax
b, (URList
ur, Seq Update
xs))
  Change
SavedFilePoint S.:< (Seq Change -> ViewL Change
forall a. Seq a -> ViewL a
S.viewl -> ViewL Change
S.EmptyL) -> (BufferImpl syntax
b, (URList
ur, Seq Update
xs)) -- Why this special case?
  Change
InteractivePoint S.:< Seq Change
_ -> (BufferImpl syntax
b, (URList
ur, Seq Update
xs))
  Change
SavedFilePoint S.:< Seq Change
cs' ->
    Mark
-> Seq Update
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
forall syntax.
Mark
-> Seq Update
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
undoUntilInteractive Mark
pointMark Seq Update
xs (Seq Change -> Seq Change -> URList
URList Seq Change
cs' (Change
SavedFilePoint Change -> Seq Change -> Seq Change
forall a. a -> Seq a -> Seq a
S.<| Seq Change
rs)) BufferImpl syntax
b
  AtomicChange Update
u S.:< Seq Change
cs' ->
    let ur' :: URList
ur' = Seq Change -> Seq Change -> URList
URList Seq Change
cs' (Update -> Change
AtomicChange (Update -> Update
reverseUpdateI Update
u) Change -> Seq Change -> Seq Change
forall a. a -> Seq a -> Seq a
S.<| Seq Change
rs)
        b' :: BufferImpl syntax
b' = Update -> BufferImpl syntax -> BufferImpl syntax
forall syntax. Update -> BufferImpl syntax -> BufferImpl syntax
applyUpdateWithMoveI Update
u BufferImpl syntax
b
        (BufferImpl syntax
b'', (URList
ur'', Seq Update
xs')) = Mark
-> Seq Update
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
forall syntax.
Mark
-> Seq Update
-> URList
-> BufferImpl syntax
-> (BufferImpl syntax, (URList, Seq Update))
undoUntilInteractive Mark
pointMark Seq Update
xs URList
ur' BufferImpl syntax
b'
    in (BufferImpl syntax
b'', (URList
ur'', Update
u Update -> Seq Update -> Seq Update
forall a. a -> Seq a -> Seq a
S.<| Seq Update
xs'))
    where
      -- Apply a /valid/ update and also move point in buffer to update position
      applyUpdateWithMoveI :: Update -> BufferImpl syntax -> BufferImpl syntax
      applyUpdateWithMoveI :: Update -> BufferImpl syntax -> BufferImpl syntax
applyUpdateWithMoveI Update
upd = case Update -> Direction
updateDirection Update
upd of
                                 Direction
Forward ->  BufferImpl syntax -> BufferImpl syntax
forall syntax. BufferImpl syntax -> BufferImpl syntax
apply (BufferImpl syntax -> BufferImpl syntax)
-> (BufferImpl syntax -> BufferImpl syntax)
-> BufferImpl syntax
-> BufferImpl syntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferImpl syntax -> BufferImpl syntax
forall syntax. BufferImpl syntax -> BufferImpl syntax
move
                                 Direction
Backward -> BufferImpl syntax -> BufferImpl syntax
forall syntax. BufferImpl syntax -> BufferImpl syntax
move (BufferImpl syntax -> BufferImpl syntax)
-> (BufferImpl syntax -> BufferImpl syntax)
-> BufferImpl syntax
-> BufferImpl syntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferImpl syntax -> BufferImpl syntax
forall syntax. BufferImpl syntax -> BufferImpl syntax
apply
          where move :: BufferImpl syntax -> BufferImpl syntax
move = Mark
-> (MarkValue -> MarkValue)
-> forall syntax. BufferImpl syntax -> BufferImpl syntax
modifyMarkBI Mark
pointMark (\MarkValue
v -> MarkValue
v {markPoint :: Point
markPoint = Update -> Point
updatePoint Update
u})
                apply :: BufferImpl syntax -> BufferImpl syntax
apply = Update -> BufferImpl syntax -> BufferImpl syntax
forall syntax. Update -> BufferImpl syntax -> BufferImpl syntax
applyUpdateI Update
u

-- | Run the undo-function @f@ on a swapped URList making it
--   operate in a redo fashion instead of undo.
asRedo :: (URList -> t -> (t, (URList, S.Seq Update))) -> URList -> t
       -> (t, (URList, S.Seq Update))
asRedo :: (URList -> t -> (t, (URList, Seq Update)))
-> URList -> t -> (t, (URList, Seq Update))
asRedo URList -> t -> (t, (URList, Seq Update))
f URList
ur t
x = let (t
y,(URList
ur',Seq Update
rs)) = URList -> t -> (t, (URList, Seq Update))
f (URList -> URList
swapUndoRedo URList
ur) t
x
                in (t
y,(URList -> URList
swapUndoRedo URList
ur',Seq Update
rs))
  where
    swapUndoRedo :: URList -> URList
    swapUndoRedo :: URList -> URList
swapUndoRedo (URList Seq Change
us Seq Change
rs) = Seq Change -> Seq Change -> URList
URList Seq Change
rs Seq Change
us

-- | undoIsAtSavedFilePoint. @True@ if the undo list is at a SavedFilePoint indicating
--   that the buffer has not been modified since we last saved the file.
-- Note: that an empty undo list does NOT mean that the buffer is not modified since
-- the last save. Because we may have saved the file and then undone actions done before
-- the save.
isAtSavedFilePointU :: URList -> Bool
isAtSavedFilePointU :: URList -> Bool
isAtSavedFilePointU (URList Seq Change
us Seq Change
_) = Seq Change -> Bool
isUnchanged Seq Change
us
  where
    isUnchanged :: Seq Change -> Bool
isUnchanged Seq Change
cs = case Seq Change -> ViewL Change
forall a. Seq a -> ViewL a
S.viewl Seq Change
cs of
      ViewL Change
S.EmptyL                  -> Bool
False
      Change
SavedFilePoint S.:< Seq Change
_     -> Bool
True
      Change
InteractivePoint S.:< Seq Change
cs' -> Seq Change -> Bool
isUnchanged Seq Change
cs'
      ViewL Change
_                         -> Bool
False