Trigger ResizeWidgets when user defined size requests change (#229)

src/Monomer/Widgets/Composite.hs

@@ -626,7 +626,9 @@ compositeMerge comp state wenv newComp oldComp = newResult where
   reducedResult
     | useNewRoot = toParentResult comp newState wenv styledComp tmpResult
     | otherwise = resultNode oldComp
-  !newResult = handleWidgetIdChange oldComp reducedResult
+  !newResult = reducedResult
+    & handleUserSizeReqChange wenv oldComp
+    & handleWidgetIdChange oldComp
 
 -- | Dispose
 compositeDispose

src/Monomer/Widgets/Container.hs

@@ -662,11 +662,14 @@ mergeWrapper container wenv newNode oldNode = newResult where
     Just (ost, st) -> mergePostHandler wenv mNode oldNode ost st mResult
     Nothing -> mResult
 
-  tmpResult
-    | isResizeAnyResult (Just postRes) = postRes
-        & L.node .~ updateSizeReq wenv (postRes ^. L.node)
-    | otherwise = postRes
-  newResult = handleWidgetIdChange oldNode tmpResult
+  tmpResult = postRes
+    & handleUserSizeReqChange wenv oldNode
+    & handleWidgetIdChange oldNode
+
+  newResult
+    | isResizeAnyResult (Just tmpResult) = tmpResult
+        & L.node .~ updateSizeReq wenv (tmpResult ^. L.node)
+    | otherwise = tmpResult
 
 mergeParent
   :: WidgetModel a

src/Monomer/Widgets/Single.hs

@@ -368,7 +368,7 @@ mergeWrapper single wenv newNode oldNode = newResult where
   nodeHandler wenv styledNode = case useState oldState of
     Just state -> mergeHandler wenv styledNode oldNode state
     _ -> resultNode styledNode
-  tmpResult = runNodeHandler single wenv newNode oldInfo nodeHandler
+  tmpResult = runNodeHandler single wenv newNode oldNode nodeHandler
   newResult = handleWidgetIdChange oldNode tmpResult
 
 runNodeHandler
@@ -376,10 +376,11 @@ runNodeHandler
   => Single s e a
   -> WidgetEnv s e
   -> WidgetNode s e
-  -> WidgetNodeInfo
+  -> WidgetNode s e
   -> (WidgetEnv s e -> WidgetNode s e -> WidgetResult s e)
   -> WidgetResult s e
-runNodeHandler single wenv newNode oldInfo nodeHandler = newResult where
+runNodeHandler single wenv newNode oldNode nodeHandler = newResult where
+  oldInfo = oldNode ^. L.info
   getBaseStyle = singleGetBaseStyle single
   tempNode = newNode
     & L.info . L.widgetId .~ oldInfo ^. L.widgetId
@@ -389,6 +390,9 @@ runNodeHandler single wenv newNode oldInfo nodeHandler = newResult where
   styledNode = initNodeStyle getBaseStyle wenv tempNode
 
   tmpResult = nodeHandler wenv styledNode
+    & handleUserSizeReqChange wenv oldNode
+    & handleWidgetIdChange oldNode
+
   newResult
     | isResizeAnyResult (Just tmpResult) = tmpResult
         & L.node .~ updateSizeReq wenv (tmpResult ^. L.node)

src/Monomer/Widgets/Util/Style.hs

@@ -24,11 +24,12 @@ module Monomer.Widgets.Util.Style (
   initNodeStyle,
   mergeBasicStyle,
   handleStyleChange,
+  handleUserSizeReqChange,
   childOfFocusedStyle
 ) where
 
 import Control.Applicative ((<|>))
-import Control.Lens (Lens', (&), (^.), (^?), (.~), (?~), (<>~), _Just, _1, non)
+import Control.Lens hiding ((<|), (|>))
 
 import Data.Bits (xor)
 import Data.Default
@@ -213,6 +214,27 @@ handleStyleChange wenv target style doCursor node evt result = newResult where
     | doCursor = handleCursorChange wenv target evt style node tmpResult
     | otherwise = tmpResult
 
+{-|
+Checks if the user set size requests changed between the old and new versions of
+the node. Useful during merge to trigger a widget resize.
+-}
+handleUserSizeReqChange
+  :: WidgetEnv s e
+  -> WidgetNode s e
+  -> WidgetResult s e
+  -> WidgetResult s e
+handleUserSizeReqChange wenv oldNode result = newResult where
+  newNode = result ^. L.node
+  newWidgetId = newNode ^. L.info . L.widgetId
+
+  (oldStyle, newStyle) = (currentStyle wenv oldNode, currentStyle wenv newNode)
+  changedW = oldStyle ^. L.sizeReqW /= newStyle ^. L.sizeReqW
+  changedH = oldStyle ^. L.sizeReqH /= newStyle ^. L.sizeReqH
+  newResult
+    | changedW || changedH = result
+        & L.requests %~ (|> ResizeWidgets newWidgetId)
+    | otherwise = result
+
 {-|
 Replacement of currentStyle for child widgets embedded in a focusable parent. It
 selects the correct style state according to the situation.

test/unit/Monomer/Widgets/CompositeSpec.hs

@@ -20,6 +20,7 @@ import Control.Lens hiding ((|>), deep)
 import Control.Lens.TH (abbreviatedFields, makeLensesWith)
 import Data.Default
 import Data.Foldable (toList)
+import Data.List (find)
 import Data.Maybe
 import Data.Text (Text)
 import Data.Typeable (Typeable, cast)
@@ -42,6 +43,7 @@ import Monomer.Widgets.Containers.ZStack
 import Monomer.Widgets.Singles.Button
 import Monomer.Widgets.Singles.Checkbox
 import Monomer.Widgets.Singles.Label
+import Monomer.Widgets.Singles.Spacer
 import Monomer.Widgets.Singles.TextField
 import Monomer.Widgets.Util.Widget
 
@@ -139,6 +141,7 @@ spec = describe "Composite" $ do
   findByPoint
   findByPath
   findNextFocus
+  mergeUserResize
   getSizeReq
   resize
 
@@ -615,6 +618,39 @@ findByHelperUI = composite "main" id buildUI handleEvent where
         ]
     ]
 
+mergeUserResize :: Spec
+mergeUserResize = describe "merge resize" $ do
+  it "should not generate a request if user size did not change" $ do
+    let result = mergeSizeReq [] []
+    find isResizeWidgets (result ^. L.requests) `shouldBe` Nothing
+
+  it "should generate a ResizeWidgets request if user size changed" $ do
+    let result = mergeSizeReq [width 100] []
+    find isResizeWidgets (result ^. L.requests) `shouldNotBe` Nothing
+
+  it "should generate a ResizeWidgets request if user size changed" $ do
+    let result = mergeSizeReq [width 100] [width 200]
+    find isResizeWidgets (result ^. L.requests) `shouldNotBe` Nothing
+
+  where
+    wenv = mockWenv def
+    handleEvent
+      :: WidgetEnv MainModel MainEvt
+      -> WidgetNode MainModel MainEvt
+      -> MainModel
+      -> MainEvt
+      -> [EventResponse MainModel MainEvt MainModel MainEvt]
+    handleEvent wenv node model evt = []
+    buildUI wenv model = spacer
+    oldNode = composite "main" id buildUI handleEvent
+    newNode = composite_ "main" id buildUI handleEvent [mergeRequired (const . const . const True)]
+    mergeSizeReq oldStyle newStyle = result where
+      oldNode2 = nodeInit wenv $
+        oldNode `styleBasic` oldStyle
+      newNode2 = newNode
+        `styleBasic` newStyle
+      result = widgetMerge (newNode2 ^. L.widget) wenv newNode2 oldNode2
+
 getSizeReq :: Spec
 getSizeReq = describe "getSizeReq" $ do
   it "should return width = Fixed 70" $

test/unit/Monomer/Widgets/ContainerSpec.hs

@@ -19,6 +19,7 @@ module Monomer.Widgets.ContainerSpec (spec) where
 import Control.Lens ((&), (^.), (^?), (.~), (%~), ix)
 import Control.Lens.TH (abbreviatedFields, makeLensesWith)
 import Data.Default
+import Data.List (find)
 import Data.Text (Text)
 import Test.Hspec
 
@@ -46,9 +47,35 @@ widLens idx = L.children . ix idx . L.info . L.widgetId
 
 -- This uses Stack for testing, since Container is a template and not a real container
 spec :: Spec
-spec = describe "Container"
+spec = describe "Container" $ do
+  mergeUserResize
   handleEvent
 
+mergeUserResize :: Spec
+mergeUserResize = describe "merge resize" $ do
+  it "should not generate a request if user size did not change" $ do
+    let result = mergeSizeReq [] []
+    find isResizeWidgets (result ^. L.requests) `shouldBe` Nothing
+
+  it "should generate a ResizeWidgets request if user size changed" $ do
+    let result = mergeSizeReq [width 100] []
+    find isResizeWidgets (result ^. L.requests) `shouldNotBe` Nothing
+
+  it "should generate a ResizeWidgets request if user size changed" $ do
+    let result = mergeSizeReq [width 100] [width 200]
+    find isResizeWidgets (result ^. L.requests) `shouldNotBe` Nothing
+
+  where
+    wenv = mockWenvEvtUnit (TestModel "" "")
+    oldNode = vstack []
+    newNode = vstack []
+    mergeSizeReq oldStyle newStyle = result where
+      oldNode2 = nodeInit wenv $
+        oldNode `styleBasic` oldStyle
+      newNode2 = newNode
+        `styleBasic` newStyle
+      result = widgetMerge (newNode2 ^. L.widget) wenv newNode2 oldNode2
+
 handleEvent :: Spec
 handleEvent = describe "handleEvent" $ do
   handleEventNormal