Provide wenv parameter to Composites handleEvent

app/KeysComposite.hs

@@ -53,7 +53,7 @@ initialState = KeysCompState {
 keysComposite :: WidgetNode KeysCompState ep
 keysComposite = composite "keysComposite" id Nothing buildKeysComp handleKeysCompEvent
 
-handleKeysCompEvent model evt = case evt of
+handleKeysCompEvent wenv model evt = case evt of
   RotateChildren -> [Model (model & items %~ rotateSeq)]
 
 buildKeysComp wenv model = trace "Created keys composite UI" $

app/Main.hs

@@ -53,8 +53,12 @@ main = do
   simpleApp_ model handleAppEvent buildUI config
   --simpleApp model handleAppEvent buildUI
 
-handleAppEvent :: App -> AppEvent -> [AppEventResponse App AppEvent]
-handleAppEvent model evt = case evt of
+handleAppEvent
+  :: WidgetEnv App AppEvent
+  -> App
+  -> AppEvent
+  -> [AppEventResponse App AppEvent]
+handleAppEvent wenv model evt = case evt of
   IncButton -> [Model (model & clickCount %~ (+1))]
 --  PrintMessage txt -> Model (model & showAlert .~ True)
   PrintMessage txt -> [Task $ do

app/TestComposite.hs

@@ -43,7 +43,7 @@ data CompEvent
 testComposite :: WidgetNode CompState AppEvent
 testComposite = composite "testComposite" id (Just InitComposite) buildComposite handleCompositeEvent
 
-handleCompositeEvent model evt = case evt of
+handleCompositeEvent wenv model evt = case evt of
   InitComposite -> [Task $ do
     threadDelay 1000
     putStrLn "Initialized composite"

src/Monomer/Main/Core.hs

@@ -41,7 +41,7 @@ import Monomer.Widgets.Composite
 import qualified Monomer.Lens as L
 
 type AppEventResponse s e = EventResponse s e ()
-type AppEventHandler s e = s -> e -> [AppEventResponse s e]
+type AppEventHandler s e = WidgetEnv s e -> s -> e -> [AppEventResponse s e]
 type AppUIBuilder s e = UIBuilder s e
 
 data MainLoopArgs s e ep = MainLoopArgs {

src/Monomer/Widgets/Alert.hs

@@ -77,5 +77,5 @@ buildUI message evt config wenv model = alertBox where
   alertBox = box_ alertTree [onClickEmpty evt]
     & L.info . L.style .~ emptyOverlayColor
 
-handleEvent :: s -> e -> [EventResponse s e e]
-handleEvent model evt = [Report evt]
+handleEvent :: WidgetEnv s e -> s -> e -> [EventResponse s e e]
+handleEvent wenv model evt = [Report evt]

src/Monomer/Widgets/Composite.hs

@@ -46,7 +46,7 @@ type ParentModel sp = Typeable sp
 type CompositeModel s = (Eq s, Typeable s)
 type CompositeEvent e = Typeable e
 
-type EventHandler s e ep = s -> e -> [EventResponse s e ep]
+type EventHandler s e ep = WidgetEnv s e -> s -> e -> [EventResponse s e ep]
 type UIBuilder s e = WidgetEnv s e -> s -> WidgetNode s e
 type MergeRequired s = s -> s -> Bool
 type TaskHandler e = IO (Maybe e)
@@ -509,9 +509,11 @@ reduceResult comp state wenv widgetComp widgetResult = newResult where
     | isJust _cpsModel = fromJust _cpsModel
     | otherwise = getModel comp wenv
   evtUpdates = getUpdateModelReqs reqs
-  evtModel = foldr (.) id evtUpdates model
+  evtModel = foldr ($) model evtUpdates
   evtHandler = _cmpEventHandler comp
-  ReducedEvents{..} = reduceCompEvents _cpsGlobalKeys evtHandler evtModel evts
+  cwenv = convertWidgetEnv wenv _cpsGlobalKeys evtModel
+  ReducedEvents{..} =
+      reduceCompEvents _cpsGlobalKeys evtHandler cwenv evtModel evts
   WidgetResult uWidget uReqs uEvts =
     updateComposite comp state wenv _reModel evtsRoot widgetComp
   currentPath = widgetComp ^. L.info . L.path
@@ -582,10 +584,11 @@ mergeChild comp state wenv newModel widgetRoot widgetComp = newResult where
 reduceCompEvents
   :: GlobalKeys s e
   -> EventHandler s e ep
+  -> WidgetEnv s e
   -> s
   -> Seq e
   -> ReducedEvents s e sp ep
-reduceCompEvents globalKeys eventHandler model events = result where
+reduceCompEvents globalKeys eventHandler cwenv model events = result where
   initial = ReducedEvents {
     _reModel = model,
     _reEvents = Seq.empty,
@@ -596,7 +599,7 @@ reduceCompEvents globalKeys eventHandler model events = result where
     _reProducers = Seq.empty
   }
   reducer current event = foldl' reducer newCurrent newEvents where
-    response = eventHandler (_reModel current) event
+    response = eventHandler cwenv (_reModel current) event
     processed = foldl' (reduceEvtResponse globalKeys) current response
     newEvents = _reEvents processed
     newCurrent = processed { _reEvents = Seq.empty }

src/Monomer/Widgets/Confirm.hs

@@ -96,5 +96,5 @@ buildUI message acceptEvt cancelEvt config wenv model = confirmBox where
   confirmBox = box_ confirmTree [onClickEmpty cancelEvt]
     & L.info . L.style .~ emptyOverlayColor
 
-handleEvent :: s -> e -> [EventResponse s e e]
-handleEvent model evt = [Report evt]
+handleEvent :: WidgetEnv s e -> s -> e -> [EventResponse s e e]
+handleEvent wenv model evt = [Report evt]

test/unit/Monomer/Widgets/CompositeSpec.hs

@@ -89,8 +89,12 @@ handleEventBasic = describe "handleEventBasic" $ do
 
   where
     wenv = mockWenv def
-    handleEvent :: MainModel -> MainEvt -> [EventResponse MainModel MainEvt ()]
-    handleEvent model evt = [Model (model & clicks %~ (+1))]
+    handleEvent
+      :: WidgetEnv MainModel MainEvt
+      -> MainModel
+      -> MainEvt
+      -> [EventResponse MainModel MainEvt ()]
+    handleEvent wenv model evt = [Model (model & clicks %~ (+1))]
     buildUI wenv model = button "Click" MainBtnClicked
     cmpNode = composite "main" id Nothing buildUI handleEvent
     model es = nodeHandleEventCtxModel wenv es cmpNode
@@ -111,11 +115,19 @@ handleEventChild = describe "handleEventChild" $ do
 
   where
     wenv = mockWenv def
-    handleChild :: ChildModel -> ChildEvt -> [EventResponse ChildModel ChildEvt MainEvt]
-    handleChild model evt = [Model (model & clicks %~ (+1))]
+    handleChild
+      :: WidgetEnv ChildModel ChildEvt
+      -> ChildModel
+      -> ChildEvt
+      -> [EventResponse ChildModel ChildEvt MainEvt]
+    handleChild wenv model evt = [Model (model & clicks %~ (+1))]
     buildChild wenv model = button "Click" ChildBtnClicked
-    handleEvent :: MainModel -> MainEvt -> [EventResponse MainModel MainEvt ()]
-    handleEvent model evt = [Model (model & clicks %~ (+1))]
+    handleEvent
+      :: WidgetEnv MainModel MainEvt
+      -> MainModel
+      -> MainEvt
+      -> [EventResponse MainModel MainEvt ()]
+    handleEvent wenv model evt = [Model (model & clicks %~ (+1))]
     buildUI wenv model = vstack [
         button "Click" MainBtnClicked,
         composite "child" child Nothing buildChild handleChild
@@ -133,8 +145,12 @@ handleEventLocalKey = describe "handleEventLocalKey" $
 
   where
     wenv = mockWenv (TestModel "" "")
-    handleEvent :: TestModel -> () -> [EventResponse TestModel () ()]
-    handleEvent model evt = []
+    handleEvent
+      :: WidgetEnv TestModel ()
+      -> TestModel
+      -> ()
+      -> [EventResponse TestModel () ()]
+    handleEvent wenv model evt = []
     buildUI1 wenv model = hstack [
         vstack [
           textField text1 `key` "localTxt1"
@@ -170,8 +186,12 @@ handleEventGlobalKey = describe "handleEventGlobalKey" $
 
   where
     wenv = mockWenv (TestModel "" "")
-    handleEvent :: TestModel -> () -> [EventResponse TestModel () ()]
-    handleEvent model evt = []
+    handleEvent
+      :: WidgetEnv TestModel ()
+      -> TestModel
+      -> ()
+      -> [EventResponse TestModel () ()]
+    handleEvent wenv model evt = []
     buildUI1 wenv model = hstack [
         vstack [
           textField text1 `globalKey` "globalTxt1"
@@ -207,7 +227,7 @@ updateSizeReq = describe "updateSizeReq" $ do
 
   where
     wenv = mockWenv ()
-    handleEvent model evt = []
+    handleEvent wenv model evt = []
     buildUI :: WidgetEnv () () -> () -> WidgetNode () ()
     buildUI wenv model = vstack [
         label "label 1",
@@ -234,7 +254,7 @@ resize = describe "resize" $ do
     wenv = mockWenv () & L.windowSize .~ Size 640 480
     vp   = Rect 0 0 640 480
     cvp1 = Rect 0 0 640 480
-    handleEvent model evt = []
+    handleEvent wenv model evt = []
     buildUI :: WidgetEnv () () -> () -> WidgetNode () ()
     buildUI wenv model = hstack []
     cmpNode = composite "main" id Nothing buildUI handleEvent