Fail restore process if widget tree structure differs

2024-11-13 00:11:06 +03:00 · 2021-01-13 22:32:30 -03:00 · 2021-01-13 22:32:30 -03:00 · 60b87fdf07
commit 60b87fdf07
parent 8c9892cb19
5 changed files with 43 additions and 20 deletions
--- a/src/Monomer/Widgets/Composite.hs
+++ b/src/Monomer/Widgets/Composite.hs
@ -25,6 +25,7 @@ import Codec.CBOR.Decoding
 import Codec.CBOR.Encoding
 import Codec.Serialise
 import Control.Applicative ((<|>))
+import Control.Exception (AssertionFailed(..), throw)
 import Control.Lens (ALens', (&), (^.), (^?), (.~), (%~), (<>~), at, ix, non)
 import Data.Default
 import Data.List (foldl')
@ -314,7 +315,7 @@ compositeMerge comp state wenv oldComp newComp = newResult where
  mergeRequired
    | isJust oldModel = modelChanged || (oldFlags /= newFlags)
    | otherwise = True
-  initRequired = not (instanceMatches tempRoot oldRoot)
+  initRequired = not (nodeMatches tempRoot oldRoot)
  tempResult
    | initRequired = widgetInit tempWidget cwenv tempRoot
    | otherwise = widgetMerge tempWidget cwenv oldRoot tempRoot
@ -402,16 +403,18 @@ compositeRestore comp state wenv win newComp = result where
  }
  getBaseStyle wenv node = Nothing
  styledComp = initNodeStyle getBaseStyle wenv newComp
-  newResult = reduceResult comp newState wenv styledComp tempResult
+  reducedResult = reduceResult comp newState wenv styledComp tempResult
  widgetId = newComp ^. L.info . L.widgetId
-  path = newComp ^. L.info . L.path
-  result = newResult
-    & L.node . L.info . L.widgetId .~ oldInfo ^. L.widgetId
-    & L.node . L.info . L.viewport .~ oldInfo ^. L.viewport
-    & L.node . L.info . L.renderArea .~ oldInfo ^. L.renderArea
-    & L.node . L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW
-    & L.node . L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH
-    & L.requests %~ (UpdateWidgetPath widgetId path <|)
+  valid = infoMatches (win ^. L.info) (newComp ^. L.info)
+  message = matchFailedMsg (win ^. L.info) (newComp ^. L.info)
+  result
+    | valid = reducedResult
+        & L.node . L.info . L.widgetId .~ oldInfo ^. L.widgetId
+        & L.node . L.info . L.viewport .~ oldInfo ^. L.viewport
+        & L.node . L.info . L.renderArea .~ oldInfo ^. L.renderArea
+        & L.node . L.info . L.sizeReqW .~ oldInfo ^. L.sizeReqW
+        & L.node . L.info . L.sizeReqH .~ oldInfo ^. L.sizeReqH
+    | otherwise = throw (AssertionFailed $ "Restore failed. " ++ message)

 -- | Next focusable
 compositeFindNextFocus
--- a/src/Monomer/Widgets/Container.hs
+++ b/src/Monomer/Widgets/Container.hs
@ -29,6 +29,7 @@ module Monomer.Widgets.Container (

 import Codec.Serialise
 import Control.Applicative ((<|>))
+import Control.Exception (AssertionFailed(..), throw)
 import Control.Lens ((&), (^.), (^?), (.~), (%~), _Just)
 import Control.Monad
 import Data.Default
@ -388,9 +389,9 @@ mergeChildrenSeq wenv localKeys newNode oldItems newItems = res where
  mergedKey = widgetMerge newWidget wenv oldMatch newChild
  initNew = widgetInit newWidget wenv newChild
    & L.requests %~ (|> ResizeWidgets)
-  isMergeKey = isJust oldKeyMatch && instanceMatches newChild oldMatch
+  isMergeKey = isJust oldKeyMatch && nodeMatches newChild oldMatch
  (child, oldRest)
-    | instanceMatches newChild oldChild = (mergedOld, oldChildren)
+    | nodeMatches newChild oldChild = (mergedOld, oldChildren)
    | isMergeKey = (mergedKey, oldItems)
    | otherwise = (initNew, oldItems)
  (cmerged, cremoved)
@ -477,7 +478,10 @@ restoreWrapper container wenv win newNode = newResult where
  postRes = case loadState (win ^. L.state) of
    Just state -> restorePostHandler wenv tmpRes state oldInfo newParent
    Nothing -> resultWidget newParent
+  valid = infoMatches (win ^. L.info) (newNode ^. L.info)
+  message = matchFailedMsg (win ^. L.info) (newNode ^. L.info)
  newResult
+    | not valid = throw (AssertionFailed $ "Restore failed. " ++ message)
    | isResizeResult (Just postRes) = postRes
        & L.node .~ updateSizeReq container wenv (postRes ^. L.node)
    | otherwise = postRes
--- a/src/Monomer/Widgets/Single.hs
+++ b/src/Monomer/Widgets/Single.hs
@ -13,6 +13,7 @@ module Monomer.Widgets.Single (
 ) where

 import Codec.Serialise
+import Control.Exception (AssertionFailed(..), throw)
 import Control.Lens ((&), (^.), (^?), (.~), _Just)
 import Data.Default
 import Data.Maybe
@ -252,7 +253,11 @@ restoreWrapper single wenv win newNode = newResult where
  nodeHandler styledNode = case loadState (win ^. L.state) of
    Just state -> restoreHandler wenv state oldInfo styledNode
    _ -> resultWidget styledNode
-  newResult = loadStateHandler single wenv oldInfo newNode nodeHandler
+  valid = infoMatches (win ^. L.info) (newNode ^. L.info)
+  message = matchFailedMsg (win ^. L.info) (newNode ^. L.info)
+  newResult
+    | valid = loadStateHandler single wenv oldInfo newNode nodeHandler
+    | otherwise = throw (AssertionFailed $ "Restore failed. " ++ message)

 loadStateHandler
  :: (Typeable a, Serialise a)
--- a/src/Monomer/Widgets/Util/Widget.hs
+++ b/src/Monomer/Widgets/Util/Widget.hs
@ -13,7 +13,9 @@ module Monomer.Widgets.Util.Widget (
  makeState,
  useState,
  loadState,
-  instanceMatches,
+  matchFailedMsg,
+  infoMatches,
+  nodeMatches,
  handleWidgetIdChange
 ) where

@ -93,13 +95,22 @@ loadState state = state >>= wsVal >>= fromBS where
    Left _ -> Nothing
    Right val -> Just val

-instanceMatches :: WidgetNode s e -> WidgetNode s e -> Bool
-instanceMatches newNode oldNode = typeMatches && keyMatches where
-  oldInfo = oldNode ^. L.info
-  newInfo = newNode ^. L.info
+matchFailedMsg :: WidgetNodeInfo -> WidgetNodeInfo -> String
+matchFailedMsg oldInfo newInfo = message where
+  oldData = (oldInfo ^. L.widgetType, oldInfo ^. L.key)
+  newData = (newInfo ^. L.widgetType, newInfo ^. L.key)
+  message = "Nodes do not match: " ++ show oldData ++ " - " ++ show newData
+
+infoMatches :: WidgetNodeInfo -> WidgetNodeInfo -> Bool
+infoMatches oldInfo newInfo = typeMatches && keyMatches where
  typeMatches = oldInfo ^. L.widgetType == newInfo ^. L.widgetType
  keyMatches = oldInfo ^. L.key == newInfo ^. L.key

+nodeMatches :: WidgetNode s e -> WidgetNode s e -> Bool
+nodeMatches oldNode newNode = infoMatches oldInfo newInfo where
+  oldInfo = oldNode ^. L.info
+  newInfo = newNode ^. L.info
+
 handleWidgetIdChange :: WidgetNode s e -> WidgetResult s e -> WidgetResult s e
 handleWidgetIdChange oldNode result = newResult where
  oldPath = oldNode ^. L.info . L.path
--- a/tasks.md
+++ b/tasks.md
@ -407,6 +407,7 @@
    - Make save/restore configurable (app)
    - Rebuild composite globalKeys
  - Automatically set new WidgetId/Path on Container
+  - Remove embedded fonts. Rely on loaded fonts, template will also include them

 - Pending
  - Add header in all files, indicating license and documenting what the module does
@ -419,7 +420,7 @@
  - Add user documentation

 Maybe postponed after release?
-  - Remove embedded fonts. Rely on loaded fonts, template will also include them
+  - Restoring should fail if widget tree structure is different
  - Image
    - Fix crash when adding images
      - If called from render, immediate add seems to work.
@ -444,7 +445,6 @@ Maybe postponed after release?
    - Test image updating WidgetId/Path
  - Create consistent, good looking, themes: dark, light, pastel
    - Import HTML color names: https://www.rapidtables.com/web/color/RGB_Color.html
-  - Restoring should fail if widget tree structure is different
  - Validate nested structures update correctly when disabling/enabling parent
  - Create DevelMain, take care of saving/loading state. Also provide a way of ignoring it.
  - Drag & drop for user (add attribute indicating if component supports being source/target)