Fix Composite's onDispose event handler (#176)

* Add minNumericValue helper. Add attribution note

* Process Composite's onDispose events in its own dispose handler, since RaiseEvent will not have a handler after the Composite's disposal

src/Monomer/Helper.hs

@@ -57,7 +57,23 @@ seqCatMaybes (x :<| xs) = case x of
 applyFnList :: [a -> a] -> a -> a
 applyFnList fns initial = foldl (flip ($)) initial fns
 
--- | Returns the maximum value of a given floating type.
+{-|
+Returns the minimum value of a given floating type.
+
+Copied from: https://hackage.haskell.org/package/numeric-limits
+-}
+minNumericValue :: (RealFloat a) => a
+minNumericValue = x where
+  n = floatDigits x
+  b = floatRadix x
+  (l, _) = floatRange x
+  x = encodeFloat (b^n - 1) (l - n - 1)
+
+{-|
+Returns the maximum value of a given floating type.
+
+Copied from: https://hackage.haskell.org/package/numeric-limits
+-}
 maxNumericValue :: (RealFloat a) => a
 maxNumericValue = x where
   n = floatDigits x

src/Monomer/Widgets/Composite.hs

@@ -69,7 +69,6 @@ import Control.Applicative ((<|>))
 import Control.Exception (AssertionFailed(..), throw)
 import Control.Lens (ALens', (&), (^.), (^?), (.~), (%~), (<>~), at, ix, non)
 import Data.Default
-import Data.Either
 import Data.List (foldl')
 import Data.Map.Strict (Map)
 import Data.Maybe
@@ -642,12 +641,18 @@ compositeDispose comp state wenv widgetComp = result where
   model = getCompositeModel state
   cwenv = convertWidgetEnv wenv _cpsWidgetKeyMap model
   widget = _cpsRoot ^. L.widget
+  widgetId = widgetComp ^. L.info . L.widgetId
 
-  WidgetResult _ reqs = widgetDispose widget cwenv _cpsRoot
+  handleReq (RaiseEvent evt) = reqs where
+    WidgetResult _ reqs = handleMsgEvent comp state wenv widgetComp evt
+  handleReq req = maybe Seq.empty Seq.singleton (toParentReq widgetId req)
 
-  disposeReqs = Seq.fromList (_cmpOnDisposeReq comp)
-  tempResult = WidgetResult _cpsRoot (reqs <> disposeReqs)
+  parentReqs = mconcat (handleReq <$> _cmpOnDisposeReq comp)
+
+  WidgetResult _ childReqs = widgetDispose widget cwenv _cpsRoot
+  tempResult = WidgetResult _cpsRoot childReqs
   result = toParentResult comp state wenv widgetComp tempResult
+    & L.requests %~ (parentReqs <>)
 
 compositeGetInstanceTree
   :: (CompositeModel s, CompositeEvent e, CompositeEvent ep, CompParentModel sp)

test/unit/Monomer/Widgets/CompositeSpec.hs

@@ -16,8 +16,7 @@ Unit tests for Composite widget.
 
 module Monomer.Widgets.CompositeSpec (spec) where
 
-import Control.Lens (
-  (&), (^.), (^?), (^?!), (^..), (.~), (%~), _Just, ix, folded, traverse, dropping)
+import Control.Lens hiding ((|>), deep)
 import Control.Lens.TH (abbreviatedFields, makeLensesWith)
 import Data.Default
 import Data.Foldable (toList)
@@ -63,6 +62,7 @@ data ChildEvt
   = ChildBtnClicked
   | ChildMessage String
   | ChildResize Rect
+  | ChildDispose
   deriving (Eq, Show)
 
 data DeepEvt
@@ -201,12 +201,10 @@ handleEventOnInit = describe "handleEventOnInit" $ do
 
 handleEventOnDispose :: Spec
 handleEventOnDispose = describe "handleEventOnDispose" $ do
-  it "should generate an init event" $ do
-    let val = case evts [] ^?! L.requests . ix 1 of
-          SendMessage wid msg -> cast msg
-          _ -> Nothing
-
-    val `shouldBe` Just OnDispose
+  it "should generate a dispose event" $ do
+    evts ^? L.requests . ix 0 `shouldBe` Just RenderOnce
+    evts ^? L.requests . ix 1 `shouldBe` Just (RaiseEvent ChildClicked)
+    evts ^? L.requests . ix 2 `shouldBe` Just (SetClipboard ClipboardEmpty)
 
   where
     wenv = mockWenv def
@@ -217,12 +215,12 @@ handleEventOnDispose = describe "handleEventOnDispose" $ do
       -> MainEvt
       -> [EventResponse MainModel MainEvt MainModel MainEvt]
     handleEvent wenv node model evt = case evt of
-      OnInit{} -> [Report evt]
+      OnDispose{} -> [ Request RenderOnce, Report ChildClicked ]
       _ -> []
     buildUI wenv model = vstack []
     cmpNode = nodeInit wenv
-      $ composite_ "main" id buildUI handleEvent [onDispose OnDispose]
-    evts es = widgetDispose (cmpNode ^. L.widget) wenv cmpNode
+      $ composite_ "main" id buildUI handleEvent [onDispose OnDispose, onDisposeReq (SetClipboard ClipboardEmpty)]
+    evts = widgetDispose (cmpNode ^. L.widget) wenv cmpNode
 
 handleEventOnChange :: Spec
 handleEventOnChange = describe "handleEventOnChange" $ do