Add new Reverse Frame concept for Undo/Redo

elm/Components/Replicator.elm

@@ -1,13 +1,15 @@
 module Components.Replicator exposing (..)
 
 import Console
+import Dict.Any as AnyDict exposing (AnyDict)
 import Log
 import Maybe.Extra
 import Platform exposing (Task)
 import Replicated.Change as Change
 import Replicated.Codec as Codec exposing (SkelCodec)
 import Replicated.Node.Node as Node exposing (Node, OpImportWarning)
 import Replicated.Op.Op as Op
+import Replicated.Op.OpID as OpID
 import SmartTime.Moment as Moment exposing (Moment)
 import Task
 
@@ -20,6 +22,7 @@ type Replicator replica frameDesc
         , replicaCodec : SkelCodec ReplicaError replica
         , replica : replica
         , outPort : String -> Cmd (Msg frameDesc)
+        , history : AnyDict OpID.OpIDSortable OpID.OpID (Change.ReverseFrame frameDesc)
         }
 
 
@@ -51,6 +54,7 @@ init { launchTime, replicaCodec, outPort } =
         , replicaCodec = replicaCodec
         , replica = startReplica
         , outPort = outPort
+        , history = AnyDict.empty OpID.toSortablePrimitives
         }
     , startReplica
     )
@@ -113,19 +117,31 @@ update msg (ReplicatorModel oldReplicator) =
 
         ApplyFrames newFrames newTime ->
             let
-                ( nodeWithUpdates, finalOutputFrame ) =
-                    List.foldl applyFrame ( oldReplicator.node, [] ) newFrames
+                ( nodeWithUpdates, finalOutputFrame, ( allNowReversed, allFutureReverseFrames ) ) =
+                    List.foldl applyFrame ( oldReplicator.node, [], ( [], [] ) ) newFrames
 
-                applyFrame givenFrame ( inNode, outputsSoFar ) =
+                applyFrame givenFrame ( inNode, outputsSoFar, ( nowReversedPrior, reversibleFrames ) ) =
                     let
-                        { outputFrame, updatedNode } =
+                        { outputFrame, updatedNode, outputReverseFrameMaybe, nowReversed } =
                             Node.apply (Just newTime) False inNode givenFrame
                     in
-                    ( updatedNode, outputsSoFar ++ outputFrame )
+                    ( updatedNode, outputsSoFar ++ outputFrame, ( nowReversed ++ nowReversedPrior, reversibleFrames ++ Maybe.Extra.toList outputReverseFrameMaybe ) )
+
+                historyWithNewFutureReverseFrames1 =
+                    List.foldl (\rf hist -> AnyDict.insert (Change.getReverseFrameID rf) rf hist) oldReplicator.history allFutureReverseFrames
+
+                historyWithReversalsApplied2 =
+                    List.foldl (\rfID hist -> AnyDict.update rfID (Maybe.map Change.markReversal) hist) historyWithNewFutureReverseFrames1 allNowReversed
             in
             case Codec.decodeFromNode oldReplicator.replicaCodec nodeWithUpdates of
                 Ok updatedUserReplica ->
-                    { newReplicator = ReplicatorModel { oldReplicator | node = nodeWithUpdates, replica = updatedUserReplica }
+                    { newReplicator =
+                        ReplicatorModel
+                            { oldReplicator
+                                | node = nodeWithUpdates
+                                , replica = updatedUserReplica
+                                , history = historyWithReversalsApplied2
+                            }
                     , newReplica = updatedUserReplica
                     , warnings = []
                     , cmd = Cmd.batch [ oldReplicator.outPort (Op.closedChunksToFrameText finalOutputFrame) ]

elm/Replicated/Change.elm

@@ -1,4 +1,4 @@
-module Replicated.Change exposing (Change(..), ChangeSet(..), Changer, ComplexAtom(..), ComplexPayload, Context(..), Creator, DelayedChange, ExistingID, Frame(..), ObjectChange(..), Parent, PendingID, Pointer(..), PrimitiveAtom(..), PrimitivePayload, SoloObjectEncoded, becomeDelayedParent, becomeInstantParent, changeObject, changeObjectWithExternal, changeSetDebug, collapseChangesToChangeSet, complexFromSolo, contextDifferentiatorString, delayedChangeObject, delayedChangesToSets, emptyChangeSet, emptyFrame, equalPointers, extractOwnSubChanges, genesisParent, getContextLocation, getContextParent, getObjectChanges, getPointerObjectID, getPointerReducer, isEmptyChangeSet, isPlaceholder, mapChanger, mapCreator, mergeChanges, mergeMaybeChange, newPointer, noChange, nonEmptyFrames, pendingIDToComparable, pendingIDToString, primitiveAtomToRonAtom, primitiveAtomToString, redundantObjectChange, reuseContext, saveSystemChanges, saveUserChanges, startContext)
+module Replicated.Change exposing (Change(..), ChangeSet(..), Changer, ComplexAtom(..), ComplexPayload, Context(..), Creator, DelayedChange, ExistingID, Frame(..), ObjectChange(..), Parent, PendingID, Pointer(..), PrimitiveAtom(..), PrimitivePayload, ReverseFrame, SoloObjectEncoded, becomeDelayedParent, becomeInstantParent, changeObject, changeObjectWithExternal, changeSetDebug, collapseChangesToChangeSet, complexFromSolo, contextDifferentiatorString, createReverseFrame, delayedChangeObject, delayedChangesToSets, emptyChangeSet, emptyFrame, equalPointers, extractOwnSubChanges, genesisParent, getContextLocation, getContextParent, getObjectChanges, getPointerObjectID, getPointerReducer, getReverseFrameID, isEmptyChangeSet, isPlaceholder, mapChanger, mapCreator, markReversal, mergeChanges, mergeMaybeChange, newPointer, noChange, nonEmptyFrames, pendingIDToComparable, pendingIDToString, primitiveAtomToRonAtom, primitiveAtomToString, redundantObjectChange, reuseContext, reverseFrameToChangeFrame, saveSystemChanges, saveUserChanges, startContext)
 
 import Console
 import Dict.Any as AnyDict exposing (AnyDict)
@@ -14,15 +14,12 @@ import Replicated.Op.OpID as OpID exposing (ObjectID, OpID)
 import Result.Extra
 
 
-{-| Represents a _POTENTIAL_ change to the node - if you have one, you can "apply" your pending changes to make actual modifications to your model.
-
-Outputs a Chunk - Chunks are same-object changes within a Frame.
-
--}
 type ChangeSet
     = ChangeSet ChangeSetDetails
 
 
+{-| Represents a _POTENTIAL_ change to the node - if you have one, you can "apply" your pending changes to make actual modifications to your model.
+-}
 type Change
     = WithFrameIndex (Location -> ChangeSet)
 
@@ -510,7 +507,7 @@ isEmptyChangeSet (ChangeSet details) =
 
 extractOwnSubChanges : Pointer -> List Change -> { earlier : ChangeSet, mine : List ObjectChange, later : ChangeSet }
 extractOwnSubChanges pointer changeList =
-    -- TODO FIXME
+    -- TODO no longer needed?
     -- ideally this would find changes that directly modify nested objects, and turn them into QuoteNestedObject references, with full nested contents, rather than just a pending ref and a delayed installer for the object that's already being created anyway. this optimizes op order.
     let
         supplyIndexToChange index (WithFrameIndex toChangeSet) =
@@ -625,24 +622,25 @@ type Frame desc
     = Frame
         { changes : ChangeSet
         , description : Maybe desc
+        , reversedFrames : List OpID
         }
 
 
 saveUserChanges : desc -> List Change -> Frame desc
 saveUserChanges description changes =
-    Frame { changes = collapseChangesToChangeSet "save" changes, description = Just description }
+    Frame { changes = collapseChangesToChangeSet "save" changes, description = Just description, reversedFrames = [] }
 
 
 saveSystemChanges : List Change -> Frame desc
 saveSystemChanges changes =
-    Frame { changes = collapseChangesToChangeSet "save" changes, description = Nothing }
+    Frame { changes = collapseChangesToChangeSet "save" changes, description = Nothing, reversedFrames = [] }
 
 
 {-| An empty Frame, for when you have no changes to save.
 -}
 emptyFrame : Frame desc
 emptyFrame =
-    Frame { changes = emptyChangeSet, description = Nothing }
+    Frame { changes = emptyChangeSet, description = Nothing, reversedFrames = [] }
 
 
 isEmpty : Frame desc -> Bool
@@ -655,7 +653,62 @@ nonEmptyFrames frames =
     List.filter (not << isEmpty) frames
 
 
+type ReverseFrame desc
+    = ReverseFrame
+        { description : desc
+        , ops : Nonempty Op
+        , undone : Bool
+        }
+
+
+createReverseFrame : List Op -> desc -> Maybe (ReverseFrame desc)
+createReverseFrame opsToReverse description =
+    let
+        reverseFrame nonemptyOpsToReverse =
+            ReverseFrame
+                { description = description
+                , ops = nonemptyOpsToReverse
+                , undone = False
+                }
+    in
+    Maybe.map reverseFrame (Nonempty.fromList opsToReverse)
+
+
+getReverseFrameID : ReverseFrame desc -> OpID
+getReverseFrameID (ReverseFrame reverseFrame) =
+    Nonempty.head reverseFrame.ops
+        |> Op.id
+
+
+markReversal : ReverseFrame desc -> ReverseFrame desc
+markReversal (ReverseFrame reverseFrameRec) =
+    ReverseFrame { reverseFrameRec | undone = not reverseFrameRec.undone }
+
+
+reverseFrameToChangeFrame : ReverseFrame desc -> Frame desc
+reverseFrameToChangeFrame (ReverseFrame reverseFrame) =
+    let
+        changeSet =
+            ChangeSet
+                { objectsToCreate = emptyObjectsToCreate
+                , existingObjectChanges = Nonempty.foldl addOpToChangeSet emptyExistingObjectChanges reverseFrame.ops
+                , delayed = []
+                , opsToRepeat = emptyOpsToRepeat
+                }
+
+        addOpToChangeSet op existingObjectChanges =
+            let
+                existingID =
+                    ExistingID (Op.reducer op) (Op.object op)
+            in
+            -- AnyDict ( Op.ReducerID, OpID.ObjectIDString ) ExistingID (List ObjectChange)
+            AnyDict.insert existingID [ RevertOp (Op.id op) ] existingObjectChanges
+    in
+    Frame { changes = changeSet, description = Nothing, reversedFrames = [ Nonempty.head reverseFrame.ops |> Op.id ] }
+
+
 
+--Frame { changes = emptyChangeSet, description = Nothing, opsToReverse = opsToReverse }
 -- POINTERS -----------------------------------------------------------------
 
 

elm/Replicated/Node/Node.elm

@@ -3,6 +3,7 @@ module Replicated.Node.Node exposing (..)
 import Console
 import Dict exposing (Dict)
 import Dict.Any as AnyDict exposing (AnyDict)
+import Element.Region exposing (description)
 import Json.Encode as JE
 import List.Extra as List
 import List.Nonempty as Nonempty exposing (Nonempty(..))
@@ -343,8 +344,19 @@ Always supply the current time (`Just moment`).
 (Else, new Ops will be timestamped as if they occurred mere milliseconds after the previous save, which can cause them to always be considered "older" than other ops that happened between.)
 If the clock is set backwards or another node loses track of time, we will never go backwards in timestamps.
 -}
-apply : Maybe Moment -> Bool -> Node -> Change.Frame desc -> { outputFrame : List Op.ClosedChunk, updatedNode : Node, created : List ObjectID }
-apply timeMaybe testMode node (Change.Frame { changes, description }) =
+apply :
+    Maybe Moment
+    -> Bool
+    -> Node
+    -> Change.Frame desc
+    ->
+        { outputFrame : List Op.ClosedChunk
+        , updatedNode : Node
+        , created : List ObjectID
+        , outputReverseFrameMaybe : Maybe (Change.ReverseFrame desc)
+        , nowReversed : List OpID
+        }
+apply timeMaybe testMode node (Change.Frame { changes, description, reversedFrames }) =
     let
         nextUnseenCounter =
             OpID.importCounter (node.highestSeenClock + 1)
@@ -381,6 +393,9 @@ apply timeMaybe testMode node (Change.Frame { changes, description }) =
         ( ( step2OutCounter, step2OutMapping ), step2OutChunks ) =
             List.mapAccuml (oneChangeSetToOpChunks node) ( step1OutCounter, { step1OutMapping | delayed = [] } ) delayedChangeSets
 
+        -- -- Step 3. Process User Undo/Redo ops
+        -- ( step3OutCounter, _) =
+        --     List.mapAccuml createReversionOp step2OutCounter reversions
         outChunks =
             step1OutChunks ++ List.concat step2OutChunks
 
@@ -415,11 +430,17 @@ apply timeMaybe testMode node (Change.Frame { changes, description }) =
                 , [ "Delayed Updates:" ]
                 , [ Op.closedChunksToFrameText (List.concat step2OutChunks) ]
                 ]
+
+        reverseFrameMaybe =
+            -- If this is a user frame (has description), build a reversal in case the user wants to undo
+            Maybe.andThen (Change.createReverseFrame (getReversibleOps allGeneratedOps)) description
     in
     Log.logMessageOnly logApplyResults
         { outputFrame = outChunks
         , updatedNode = finalNode
         , created = newObjectsCreated
+        , outputReverseFrameMaybe = reverseFrameMaybe
+        , nowReversed = reversedFrames
         }
 
 
@@ -437,6 +458,34 @@ creationOpsToObjectIDs ops =
     List.filterMap getCreationIDs ops
 
 
+{-| Get the IDs of the ops that are reversible
+-}
+getReversibleOps : List Op -> List Op
+getReversibleOps ops =
+    let
+        getCreationIDs op =
+            case Op.pattern op of
+                Op.NormalOp ->
+                    Just op
+
+                Op.DeletionOp ->
+                    Just op
+
+                Op.UnDeletionOp ->
+                    Just op
+
+                Op.CreationOp ->
+                    Nothing
+
+                Op.Annotation ->
+                    Nothing
+
+                Op.Acknowledgement ->
+                    Nothing
+    in
+    List.filterMap getCreationIDs ops
+
+
 {-| Collects info on what ObjectIDs map back to what placeholder IDs from before they were initialized. In case we want to reference the new object same-frame.
 Use with Change.pendingIDToString
 -}
@@ -451,6 +500,16 @@ keepChangeSetIfNonempty changeSetMaybe =
     Maybe.Extra.filter (not << Change.isEmptyChangeSet) changeSetMaybe
 
 
+
+-- createReversionOp : InCounter -> OpID -> (OutCounter, Op)
+-- createReversionOp inCounter opIDToReverse =
+--     let
+--         ( newID, stampOutCounter ) =
+--             OpID.generate stampInCounter node.identity givenUCO.reversion
+--     in
+--     Op.cr
+
+
 {-| Passed to mapAccuml, so must have accumulator and change as last params
 -}
 oneChangeSetToOpChunks :