Add merge function

Author: paf31

bower.json

@@ -10,6 +10,8 @@
     "purescript-functions": "^3.0.0",
     "purescript-eff": "^3.1.0",
     "purescript-unsafe-coerce": "^3.0.0",
-    "purescript-nullable": "^3.0.0"
+    "purescript-nullable": "^3.0.0",
+    "purescript-typelevel-prelude": "^2.6.0",
+    "purescript-record": "^0.2.6"
   }
 }

examples/controlled-input/src/ControlledInput.purs

@@ -2,22 +2,28 @@ module ControlledInput where
 
 import Prelude
 
-import Data.Maybe (fromMaybe)
+import Data.Maybe (Maybe(..), fromMaybe, maybe)
 import Data.Nullable (toMaybe)
 import React.Basic (ReactComponent, react)
 import React.Basic.DOM as R
-import React.Basic.DOM.Events (handler, targetValue)
+import React.Basic.DOM.Events (targetValue, timeStamp)
+import React.Basic.DOM.Events as Events
 
 component :: ReactComponent {}
 component = react
   { displayName: "Counter"
-  , initialState: { value: "hello world" }
+  , initialState: { value: "hello world", timeStamp: Nothing }
   , receiveProps: \_ _ _ -> pure unit
   , render: \_ state setState ->
       R.div_
-        [ R.input { onChange: handler targetValue \value ->
-                      setState \_ -> { value: fromMaybe "" (toMaybe value) }
-                  , value: state.value
-                  }
+        [ R.p_ [ R.input { onChange: Events.handler (Events.preventDefault >>> Events.merge { targetValue, timeStamp }) \{ timeStamp, targetValue } ->
+                             setState \_ -> { value: fromMaybe "" (toMaybe targetValue)
+                                            , timeStamp: Just timeStamp
+                                            }
+                         , value: state.value
+                         }
+               ]
+        , R.p_ [ R.text ("Current value = " <> show state.value) ]
+        , R.p_ (maybe [] (\ts -> [R.text ("Changed at: " <> show ts)]) state.timeStamp)
         ]
   }

generated-docs/React/Basic/DOM/Events.md

@@ -45,6 +45,19 @@ newtype EventFn a b
 ``` purescript
 Semigroupoid EventFn
 Category EventFn
+(IsSymbol l, RowCons l (EventFn a b) fns_rest fns, RowCons l b r_rest r, RowLacks l fns_rest, RowLacks l r_rest, Merge rest fns_rest a r_rest) => Merge (Cons l (EventFn a b) rest) fns a r
+```
+
+#### `handler`
+
+``` purescript
+handler :: forall a. EventFn SyntheticEvent a -> (a -> Eff (react :: ReactFX) Unit) -> EventHandler
+```
+
+#### `merge`
+
+``` purescript
+merge :: forall a fns fns_list r. RowToList fns fns_list => Merge fns_list fns a r => {  | fns } -> EventFn a ({  | r })
 ```
 
 #### `bubbles`
@@ -143,6 +156,18 @@ isPropagationStopped :: EventFn SyntheticEvent Boolean
 target :: EventFn SyntheticEvent DOMNode
 ```
 
+#### `targetChecked`
+
+``` purescript
+targetChecked :: EventFn SyntheticEvent (Nullable Boolean)
+```
+
+#### `targetValue`
+
+``` purescript
+targetValue :: EventFn SyntheticEvent (Nullable String)
+```
+
 #### `timeStamp`
 
 ``` purescript
@@ -155,4 +180,17 @@ timeStamp :: EventFn SyntheticEvent Number
 type_ :: EventFn SyntheticEvent String
 ```
 
+#### `Merge`
+
+``` purescript
+class Merge (rl :: RowList) fns a r | rl -> fns, rl a -> r where
+  mergeImpl :: RLProxy rl -> {  | fns } -> EventFn a ({  | r })
+```
+
+##### Instances
+``` purescript
+Merge Nil () a ()
+(IsSymbol l, RowCons l (EventFn a b) fns_rest fns, RowCons l b r_rest r, RowLacks l fns_rest, RowLacks l r_rest, Merge rest fns_rest a r_rest) => Merge (Cons l (EventFn a b) rest) fns a r
+```
+
 

src/React/Basic/DOM/Events.purs

@@ -7,7 +7,7 @@ module React.Basic.DOM.Events
   , DOMEvent
   , EventFn
   , handler
-  -- , smoosh
+  , merge
   , bubbles
   , cancelable
   , currentTarget
@@ -28,14 +28,19 @@ module React.Basic.DOM.Events
   , targetValue
   , timeStamp
   , type_
+  , class Merge
+  , mergeImpl
   ) where
 
 import Prelude
 
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Uncurried (EffFn1, mkEffFn1)
 import Data.Nullable (Nullable)
+import Data.Record (delete, get, insert)
+import Data.Symbol (class IsSymbol, SProxy(SProxy))
 import React.Basic (ReactFX)
+import Type.Row (kind RowList, class RowToList, class RowLacks, RLProxy(..), Cons, Nil)
 import Unsafe.Coerce (unsafeCoerce)
 
 -- | An event handler, which receives a `SyntheticEvent` and performs some
@@ -59,9 +64,36 @@ derive newtype instance categoryBuilder :: Category EventFn
 handler :: forall a. EventFn SyntheticEvent a -> (a -> Eff (react :: ReactFX) Unit) -> EventHandler
 handler (EventFn fn) cb = mkEffFn1 $ fn >>> cb
 
--- smoosh
---   :: { b :: EventFn a b } -> { c :: EventFn a c } -> EventFn a { b :: b, c :: c }
--- smoosh = ?smoosh
+class Merge (rl :: RowList) fns a r | rl -> fns, rl a -> r where
+  mergeImpl :: RLProxy rl -> Record fns -> EventFn a (Record r)
+
+instance mergeNil :: Merge Nil () a () where
+  mergeImpl _ _ = EventFn \_ -> {}
+
+instance mergeCons
+    :: ( IsSymbol l
+       , RowCons l (EventFn a b) fns_rest fns
+       , RowCons l b r_rest r
+       , RowLacks l fns_rest
+       , RowLacks l r_rest
+       , Merge rest fns_rest a r_rest
+       )
+    => Merge (Cons l (EventFn a b) rest) fns a r
+  where
+    mergeImpl _ fns = EventFn \a ->
+        let EventFn inner = mergeImpl (RLProxy :: RLProxy rest) (delete l fns)
+            EventFn f = get l fns
+         in insert l (f a) (inner a)
+      where
+        l = SProxy :: SProxy l
+
+merge
+  :: forall a fns fns_list r
+   . RowToList fns fns_list
+  => Merge fns_list fns a r
+  => Record fns
+  -> EventFn a (Record r)
+merge = mergeImpl (RLProxy :: RLProxy fns_list)
 
 bubbles :: EventFn SyntheticEvent Boolean
 bubbles = EventFn \e -> (unsafeCoerce e).bubbles