update list model upon undo/redo

src/app/MetaBrush/Application/Action.hs

@@ -115,8 +115,8 @@ import MetaBrush.Asset.WindowIcons
   ( drawClose )
 import MetaBrush.Document.Diff
 import MetaBrush.Document.History
-  ( DocumentHistory(..), newHistory
+  ( DocumentHistory(..), Do(..)
-  , back, fwd
+  , newHistory, back, fwd
   )
 import MetaBrush.Document.Serialise
   ( saveDocument, loadDocument )
@@ -134,6 +134,8 @@ import MetaBrush.UI.InfoBar
   ( updateInfoBar )
 import MetaBrush.UI.FileBar
   ( newFileTab, removeFileTab )
+import MetaBrush.UI.StrokeTreeView
+  ( applyDiffToListModel )
 import MetaBrush.UI.Viewport
   ( Viewport(..) )
 import MetaBrush.Unique
@@ -557,25 +559,31 @@ data Redo = Redo
 instance HandleAction Redo where
   handleAction uiElts vars _ = updateHistory fwd uiElts vars
 
-updateHistory :: ( DocumentHistory -> DocumentHistory ) -> UIElements -> Variables -> IO ()
+updateHistory :: ( DocumentHistory -> Maybe ( DocumentHistory, ( Do, HistoryDiff ) ) ) -> UIElements -> Variables -> IO ()
 updateHistory f uiElts vars@( Variables {..} ) = do
   uiUpdateAction <- STM.atomically do
     mbUnique <- STM.readTVar activeDocumentTVar
     case mbUnique of
       Nothing -> pure ( pure () )
-      Just unique -> do
+      Just docUnique -> do
-        mbDocHistory <- Map.lookup unique <$> STM.readTVar openDocumentsTVar
+        mbDocHistory <- Map.lookup docUnique <$> STM.readTVar openDocumentsTVar
         case mbDocHistory of
           Nothing -> pure ( pure () )
           Just docHistory -> do
-            let
+            let mbNewHist = f docHistory
-              newDocHistory :: DocumentHistory
+            case mbNewHist of
-              newDocHistory = f docHistory
+              Nothing -> pure ( pure () )
-            STM.modifyTVar' openDocumentsTVar ( Map.insert unique newDocHistory )
+              Just ( newDocHistory, ( doOrUndo, diff ) ) -> do
-            uiUpdateAction <- updateUIAction NoActiveDocChange uiElts vars
+                STM.modifyTVar' openDocumentsTVar ( Map.insert docUnique newDocHistory )
-            pure do
+                uiUpdateAction <- updateUIAction NoActiveDocChange uiElts vars
-              updateHistoryState uiElts ( Just newDocHistory )
+                pure do
-              uiUpdateAction
+                  case diff of
+                    DocumentDiff {} -> return ()
+                    HierarchyDiff hDiff ->
+                      applyDiffToListModel parStoresTVar docUnique ( doOrUndo, hDiff )
+                    ContentDiff {} -> return ()
+                  updateHistoryState uiElts ( Just newDocHistory )
+                  uiUpdateAction
   uiUpdateAction
 
 ---------

src/app/MetaBrush/UI/StrokeTreeView.hs

@@ -863,10 +863,6 @@ getSelectedItem layersView = do
 
 --------------------------------------------------------------------------------
 
--- | Do or undo?
-data Do = Do | Undo
-  deriving stock ( Eq, Show )
-
 -- | Do, undo or redo?
 data DoLayerChange = DoLayerChange !LayerChange | RedoChange | UndoChange
 

src/metabrushes/MetaBrush/Document/History.hs

@@ -1,5 +1,6 @@
 module MetaBrush.Document.History
   ( DocumentHistory(..)
+  , Do(..)
   , back, fwd, newHistory, newFutureStep
   , atStart, atEnd
   , affirmPresentSaved
@@ -49,23 +50,33 @@ instance NFData DocumentHistory where
   rnf ( History { past = ps, present, future } ) =
     ps `deepseq` present `deepseq` future `deepseq` ()
 
-back :: DocumentHistory -> DocumentHistory
+-- | Do or undo?
-back hist@( History { past = ps, present = c, future = fs } ) = case ps of
+data Do = Do | Undo
-  Empty
+  deriving stock ( Eq, Show )
-    -> hist
-  qs :|> ( q, diff )
-    -> History { past = qs
-               , present = c { documentContent = q }
-               , future = ( diff, documentContent c ) : fs }
 
-fwd :: DocumentHistory -> DocumentHistory
+back :: DocumentHistory -> Maybe ( DocumentHistory, ( Do, HistoryDiff ) )
-fwd hist@( History { past = ps, present = c, future = fs } ) = case fs of
+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
   []
-    -> hist
+    -> Nothing
   ( diff, g ) : gs
-    -> History { past = ps :|> ( documentContent c, diff )
+    -> Just
-               , present = c { documentContent = g }
+        ( History { past = ps :|> ( documentContent c, diff )
-               , future = gs }
+                 , present = c { documentContent = g }
+                 , future = gs }
+       , ( Do, diff )
+       )
 
 newHistory :: Document -> DocumentHistory
 newHistory a = History { past = Empty, present = a, future = [] }