Overhaul UndoRedo Frame system

TODO.md

@@ -8,6 +8,13 @@
 - Why is parent init change not required?
 - Put showstopper RON debugger in place
 - Rename RepStore to RepDictSparse
+- Put OpDb in its own type file
+
+- UNDO/REDO Framework
+    - Create ReversibleOps type - `List OpID` of reversible ops
+    - Allow output of changes with ReversibleOps placeholder as value
+    - When converting changes to ops, fill in any ReversibleOps placeholder with the frame's reversible OpIDs
+    - When converting reversal changes to reversal ops, calculate OpIDs' ExistingObjectIDs and merge into ChangeSets
 
 
 # Task list

elm.json

@@ -51,6 +51,7 @@
             "rtfeldman/elm-css": "18.0.0",
             "sporto/time-distance": "1.0.1",
             "turboMaCk/any-dict": "2.6.0",
+            "turboMaCk/any-set": "1.6.0",
             "zwilias/json-decode-exploration": "6.0.0"
         },
         "indirect": {

elm/Components/Replicator.elm

@@ -22,7 +22,6 @@ type Replicator replica frameDesc
         , replicaCodec : SkelCodec ReplicaError replica
         , replica : replica
         , outPort : String -> Cmd (Msg frameDesc)
-        , history : AnyDict OpID.OpIDSortable OpID.OpID (Change.ReverseFrame frameDesc)
         }
 
 
@@ -54,7 +53,6 @@ init { launchTime, replicaCodec, outPort } =
         , replicaCodec = replicaCodec
         , replica = startReplica
         , outPort = outPort
-        , history = AnyDict.empty OpID.toSortablePrimitives
         }
     , startReplica
     )
@@ -117,31 +115,19 @@ update msg (ReplicatorModel oldReplicator) =
 
         ApplyFrames newFrames newTime ->
             let
-                ( nodeWithUpdates, finalOutputFrame, ( allNowReversed, allFutureReverseFrames ) ) =
-                    List.foldl applyFrame ( oldReplicator.node, [], ( [], [] ) ) newFrames
+                ( nodeWithUpdates, finalOutputFrame ) =
+                    List.foldl applyFrame ( oldReplicator.node, [] ) newFrames
 
-                applyFrame givenFrame ( inNode, outputsSoFar, ( nowReversedPrior, reversibleFrames ) ) =
+                applyFrame givenFrame ( inNode, outputsSoFar ) =
                     let
-                        { outputFrame, updatedNode, outputReverseFrameMaybe, nowReversed } =
+                        { outputFrame, updatedNode } =
                             Node.apply (Just newTime) False inNode givenFrame
                     in
-                    ( 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
+                    ( updatedNode, outputsSoFar ++ outputFrame )
             in
             case Codec.decodeFromNode oldReplicator.replicaCodec nodeWithUpdates of
                 Ok updatedUserReplica ->
-                    { newReplicator =
-                        ReplicatorModel
-                            { oldReplicator
-                                | node = nodeWithUpdates
-                                , replica = updatedUserReplica
-                                , history = historyWithReversalsApplied2
-                            }
+                    { newReplicator = ReplicatorModel { oldReplicator | node = nodeWithUpdates, replica = updatedUserReplica }
                     , newReplica = updatedUserReplica
                     , warnings = []
                     , cmd = Cmd.batch [ oldReplicator.outPort (Op.closedChunksToFrameText finalOutputFrame) ]
@@ -196,3 +182,6 @@ saveEffect framesToSave =
 
         _ ->
             Task.perform (ApplyFrames framesToSave) Moment.now
+
+
+

elm/Pages/Undo.elm

@@ -1,13 +1,19 @@
 module Pages.Undo exposing (Model, Msg, page)
 
+import Components.Replicator as Replicator exposing (Replicator)
+import Css exposing (..)
+import Dict.Any as AnyDict exposing (AnyDict)
 import Effect exposing (Effect)
 import Html.Attributes as HA
+import Html.Events as HE
 import Html.Styled as SH exposing (..)
-import Html.Styled.Attributes exposing (attribute)
+import Html.Styled.Attributes exposing (attribute, css)
+import Html.Styled.Events as SHE
 import Ion.Button
 import Ion.Icon
 import Layouts
 import Page exposing (Page)
+import Replicated.Change as Change
 import Route exposing (Route)
 import Shared
 import View exposing (View)
@@ -53,6 +59,7 @@ init () =
 
 type Msg
     = NoOp
+    | Undo (Change.Frame String)
 
 
 update : Msg -> Model -> ( Model, Effect Msg )
@@ -63,6 +70,9 @@ update msg model =
             , Effect.none
             )
 
+        Undo frame ->
+            ( model, Effect.saveFrame frame )
+
 
 
 -- SUBSCRIPTIONS
@@ -79,16 +89,25 @@ subscriptions model =
 
 view : Shared.Model -> Model -> View Msg
 view shared model =
-    let
-        viewChange profileChange =
-            node "ion-item"
-                []
-                [ text (Shared.profileChangeToString profileChange)
-                , SH.fromUnstyled <| Ion.Button.button [ HA.attribute "slot" "end" ] [ Ion.Icon.basic "arrow-undo-circle-outline" ]
-                ]
-    in
     { title = "UI History (undo)"
     , body =
-        [ node "ion-list" [] (List.map viewChange shared.uiHistory)
+        [ node "ion-list" [] []
         ]
     }
+
+
+viewHistoryFrame : { description : String, reverse : Change.Frame String, undone : Bool } -> Html Msg
+viewHistoryFrame historyItem =
+    let
+        itemAttr =
+            if historyItem.undone then
+                [ css [ textDecoration lineThrough ] ]
+
+            else
+                []
+    in
+    node "ion-item"
+        []
+        [ span itemAttr [ text <| historyItem.description ]
+        , SH.fromUnstyled <| Ion.Button.button [ HA.attribute "slot" "end", HE.onClick (Undo historyItem.reverse) ] [ Ion.Icon.basic "arrow-undo-circle-outline" ]
+        ]

elm/Replicated/Change.elm

@@ -1,7 +1,8 @@
-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)
+module Replicated.Change exposing (Change(..), ChangeSet(..), Changer, ComplexAtom(..), ComplexPayload, Context(..), Creator, DelayedChange, ExistingID, Frame(..), ObjectChange(..), Parent, PendingID, Pointer(..), PrimitiveAtom(..), PrimitivePayload, SoloObjectEncoded, UndoData, becomeDelayedParent, becomeInstantParent, changeObject, changeObjectWithExternal, changeSetDebug, collapseChangesToChangeSet, complexFromSolo, contextDifferentiatorString, createReversionFrame, 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)
 
 import Console
 import Dict.Any as AnyDict exposing (AnyDict)
+import Set.Any as AnySet exposing (AnySet)
 import Html exposing (del)
 import Json.Encode as JE
 import List.Extra
@@ -86,9 +87,6 @@ mergeChanges (ChangeSet changeSetLater) (ChangeSet changeSetEarlier) =
             -- later-specified changes should be added at bottom of list for correct precedence
             unionCombine emptyExistingObjectChanges changeSetEarlier.existingObjectChanges changeSetLater.existingObjectChanges
         , delayed = changeSetEarlier.delayed ++ changeSetLater.delayed
-        , opsToRepeat =
-            -- on collision, preference is given to later set, though ops should never differ
-            AnyDict.union changeSetLater.opsToRepeat changeSetEarlier.opsToRepeat
         }
 
 
@@ -101,12 +99,13 @@ mergeMaybeChange maybeChange change =
         Nothing ->
             change
 
-
+{-| Set of all changes to make.
+Decision: real changes only, no repeated ops. Ops to be reverted are specified at the frame level.
+-}
 type alias ChangeSetDetails =
     { objectsToCreate : AnyDict (List String) PendingID (List ObjectChange)
     , existingObjectChanges : AnyDict ( Op.ReducerID, OpID.ObjectIDString ) ExistingID (List ObjectChange)
     , delayed : List DelayedChange
-    , opsToRepeat : OpDb
     }
 
 
@@ -128,13 +127,12 @@ emptyChangeSet =
         { objectsToCreate = emptyObjectsToCreate
         , existingObjectChanges = emptyExistingObjectChanges
         , delayed = []
-        , opsToRepeat = emptyOpsToRepeat
         }
 
 
-emptyOpsToRepeat : AnyDict OpID.OpIDSortable OpID Op
-emptyOpsToRepeat =
-    AnyDict.empty OpID.toSortablePrimitives
+emptyOpIDSet : AnySet OpID.OpIDSortable OpID
+emptyOpIDSet =
+    AnySet.empty OpID.toSortablePrimitives
 
 
 emptyExistingObjectChanges =
@@ -288,15 +286,13 @@ delayedChangesToSets delayed =
                         { objectsToCreate = AnyDict.empty pendingIDToComparable
                         , existingObjectChanges = AnyDict.singleton existingID givenObjectChanges existingIDToComparable
                         , delayed = []
-                        , opsToRepeat = emptyOpsToRepeat
                         }
 
                 PlaceholderPointer pendingID _ ->
                     ChangeSet <|
                         { objectsToCreate = AnyDict.singleton pendingID givenObjectChanges pendingIDToComparable
                         , existingObjectChanges = AnyDict.empty existingIDToComparable
                         , delayed = []
-                        , opsToRepeat = emptyOpsToRepeat
                         }
     in
     List.map delayedGroupToChangeSet groupedByPointer
@@ -314,8 +310,8 @@ delayedChangeObject target objectChange =
 -- CHANGE MISC --------------------------------------------------
 
 
-type alias OpDb =
-    AnyDict OpID.OpIDSortable OpID Op
+type alias OpIDSet =
+    AnySet OpID.OpIDSortable OpID
 
 
 type alias Changer o =
@@ -481,7 +477,6 @@ changeObjectWithExternal { target, objectChanges, externalUpdates } =
                         { objectsToCreate = AnyDict.empty pendingIDToComparable
                         , existingObjectChanges = AnyDict.singleton existingID objectChanges existingIDToComparable
                         , delayed = []
-                        , opsToRepeat = AnyDict.empty OpID.toSortablePrimitives
                         }
                         |> withExternalChanges
 
@@ -490,7 +485,6 @@ changeObjectWithExternal { target, objectChanges, externalUpdates } =
                         { objectsToCreate = AnyDict.singleton pendingID objectChanges pendingIDToComparable
                         , existingObjectChanges = AnyDict.empty existingIDToComparable
                         , delayed = ancestorsInstallChanges
-                        , opsToRepeat = AnyDict.empty OpID.toSortablePrimitives
                         }
                         |> withExternalChanges
     in
@@ -502,7 +496,7 @@ changeObjectWithExternal { target, objectChanges, externalUpdates } =
 
 isEmptyChangeSet : ChangeSet -> Bool
 isEmptyChangeSet (ChangeSet details) =
-    AnyDict.isEmpty details.existingObjectChanges && AnyDict.isEmpty details.objectsToCreate && AnyDict.isEmpty details.opsToRepeat && List.isEmpty details.delayed
+    AnyDict.isEmpty details.existingObjectChanges && AnyDict.isEmpty details.objectsToCreate && List.isEmpty details.delayed
 
 
 extractOwnSubChanges : Pointer -> List Change -> { earlier : ChangeSet, mine : List ObjectChange, later : ChangeSet }
@@ -622,27 +616,27 @@ 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, reversedFrames = [] }
+    Frame { changes = collapseChangesToChangeSet "save" changes, description = Just description }
 
 
 saveSystemChanges : List Change -> Frame desc
 saveSystemChanges changes =
-    Frame { changes = collapseChangesToChangeSet "save" changes, description = Nothing, reversedFrames = [] }
+    Frame { changes = collapseChangesToChangeSet "save" changes, description = Nothing}
 
 
 {-| An empty Frame, for when you have no changes to save.
 -}
 emptyFrame : Frame desc
 emptyFrame =
-    Frame { changes = emptyChangeSet, description = Nothing, reversedFrames = [] }
-
+    Frame { changes = emptyChangeSet, description = Nothing }
 
+{-| Returns True if a change Frame contains no changes (including Ops to invert).
+-}
 isEmpty : Frame desc -> Bool
 isEmpty (Frame { changes }) =
     isEmptyChangeSet changes
@@ -653,58 +647,35 @@ 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 }
+{-| Data that can be used for user undo/redo.
+Internally, this type contains a set of IDs for all the Ops that can be reverted, if any, that were generated by an applied Change Frame. You can use this to create a new Change Frame to undo those changes, or redo those changes if they were previously undone.
+ -}
+type alias UndoData = OpIDSet
 
+{-| Used internally by Node module to create a Change Frame that reverts the given Ops. 
 
-reverseFrameToChangeFrame : ReverseFrame desc -> Frame desc
-reverseFrameToChangeFrame (ReverseFrame reverseFrame) =
+Note: does not work with the original Ops (before all reversions). The Node module takes the UndoData (OpIDs of original changes) and traces all undo/redo operations recursively to the most recent reversion of each one, and provides this function with the those Ops (actual Ops, not just IDs).
+-}
+createReversionFrame : List Op -> Frame desc
+createReversionFrame opsToRevert =
     let
-        changeSet =
-            ChangeSet
-                { objectsToCreate = emptyObjectsToCreate
-                , existingObjectChanges = Nonempty.foldl addOpToChangeSet emptyExistingObjectChanges reverseFrame.ops
-                , delayed = []
-                , opsToRepeat = emptyOpsToRepeat
-                }
-
+        -- add a reversion operation to the existingObjectChanges for the target object.
         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
+
+        changeSet =
+            ChangeSet
+                { objectsToCreate = emptyObjectsToCreate
+                , existingObjectChanges = List.foldl addOpToChangeSet emptyExistingObjectChanges opsToRevert
+                , delayed = []
+                }
     in
-    Frame { changes = changeSet, description = Nothing, reversedFrames = [ Nonempty.head reverseFrame.ops |> Op.id ] }
+    Frame { changes = changeSet, description = Nothing }