{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Yi.Buffer.Undo (
emptyU
, addChangeU
, deleteInteractivePointsU
, setSavedFilePointU
, isAtSavedFilePointU
, undoU
, redoU
, URList
, 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
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
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
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
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
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
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
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
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)
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
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
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))
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
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
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
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