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

@@ -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
 

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"

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 [

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.
--}
-class CmbMergeRequired t s | t -> s where
-  mergeRequired :: (s -> s -> Bool) -> t
 
--- | Listener for the validation status of a field using a lens.
+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 w s | t -> w s where
+  mergeRequired :: (w -> s -> s -> Bool) -> t
+
+{-|
+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

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

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

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

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

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