    {-# 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 originally 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 partially
    -- >    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
    $cshowsPrec :: Int -> Change -> ShowS
    showsPrec :: Int -> Change -> ShowS
    $cshow :: Change -> String
    show :: Change -> String
    $cshowList :: [Change] -> ShowS
    showList :: [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
    $cfrom :: forall x. Change -> Rep Change x
    from :: forall x. Change -> Rep Change x
    $cto :: forall x. Rep Change x -> Change
    to :: forall x. Rep Change x -> Change
    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
    $cshowsPrec :: Int -> URList -> ShowS
    showsPrec :: Int -> URList -> ShowS
    $cshow :: URList -> String
    show :: URList -> String
    $cshowList :: [URList] -> ShowS
    showList :: [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
    $cfrom :: forall x. URList -> Rep URList x
    from :: forall x. URList -> Rep URList x
    $cto :: forall x. Rep URList x -> URList
    to :: forall x. Rep URList x -> URList
    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 :: forall syntax.
    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 interaction step.
    redoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, S.Seq Update))
    redoU :: forall syntax.
    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 :: forall syntax.
    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 :: forall syntax. 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 = updatePoint 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 :: forall t.
    (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