From af0456ccf11c85c29dfb84a162cca7db26ff241b Mon Sep 17 00:00:00 2001 From: Francisco Vallarino Date: Sun, 17 Apr 2022 20:06:55 +0200 Subject: [PATCH] Add extra argument to mergeRequired; in most cases, it will be WidgetEnv (#122) * Add extra argument to mergeRequired; in most cases, it will be WidgetEnv * Update Changelog --- ChangeLog.md | 24 +++++++----- docs/examples/02-books.md | 2 +- examples/books/Main.hs | 2 +- src/Monomer/Core/Combinators.hs | 38 +++++++++++++++---- src/Monomer/Widgets/Composite.hs | 19 +++++----- src/Monomer/Widgets/Containers/Box.hs | 6 +-- src/Monomer/Widgets/Containers/SelectList.hs | 8 ++-- test/unit/Monomer/Widgets/CompositeSpec.hs | 2 +- .../Monomer/Widgets/Containers/BoxSpec.hs | 4 +- 9 files changed, 67 insertions(+), 38 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index d8bc2dce..864aa726 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,19 @@ ## 1.4.0.0 (in development) +### Breaking changes + +- Added `style...Set` family of functions. ([PR #104](https://github.com/fjvallarino/monomer/pull/104)). +- `Composite`'s `onChange` event is now sent to its `handleEvent` function, not to its parent; the type of the + generated event was updated to reflect this change. The rationale is that since `onInit` is sent to + `handleEvent`, having `onChange` sent to its parent was confusing. At the same time there was not an easy way + in `handleEvent` to know when the model changed. Widgets that want to report model changes to its parent can + use `Report`/`RequestParent`; an example can be found in `ColorPicker` ([PR #71](https://github.com/fjvallarino/monomer/pull/71)). +- `Timestamp` is now a newtype. Enforce use of this type instead of `Int` when appropriate ([PR #103](https://github.com/fjvallarino/monomer/pull/103)). +- `Timestamp` was renamed to `Millisecond`. The rationale is that since both timestamps and durations are used frequently in calculations (and in the context of Monomer timestamps and durations indeed represent time in milliseconds), having separate types for Timestamp and Duration caused more harm than good ([PR #107](https://github.com/fjvallarino/monomer/pull/107)). +- `compositeMergeModel` (previously `customModelBuilder`) now receives `WidgetEnv` as its first parameter ([PR #114](https://github.com/fjvallarino/monomer/pull/114)). +- `compositeMergeReqs` now receives `parentModel` and `oldModel` too ([PR #114](https://github.com/fjvallarino/monomer/pull/114)). +- `mergeRequired` now receives an extra value as its first parameter, usually `WidgetEnv` ([PR #122](https://github.com/fjvallarino/monomer/pull/122)). + ### Fixed - Properly handle `SetFocusOnKey` for `textArea` ([#80](https://github.com/fjvallarino/monomer/issues/80)). @@ -16,24 +30,14 @@ - Read-only mode for `textField`, `numericField`, `dateField`, `timeField` and `textArea` ([PR #93](https://github.com/fjvallarino/monomer/pull/93)). Thanks @Dretch! - The `scroll` widget now supports a `thumbMinSize` configuration option that allows setting a minimum thumb size ([PR #100](https://github.com/fjvallarino/monomer/pull/100)). - New field `_weAppStartTs` in `WidgetEnv`, complementary to `_weTimestamp`, representing the time in milliseconds when the application started. Added utility function `currentTimeMs` that returns their sum with a polymorphic type ([PR #103](https://github.com/fjvallarino/monomer/pull/103)). -- `style...Set` family of functions ([PR #104](https://github.com/fjvallarino/monomer/pull/104)). - Several sizeReq helpers ([PR #106](https://github.com/fjvallarino/monomer/pull/106)). - `compositeMergeEvents`, for completeness ([PR #114](https://github.com/fjvallarino/monomer/pull/114)). - Support for symbols and other keys in `keystroke` ([PR #117](https://github.com/fjvallarino/monomer/pull/117)). ### Changed -- `Composite`'s `onChange` event is now sent to its `handleEvent` function, not to its parent; the type of the - generated event was updated to reflect this change. The rationale is that since `onInit` is sent to - `handleEvent`, having `onChange` sent to its parent was confusing. At the same time there was not an easy way - in `handleEvent` to know when the model changed. Widgets that want to report model changes to its parent can - use `Report`/`RequestParent`; an example can be found in `ColorPicker` ([PR #71](https://github.com/fjvallarino/monomer/pull/71)). - The `keystroke` widget now supports the `Backspace` key ([PR #74](https://github.com/fjvallarino/monomer/pull/74)). - `style...` family of functions now combine new attributes with the existing ones ([PR #104](https://github.com/fjvallarino/monomer/pull/104)). -- `Timestamp` is now a newtype. Enforce use of this type instead of `Int` when appropriate ([PR #103](https://github.com/fjvallarino/monomer/pull/103)). -- `Timestamp` was renamed to `Millisecond`. The rationale is that since both timestamps and durations are used frequently in calculations (and in the context of Monomer timestamps and durations indeed represent time in milliseconds), having separate types for Timestamp and Duration caused more harm than good ([PR #107](https://github.com/fjvallarino/monomer/pull/107)). -- `compositeMergeModel` (previously `customModelBuilder`) now receives `WidgetEnv` as its first parameter ([PR #114](https://github.com/fjvallarino/monomer/pull/114)). -- `compositeMergeReqs` now receives `parentModel` and `oldModel` too ([PR #114](https://github.com/fjvallarino/monomer/pull/114)). ### Renamed diff --git a/docs/examples/02-books.md b/docs/examples/02-books.md index 2095e0c5..005d9fbb 100644 --- a/docs/examples/02-books.md +++ b/docs/examples/02-books.md @@ -34,7 +34,7 @@ This is an optimization and should not be needed unless performance is a concern (for example, when a long list of items is displayed). ```haskell -booksChanged old new = old ^. books /= new ^. books +booksChanged wenv old new = old ^. books /= new ^. books box_ [mergeRequired booksChanged] $ vscroll (vstack (bookRow wenv <$> model ^. books)) `nodeKey` "mainScroll" diff --git a/examples/books/Main.hs b/examples/books/Main.hs index 11af13c3..9bd4cdee 100644 --- a/examples/books/Main.hs +++ b/examples/books/Main.hs @@ -119,7 +119,7 @@ buildUI wenv model = widgetTree where countLabel = label caption `styleBasic` [padding 10] where caption = "Books (" <> showt (length $ model ^. books) <> ")" - booksChanged old new = old ^. books /= new ^. books + booksChanged wenv old new = old ^. books /= new ^. books widgetTree = zstack [ vstack [ diff --git a/src/Monomer/Core/Combinators.hs b/src/Monomer/Core/Combinators.hs index 38476f2f..e92ee121 100644 --- a/src/Monomer/Core/Combinators.hs +++ b/src/Monomer/Core/Combinators.hs @@ -30,16 +30,40 @@ import Monomer.Graphics.Types {-| Given two values, usually model, checks if merge is required for a given widget. -The first parameter corresponds to the old value, and the second to the new. + +The first parameter usually corresponds to the current 'WidgetEnv', the second +to the old value/model, and the third to the new/model. + +This is used, for example, by 'composite' and 'box'. -} -class CmbMergeRequired t s | t -> s where - mergeRequired :: (s -> s -> Bool) -> t +class CmbMergeRequired t w s | t -> w s where + mergeRequired :: (w -> s -> s -> Bool) -> t --- | Listener for the validation status of a field using a lens. +{-| +Listener for the validation status of a user input field using a lens. + +Allows associating a flag to know if the input of a field with validation +settings is valid. This can be used with 'textField ,'numericField', 'dateField' +and 'timeField'. + +The flag can be used for styling the component according to the current status. +Beyond styling, its usage is needed for validation purposes. Taking +'numericField' as an example, one can bind a 'Double' record field to it and set +a valid range from 0 to 100. When the user inputs 100, the record field will +reflect the correct value. If the user adds a 0 (the numericField showing 1000), +the record field will still have 100 because it's the last valid value. Since +there is not a way of indicating errors when using primitive types (a 'Double' +is just a number), we can rely on the flag to check its validity. +-} class CmbValidInput t s | t -> s where validInput :: ALens' s Bool -> t --- | Listener for the validation status of a field using an event handler. +{-| +Listener for the validation status of a user input field using an event handler, +avoiding the need of a lens. + +Check 'CmbValidInput' for details. +-} class CmbValidInputV t e | t -> e where validInputV :: (Bool -> e) -> t @@ -316,8 +340,8 @@ class CmbThumbHoverColor t where thumbHoverColor :: Color -> t {-| -The thumb factor. For example, in slider this makes the thumb proportional -to the width of the slider. +The thumb factor. For example, in slider this makes the thumb proportional to +the width of the slider. -} class CmbThumbFactor t where thumbFactor :: Double -> t diff --git a/src/Monomer/Widgets/Composite.hs b/src/Monomer/Widgets/Composite.hs index f2aae0cb..57a6ccb9 100644 --- a/src/Monomer/Widgets/Composite.hs +++ b/src/Monomer/Widgets/Composite.hs @@ -95,10 +95,11 @@ type CompositeModel s = (Eq s, WidgetModel s) type CompositeEvent e = WidgetEvent e -- | Checks if merging the composite is required. -type MergeRequired s - = s -- ^ Old composite model. - -> s -- ^ New composite model - -> Bool -- ^ True if merge is required. +type MergeRequired s e + = WidgetEnv s e -- ^ Widget environment. + -> s -- ^ Old composite model. + -> s -- ^ New composite model + -> Bool -- ^ True if merge is required. -- | Generates requests during the merge process. type MergeReqsHandler s e sp @@ -237,7 +238,7 @@ Configuration options for composite: than what the user is binding. -} data CompositeCfg s e sp ep = CompositeCfg { - _cmcMergeRequired :: Maybe (MergeRequired s), + _cmcMergeRequired :: Maybe (MergeRequired s e), _cmcMergeReqs :: [MergeReqsHandler s e sp], _cmcMergeModel :: Maybe (MergeModelHandler s e sp), _cmcOnInitReq :: [WidgetRequest s e], @@ -277,7 +278,7 @@ instance Semigroup (CompositeCfg s e sp ep) where instance Monoid (CompositeCfg s e sp ep) where mempty = def -instance CmbMergeRequired (CompositeCfg s e sp ep) s where +instance CmbMergeRequired (CompositeCfg s e sp ep) (WidgetEnv s e) s where mergeRequired fn = def { _cmcMergeRequired = Just fn } @@ -372,7 +373,7 @@ data Composite s e sp ep = Composite { _cmpWidgetData :: !(WidgetData sp s), _cmpEventHandler :: !(EventHandler s e sp ep), _cmpUiBuilder :: !(UIBuilder s e), - _cmpMergeRequired :: MergeRequired s, + _cmpMergeRequired :: MergeRequired s e, _cmpMergeReqs :: [MergeReqsHandler s e sp], _cmpMergeModel :: Maybe (MergeModelHandler s e sp), _cmpOnInitReq :: [WidgetRequest s e], @@ -469,7 +470,7 @@ compositeD_ -> WidgetNode sp ep -- ^ The resulting widget. compositeD_ wType wData uiBuilder evtHandler configs = newNode where config = mconcat configs - mergeReq = fromMaybe (/=) (_cmcMergeRequired config) + mergeReq = fromMaybe (const (/=)) (_cmcMergeRequired config) !widgetRoot = spacer composite = Composite { _cmpWidgetData = wData, @@ -579,7 +580,7 @@ compositeMerge comp state wenv newComp oldComp = newResult where -- Needed in case the user references something outside model when building UI -- The same model is provided as old since nothing else is available, but -- mergeRequired may be using data from a closure - modelChanged = _cmpMergeRequired comp (fromJust oldModel) model + modelChanged = _cmpMergeRequired comp cwenv (fromJust oldModel) model visibleChg = nodeVisibleChanged oldComp newComp enabledChg = nodeEnabledChanged oldComp newComp flagsChanged = visibleChg || enabledChg diff --git a/src/Monomer/Widgets/Containers/Box.hs b/src/Monomer/Widgets/Containers/Box.hs index 712c6aa0..df5a85ca 100644 --- a/src/Monomer/Widgets/Containers/Box.hs +++ b/src/Monomer/Widgets/Containers/Box.hs @@ -80,7 +80,7 @@ data BoxCfg s e = BoxCfg { _boxExpandContent :: Maybe Bool, _boxIgnoreEmptyArea :: Maybe Bool, _boxSizeReqUpdater :: [SizeReqUpdater], - _boxMergeRequired :: Maybe (s -> s -> Bool), + _boxMergeRequired :: Maybe (WidgetEnv s e -> s -> s -> Bool), _boxAlignH :: Maybe AlignH, _boxAlignV :: Maybe AlignV, _boxOnFocusReq :: [Path -> WidgetRequest s e], @@ -142,7 +142,7 @@ instance CmbSizeReqUpdater (BoxCfg s e) where _boxSizeReqUpdater = [updater] } -instance CmbMergeRequired (BoxCfg s e) s where +instance CmbMergeRequired (BoxCfg s e) (WidgetEnv s e) s where mergeRequired fn = def { _boxMergeRequired = Just fn } @@ -320,7 +320,7 @@ makeBox config state = widget where mergeRequired wenv node oldNode oldState = required where newModel = wenv ^. L.model required = case (_boxMergeRequired config, _bxsModel oldState) of - (Just mergeReqFn, Just oldModel) -> mergeReqFn oldModel newModel + (Just mergeReqFn, Just oldModel) -> mergeReqFn wenv oldModel newModel _ -> True merge wenv node oldNode oldState = resultNode newNode where diff --git a/src/Monomer/Widgets/Containers/SelectList.hs b/src/Monomer/Widgets/Containers/SelectList.hs index fe8bb10a..98471821 100644 --- a/src/Monomer/Widgets/Containers/SelectList.hs +++ b/src/Monomer/Widgets/Containers/SelectList.hs @@ -83,7 +83,7 @@ data SelectListCfg s e a = SelectListCfg { _slcSelectOnBlur :: Maybe Bool, _slcItemStyle :: Maybe Style, _slcItemSelectedStyle :: Maybe Style, - _slcMergeRequired :: Maybe (Seq a -> Seq a -> Bool), + _slcMergeRequired :: Maybe (WidgetEnv s e -> Seq a -> Seq a -> Bool), _slcOnFocusReq :: [Path -> WidgetRequest s e], _slcOnBlurReq :: [Path -> WidgetRequest s e], _slcOnChangeReq :: [a -> WidgetRequest s e], @@ -172,7 +172,7 @@ instance CmbItemSelectedStyle (SelectListCfg s e a) Style where _slcItemSelectedStyle = Just style } -instance CmbMergeRequired (SelectListCfg s e a) (Seq a) where +instance CmbMergeRequired (SelectListCfg s e a) (WidgetEnv s e) (Seq a) where mergeRequired fn = def { _slcMergeRequired = Just fn } @@ -299,8 +299,8 @@ makeSelectList widgetData items makeRow config state = widget where mergeChildrenReq wenv node oldNode oldState = result where oldItems = _prevItems oldState - mergeRequiredFn = fromMaybe (/=) (_slcMergeRequired config) - result = mergeRequiredFn oldItems items + mergeRequiredFn = fromMaybe (const (/=)) (_slcMergeRequired config) + result = mergeRequiredFn wenv oldItems items merge wenv node oldNode oldState = resultNode newNode where selected = currentValue wenv diff --git a/test/unit/Monomer/Widgets/CompositeSpec.hs b/test/unit/Monomer/Widgets/CompositeSpec.hs index db2a7918..a8ee8844 100644 --- a/test/unit/Monomer/Widgets/CompositeSpec.hs +++ b/test/unit/Monomer/Widgets/CompositeSpec.hs @@ -424,7 +424,7 @@ handleEventLocalKeySingleState = describe "handleEventLocalKeySingleState" $ ] `nodeKey` "localTxt1" ] cmpNode1 = composite "main" id buildUI1 handleEvent - cmpNode2 = composite_ "main" id buildUI2 handleEvent [mergeRequired (\_ _ -> True)] + cmpNode2 = composite_ "main" id buildUI2 handleEvent [mergeRequired (\_ _ _ -> True)] evts1 = [evtK keyTab, evtT "aacc", moveCharL, moveCharL] (wenv1, root1, _) = fst $ nodeHandleEvents wenv WInit evts1 cmpNode1 cntNodeM = nodeMerge wenv1 cmpNode2 root1 diff --git a/test/unit/Monomer/Widgets/Containers/BoxSpec.hs b/test/unit/Monomer/Widgets/Containers/BoxSpec.hs index 7bdbb4a0..434dbc1c 100644 --- a/test/unit/Monomer/Widgets/Containers/BoxSpec.hs +++ b/test/unit/Monomer/Widgets/Containers/BoxSpec.hs @@ -68,8 +68,8 @@ mergeReq = describe "mergeReq" $ do btnNew = button "Click" (BtnClick 0) `nodeKey` "btnNew" btnOld = button "Click" (BtnClick 0) `nodeKey` "btnOld" box1 = box btnNew - box2 = box_ [mergeRequired (\_ _ -> True)] btnNew - box3 = box_ [mergeRequired (\_ _ -> False)] btnNew + box2 = box_ [mergeRequired (\_ _ _ -> True)] btnNew + box3 = box_ [mergeRequired (\_ _ _ -> False)] btnNew boxM = box btnOld mergeWith newNode oldNode = result ^?! L.node . L.children . ix 0 where oldNode2 = nodeInit wenv oldNode