mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-06 07:13:37 +00:00
111 lines
2.9 KiB
Haskell
111 lines
2.9 KiB
Haskell
module MetaBrush.Document.History
|
|
( DocumentHistory(..)
|
|
, Do(..)
|
|
, back, fwd, newHistory, newFutureStep
|
|
, atStart, atEnd
|
|
, affirmPresentSaved
|
|
)
|
|
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 )
|
|
import Control.Lens.Tuple
|
|
( _1, _2 )
|
|
|
|
-- MetaBrush
|
|
import MetaBrush.Document
|
|
( Document(..), DocumentContent(..) )
|
|
import MetaBrush.Document.Diff
|
|
( HistoryDiff )
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
data DocumentHistory
|
|
= History
|
|
{ past :: !( Seq ( DocumentContent, HistoryDiff ) )
|
|
, present :: !Document
|
|
, future :: ![ ( HistoryDiff, DocumentContent ) ]
|
|
}
|
|
deriving stock ( Show, Generic )
|
|
instance NFData DocumentHistory where
|
|
rnf ( History { past = ps, present, future } ) =
|
|
ps `deepseq` present `deepseq` future `deepseq` ()
|
|
|
|
-- | Do or undo?
|
|
data Do = Do | Undo
|
|
deriving stock ( Eq, Show )
|
|
|
|
back :: DocumentHistory -> Maybe ( DocumentHistory, ( Do, HistoryDiff ) )
|
|
back ( History { past = ps, present = c, future = fs } ) = case ps of
|
|
Empty
|
|
-> Nothing
|
|
qs :|> ( q, diff )
|
|
-> Just
|
|
( History { past = qs
|
|
, present = c { documentContent = q }
|
|
, future = ( diff, documentContent c ) : fs }
|
|
, ( Undo, diff )
|
|
)
|
|
|
|
fwd :: DocumentHistory -> Maybe ( DocumentHistory, ( Do, HistoryDiff ) )
|
|
fwd ( History { past = ps, present = c, future = fs } ) = case fs of
|
|
[]
|
|
-> Nothing
|
|
( diff, g ) : gs
|
|
-> Just
|
|
( History { past = ps :|> ( documentContent c, diff )
|
|
, present = c { documentContent = g }
|
|
, future = gs }
|
|
, ( Do, diff )
|
|
)
|
|
|
|
newHistory :: Document -> DocumentHistory
|
|
newHistory a = History { past = Empty, present = a, future = [] }
|
|
|
|
newFutureStep :: Int -> HistoryDiff -> Document -> DocumentHistory -> DocumentHistory
|
|
newFutureStep maxPastDocs diff a ( History { past = ps, present = c } ) =
|
|
History
|
|
{ past = Seq.drop ( n - maxPastDocs ) ( ps :|> ( documentContent c, diff ) )
|
|
, 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 )
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
affirmPresentSaved :: DocumentHistory -> DocumentHistory
|
|
affirmPresentSaved
|
|
= set ( field' @"past" . traverse . _1 . field' @"unsavedChanges" )
|
|
True
|
|
. set ( field' @"present" . field' @"documentContent" . field' @"unsavedChanges" )
|
|
False
|
|
. set ( field' @"future" . traverse . _2 . field' @"unsavedChanges" )
|
|
True
|