From 932fd91b23f5562380b263c2f5c738efca0f9a76 Mon Sep 17 00:00:00 2001 From: Francisco Vallarino Date: Sun, 6 Dec 2020 19:58:11 -0300 Subject: [PATCH] Add widgetGetInstanceTree method --- app/Main.hs | 6 +++--- src/Monomer/Core/WidgetTypes.hs | 12 ++++++++++++ src/Monomer/Widgets/Composite.hs | 1 + src/Monomer/Widgets/Container.hs | 1 + src/Monomer/Widgets/Single.hs | 1 + src/Monomer/Widgets/Util/Widget.hs | 14 +++++++++++++- tasks.md | 21 +++++++-------------- 7 files changed, 38 insertions(+), 18 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 3bdf3b41..342f5d78 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -168,7 +168,7 @@ buildUI model = trace "Creating UI" widgetTree where label "4" `style` [bgColor pink] ], vstack [ - --textDropdown_ textField1 items id [onChange DropdownVal, onChangeIdx DropdownIdx], + --textDropdown_ dropdown1 items id [onChange DropdownVal, onChangeIdx DropdownIdx], label "1" `style` [bgColor pink, border 1 pink] ] `visible` False, label "" `style` [bgColor orange], @@ -240,7 +240,7 @@ buildUI model = trace "Creating UI" widgetTree where label "Label 1234" `style` [bgColor darkGray] ] `style` [bgColor blue] ] `style` [bgColor green], - label (model ^. textField1) `style` [bgColor lightBlue, textLeft], + --label (model ^. textField1) `style` [bgColor lightBlue, textLeft], textField textField1 `style` [bgColor lightBlue, textLeft], hgrid [ label_ "This is a really long label used to check what I did works fine" [textMultiLine, textEllipsis], @@ -254,7 +254,7 @@ buildUI model = trace "Creating UI" widgetTree where spacer_ [resizeFactor 1], image_ "https://picsum.photos/600/400" [fitFill, onLoadError ImageMsg] ], - textDropdown_ textField1 items id [onChange DropdownVal, onChangeIdx DropdownIdx], + textDropdown_ dropdown1 items id [onChange DropdownVal, onChangeIdx DropdownIdx], button_ "Click\nme!" (PrintMessage "Button clicked") [textMultiLine] ] `key` "main vstack" `style` [borderT 20 red, borderL 10 blue, borderR 10 green, borderB 10 gray, iradius 50] --, padding 20 items = fmap (\i -> "This is a long label: " <> showt i) [1..100::Int] diff --git a/src/Monomer/Core/WidgetTypes.hs b/src/Monomer/Core/WidgetTypes.hs index 3db3cd81..6f86b114 100644 --- a/src/Monomer/Core/WidgetTypes.hs +++ b/src/Monomer/Core/WidgetTypes.hs @@ -124,6 +124,13 @@ data WidgetNode s e = WidgetNode { _wnChildren :: Seq (WidgetNode s e) } +data WidgetInstanceNode = WidgetInstanceNode { + -- | The instance + _winInst :: WidgetInstance, + -- | The children widget, if any + _winChildren :: Seq WidgetInstanceNode +} + data Widget s e = Widget { -- | Performs widget initialization @@ -151,6 +158,11 @@ data Widget s e = widgetGetState :: WidgetEnv s e -> Maybe WidgetState, + -- | Returns information about the instance and its children + widgetGetInstanceTree + :: WidgetEnv s e + -> WidgetNode s e + -> WidgetInstanceNode, -- | Returns the list of focusable paths, if any -- widgetFindNextFocus diff --git a/src/Monomer/Widgets/Composite.hs b/src/Monomer/Widgets/Composite.hs index b1557e6f..6d96478c 100644 --- a/src/Monomer/Widgets/Composite.hs +++ b/src/Monomer/Widgets/Composite.hs @@ -212,6 +212,7 @@ createComposite comp state = widget where widgetMerge = compositeMerge comp state, widgetDispose = compositeDispose comp state, widgetGetState = makeState state, + widgetGetInstanceTree = getInstanceTree, widgetFindNextFocus = compositeFindNextFocus comp state, widgetFindByPoint = compositeFindByPoint comp state, widgetHandleEvent = compositeHandleEvent comp state, diff --git a/src/Monomer/Widgets/Container.hs b/src/Monomer/Widgets/Container.hs index 0310f47e..f3c21245 100644 --- a/src/Monomer/Widgets/Container.hs +++ b/src/Monomer/Widgets/Container.hs @@ -170,6 +170,7 @@ createContainer container = Widget { widgetMerge = mergeWrapper container, widgetDispose = disposeWrapper container, widgetGetState = containerGetState container, + widgetGetInstanceTree = getInstanceTree, widgetFindNextFocus = findNextFocusWrapper container, widgetFindByPoint = findByPointWrapper container, widgetHandleEvent = handleEventWrapper container, diff --git a/src/Monomer/Widgets/Single.hs b/src/Monomer/Widgets/Single.hs index ab5c652a..3fec7e64 100644 --- a/src/Monomer/Widgets/Single.hs +++ b/src/Monomer/Widgets/Single.hs @@ -132,6 +132,7 @@ createSingle single = Widget { widgetMerge = mergeWrapper single, widgetDispose = singleDispose single, widgetGetState = singleGetState single, + widgetGetInstanceTree = getInstanceTree, widgetFindNextFocus = singleFindNextFocus single, widgetFindByPoint = singleFindByPoint single, widgetHandleEvent = handleEventWrapper single, diff --git a/src/Monomer/Widgets/Util/Widget.hs b/src/Monomer/Widgets/Util/Widget.hs index be9b5354..2a22f933 100644 --- a/src/Monomer/Widgets/Util/Widget.hs +++ b/src/Monomer/Widgets/Util/Widget.hs @@ -19,7 +19,8 @@ module Monomer.Widgets.Util.Widget ( handleFocusChange, resizeWidget, buildLocalMap, - findWidgetByKey + findWidgetByKey, + getInstanceTree ) where import Control.Lens ((&), (^#), (#~), (^.), (.~)) @@ -152,3 +153,14 @@ buildLocalMap widgets = newMap where where key = widget ^. L.widgetInstance . L.key newMap = foldl' addWidget M.empty widgets + +getInstanceTree + :: WidgetEnv s e + -> WidgetNode s e + -> WidgetInstanceNode +getInstanceTree wenv node = instNode where + instNode = WidgetInstanceNode { + _winInst = node ^. L.widgetInstance, + _winChildren = fmap (getChildNode wenv) (node ^. L.children) + } + getChildNode wenv child = widgetGetInstanceTree (child ^. L.widget) wenv child diff --git a/tasks.md b/tasks.md index 30e666fb..f3431155 100644 --- a/tasks.md +++ b/tasks.md @@ -298,6 +298,13 @@ - Review composite initialization. View creation can be moved to init - Check if passing model directly is still correct - Test nested composites + - Update signatures of methods to use Widget/WidgetInstance as needed (restrict what can be changed) + - Change WidgetResult so WidgetInstance is Maybe + - This allows having a Default instance and later use lenses instead of the resultX functions + - Remove Maybe from handleEvent/handleMessage return type + - Reverted. Reward was low, and getSizeReq/resize were still inconsistent + - Can _wiChildren be removed from Widget and only be kept in Container? + - Postponed/cancelled. After all the refactoring attempts regarding WidgetResult, I'm not sure about the benefits - Pending - Add testing @@ -316,29 +323,15 @@ Maybe postponed after release? - Change interfaces - - ??? Change WidgetResult so WidgetInstance is Maybe - - ??? This allows having a Default instance and later use lenses instead of the resultX functions - - ??? Remove Maybe from handleEvent/handleMessage return type - Change return type and the moment when widgetUpdateSizeReq is called - Comment GlobalKeys out and have Container use its local list of children for merging - Create WidgetNode type, move Widget/children into it - Remove type constraints on WidgetInstance - Change type signatures to use WidgetNode - - Update signatures of methods to use Widget/WidgetInstance as needed (restrict what can be changed) - Restore GlobalKeys - Add method to collect tree of WidgetInstances - Also return map of GlobalKeys, whose value is an existential wrapping the WidgetNode - This is necessary because s/e types may not match - - Remove children from WidgetNode - - Use Widget instead of WidgetNode wherever possible - - Split WidgetInstance into Definition and Instance, in order to: - - Be able to get information about the whole widget tree, even hidden items (inside composite) - - This is needed for testing composite - - It can be used to create debugging tools/widgets - - Have clearer interfaces. A method should not be able to modify its instance, since those changes will be ignored anyway - - Pave the way for removing children from WidgetInstance - - Pave the way for removing widget from WidgetInstance - - Can _wiChildren be removed from Widget and only be kept in Container? - Do not hover if mouse drag on different widget - Fix selectOnBlur for dropdown - Set focus on ButtonDown, not Click