Add widgetGetInstanceTree method

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]

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

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,

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,

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,

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

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