mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-08-17 07:50:31 +03:00
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
This commit is contained in:
parent
353b4977fb
commit
84e37dcbfa
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user