Refactor composite example into separate file

app/Main.hs

@@ -30,28 +30,18 @@ import qualified SDL.Raw.Event as SREv
 import Monomer.Common.Geometry
 import Monomer.Common.Style
 import Monomer.Graphics.Color
-import Monomer.Graphics.Types
 import Monomer.Main.Core
 import Monomer.Main.Platform
 import Monomer.Main.Types
 import Monomer.Main.Util
-import Monomer.Widget.CompositeWidget
-import Monomer.Widget.Core
 import Monomer.Widget.Util
---import Monomer.Widget.Types
 import Monomer.Widgets
 
+import TestComposite
 import Types
 
 foreign import ccall unsafe "initGlew" glewInit :: IO CInt
 
-data AppEvent = RunShortTask
-              | RunLongTask
-              | PrintTextFields
-              | IncreaseCount Int
-              | UpdateText3 T.Text
-              deriving (Show, Eq)
-
 --type AppContext = MonomerContext App AppEvent
 --type AppM = StateT AppContext IO
 --type WidgetTree = Tree (WidgetInstance App AppEvent AppM)
@@ -132,30 +122,10 @@ handleAppEvent app evt = do
       return Nothing
     UpdateText3 txt -> State $ app & textField3 .~ txt
 
-data CompEvent = CEvent1 | CEvent2 | CEvent3 deriving (Eq, Show)
-
-handleCompositeEvent :: CompState -> CompEvent -> EventResponseC CompState CompEvent AppEvent
-handleCompositeEvent app evt = case evt of
-  CEvent1 -> StateC $ app & csCounter %~ (+1)
-  CEvent2 -> MessageC (IncreaseCount 55)
-  otherwise -> TaskC app $ do
-    liftIO . putStrLn $ "HOLA!!!!"
-    return $ Just CEvent1
-
-buildComposite app =
-  vstack [
-    scroll $ label "This is a composite label!",
-    hgrid [
-      button ("Clicked: " <> (showt $ _csCounter app)) CEvent1,
-      button "Message parent" CEvent2,
-      button "Run task" CEvent3
-    ] `style` bgColor gray
-  ]
-
 buildUI app = trace "Created main UI" $ widgetTree where
   widgetTree =
     vstack [
-      composite "newCounter" def handleCompositeEvent buildComposite,
+      testComposite,
       button "Increase" (IncreaseCount 1)
     ]
 

app/TestComposite.hs

@@ -0,0 +1,51 @@
+module TestComposite where
+
+import Debug.Trace
+
+import Control.Monad.State
+import Data.Default
+import Data.Typeable (Typeable)
+import Lens.Micro
+import TextShow
+
+import Monomer.Common.Style
+import Monomer.Graphics.Color
+import Monomer.Widget.CompositeWidget
+import Monomer.Widget.Types
+import Monomer.Widget.Util
+import Monomer.Widgets
+
+import Types
+
+data CompEvent = CEvent1
+               | CEvent2
+               | CEvent3
+               | CEvent4
+               deriving (Eq, Show)
+
+testComposite :: (Monad m, Typeable m) => WidgetInstance sp AppEvent m
+testComposite = composite "testComposite" def handleCompositeEvent buildComposite
+
+handleCompositeEvent :: CompState -> CompEvent -> EventResponseC CompState CompEvent AppEvent
+handleCompositeEvent app evt = case evt of
+  CEvent1 -> StateC $ app & csCounter %~ (+1)
+  CEvent2 -> MessageC (IncreaseCount 55)
+  CEvent3 -> TaskC app $ return Nothing
+  otherwise -> TaskC app $ do
+    liftIO . putStrLn $ "Composite event handler called"
+    return $ Just CEvent1
+
+buildComposite app = trace "Created composite UI" $
+  vstack [
+    scroll $ label "This is a composite label!",
+    vgrid [
+      hgrid [
+        button ("Clicked: " <> (showt $ _csCounter app)) CEvent1,
+        button "Message parent" CEvent2
+      ],
+      hgrid [
+        sandbox CEvent3,
+        button "Run task" CEvent4
+      ]
+    ] `style` bgColor gray
+  ]

app/Types.hs

@@ -19,6 +19,13 @@ instance Default App where
 
 makeLenses ''App
 
+data AppEvent = RunShortTask
+              | RunLongTask
+              | PrintTextFields
+              | IncreaseCount Int
+              | UpdateText3 T.Text
+              deriving (Show, Eq)
+
 data CompState = CompState {
   _csCounter :: Int
 } deriving (Show, Eq)

src/Monomer/Widget/CompositeWidget.hs

@@ -18,7 +18,6 @@ import Monomer.Common.Tree
 import Monomer.Event.Core
 import Monomer.Event.Types
 import Monomer.Graphics.Renderer
-import Monomer.Widget.BaseContainer
 import Monomer.Widget.PathContext
 import Monomer.Widget.Types
 import Monomer.Widget.Util
@@ -71,8 +70,8 @@ compositeMerge :: (Monad m, Eq s, Typeable s, Typeable e, Typeable ep, Typeable
 compositeMerge comp state pApp newComposite oldComposite = newInstance where
   oldState = _widgetGetState (_instanceWidget oldComposite) pApp
   CompositeState oldApp oldRoot = fromMaybe state (useState oldState)
-  newRoot = (_uiBuilderC comp) oldApp
-  --CompositeState _ newRoot = state
+  -- The widgetRoot created on _composite_ has not yet been evaluated, so duplicate widget tree creation is avoided
+  newRoot = _uiBuilderC comp oldApp
   widgetRoot = _widgetMerge (_instanceWidget newRoot) oldApp newRoot oldRoot
   newState = CompositeState oldApp widgetRoot
   newInstance = newComposite {
@@ -124,12 +123,16 @@ convertTasksToRequests ctx reqs = flip fmap reqs $ \req -> RunCustom (_pathCurre
 compositeHandleCustom :: forall i s e sp ep m . (Monad m, Eq s, Typeable i, Typeable s, Typeable e, Typeable ep, Typeable m) => Composite s e ep m -> CompositeState s e m -> PathContext -> i -> sp -> WidgetInstance sp ep m -> Maybe (EventResult sp ep m)
 compositeHandleCustom comp state ctx arg app widgetComposite
   | isTargetReached ctx = case cast arg of
-      Just (CompositeTask evt) -> traceShow (typeOf evt) $ case cast evt of
+      Just (CompositeTask evt) -> case cast evt of
         Just (Just res) -> Just $ processEventResult comp state ctx widgetComposite evtResult where
           evtResult = EventResult Seq.empty (Seq.singleton res) (_compositeRoot state)
         _ -> Nothing
       Nothing -> Nothing
-  | otherwise = Nothing
+  | otherwise = fmap processEvent result where
+      CompositeState app widgetRoot = state
+      processEvent = processEventResult comp state ctx widgetComposite
+      result = _widgetHandleCustom (_instanceWidget widgetRoot) ctx arg app widgetRoot
+
 
 -- Preferred size
 compositePreferredSize :: CompositeState s e m -> Renderer m -> sp -> WidgetInstance sp ep m -> Tree SizeReq

src/Monomer/Widget/Widgets/Sandbox.hs

@@ -41,6 +41,8 @@ makeSandbox onClick state = createWidget {
     _widgetRender = render
   }
   where
+    label = "Sandbox: " ++ show (_clickCount state)
+
     getState = makeState state
     merge app oldState = makeSandbox onClick newState where
       newState = fromMaybe state (useState oldState)
@@ -61,15 +63,15 @@ makeSandbox onClick state = createWidget {
       return SandboxData2
 
     handleCustom ctx bd app widgetInstance = case cast bd of
-      Just val -> if val == SandboxData2 then Nothing else Nothing
+      Just val -> if val == SandboxData2 then trace "Sandbox handleCustom called" Nothing else Nothing
       Nothing -> Nothing
 
     preferredSize renderer app widgetInstance = singleNode sizeReq where
       Style{..} = _instanceStyle widgetInstance
-      size = calcTextBounds renderer _textStyle (T.pack (show (_clickCount state)))
+      size = calcTextBounds renderer _textStyle (T.pack label)
       sizeReq = SizeReq size FlexibleSize FlexibleSize
 
     render renderer ts ctx app WidgetInstance{..} =
       do
         drawBgRect renderer _instanceRenderArea _instanceStyle
-        drawText_ renderer _instanceRenderArea (_textStyle _instanceStyle) (T.pack (show (_clickCount state)))
+        drawText_ renderer _instanceRenderArea (_textStyle _instanceStyle) (T.pack label)

tasks.md

@@ -52,8 +52,15 @@
   - Create composite widget, on which application itself is based
     - Remove UserTask concept, handle it as WidgetTask
   - Can we generalize _widgetFind?
-    - To find widgetInstances that need a specific kind of event (TimeStep)
+    - To find widgetInstances that need a specific kind of event (entities that need timeStep)
   - Improve merge process. Implement Global keys
+  - Provide long running tasks that can provide events through a channel
+  - Provide a way of initializing the application
+    - Probably taking a simple event that is relayed to appEventsHandler is enough?
+  - Add a way to get path of widget given an id, and provide a method to send a message/event
+  - Try to remove all those Typeable requirements in CompositeWidget
+    - Maybe passing the current root as a parameter?
+    - Find a way of providing a function that creates the updated UI, and avoid storing it in state?
   - Add _renderLast_ function to Renderer, which delays rendering until the first pass is done
     - Futher calls to _renderLast_ should not be ignored (tooltip on dropdown menu?)
     - A _handleDelayedRendering_ also needs to be added