mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-06 15:23:37 +00:00
88 lines
2.4 KiB
Haskell
88 lines
2.4 KiB
Haskell
module MetaBrush.Document.History
|
|
( DocumentHistory(..)
|
|
, back, fwd, newHistory, newFutureStep
|
|
, atStart, atEnd
|
|
, affirmPresent
|
|
)
|
|
where
|
|
|
|
-- base
|
|
import GHC.Generics
|
|
( Generic )
|
|
|
|
-- containers
|
|
import Data.Sequence
|
|
( Seq(..) )
|
|
import qualified Data.Sequence as Seq
|
|
( length, drop )
|
|
|
|
-- deepseq
|
|
import Control.DeepSeq
|
|
( NFData(..), deepseq )
|
|
|
|
-- generic-lens
|
|
import Data.Generics.Product.Fields
|
|
( field' )
|
|
|
|
-- lens
|
|
import Control.Lens
|
|
( set )
|
|
|
|
-- MetaBrush
|
|
import MetaBrush.Document
|
|
( Document(..), DocumentContent(..) )
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
data DocumentHistory
|
|
= History
|
|
{ past :: !( Seq DocumentContent )
|
|
, present :: !Document
|
|
, future :: ![ DocumentContent ]
|
|
}
|
|
deriving stock ( Show, Generic )
|
|
instance NFData DocumentHistory where
|
|
rnf ( History { past = ps, present, future } ) =
|
|
ps `deepseq` present `deepseq` future `deepseq` ()
|
|
|
|
back :: DocumentHistory -> DocumentHistory
|
|
back hist@( History { past = ps, present = c, future = fs } ) = case ps of
|
|
Empty -> hist
|
|
qs :|> q -> History { past = qs, present = c { documentContent = q }, future = documentContent c : fs }
|
|
|
|
fwd :: DocumentHistory -> DocumentHistory
|
|
fwd hist@( History { past = ps, present = c, future = fs } ) = case fs of
|
|
[] -> hist
|
|
g : gs -> History { past = ps :|> documentContent c, present = c { documentContent = g }, future = gs }
|
|
|
|
newHistory :: Document -> DocumentHistory
|
|
newHistory a = History { past = Empty, present = a, future = [] }
|
|
|
|
newFutureStep :: Int -> Document -> DocumentHistory -> DocumentHistory
|
|
newFutureStep maxPastDocs a ( History { past = ps, present = c } ) =
|
|
History
|
|
{ past = Seq.drop ( n - maxPastDocs ) ( ps :|> documentContent c )
|
|
, present = a
|
|
, future = []
|
|
}
|
|
where
|
|
n :: Int
|
|
n = 1 + Seq.length ps
|
|
|
|
|
|
|
|
atStart, atEnd :: DocumentHistory -> Bool
|
|
atStart hist = null ( past hist )
|
|
atEnd hist = null ( future hist )
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
affirmPresent :: DocumentHistory -> DocumentHistory
|
|
affirmPresent
|
|
= set ( field' @"past" . traverse . field' @"unsavedChanges" )
|
|
True
|
|
. set ( field' @"present" . field' @"documentContent" . field' @"unsavedChanges" )
|
|
False
|
|
. set ( field' @"future" . traverse . field' @"unsavedChanges" )
|
|
True
|