diff --git a/src/Monomer/Widgets/Composite.hs b/src/Monomer/Widgets/Composite.hs index 01e8ec05..987231e3 100644 --- a/src/Monomer/Widgets/Composite.hs +++ b/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 diff --git a/src/Monomer/Widgets/Container.hs b/src/Monomer/Widgets/Container.hs index 197888a3..4578c526 100644 --- a/src/Monomer/Widgets/Container.hs +++ b/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 diff --git a/src/Monomer/Widgets/Single.hs b/src/Monomer/Widgets/Single.hs index a9ca9c4f..9ca78220 100644 --- a/src/Monomer/Widgets/Single.hs +++ b/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) diff --git a/src/Monomer/Widgets/Util/Style.hs b/src/Monomer/Widgets/Util/Style.hs index 23094fa9..5da9cacb 100644 --- a/src/Monomer/Widgets/Util/Style.hs +++ b/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. diff --git a/test/unit/Monomer/Widgets/CompositeSpec.hs b/test/unit/Monomer/Widgets/CompositeSpec.hs index c3157459..fa718d60 100644 --- a/test/unit/Monomer/Widgets/CompositeSpec.hs +++ b/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" $ diff --git a/test/unit/Monomer/Widgets/ContainerSpec.hs b/test/unit/Monomer/Widgets/ContainerSpec.hs index b01b9dd2..253cf6bd 100644 --- a/test/unit/Monomer/Widgets/ContainerSpec.hs +++ b/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