explore a unified attribute interface

example/main.ml

@@ -24,46 +24,37 @@ let () =
         ; dataset_module
         ])
   in
-  let h1 = Vnode.h1 Jv.null [ Vnode.text "Hello World" ] in
-  let tick () =
-    Vnode.h2 Jv.null [ Vnode.text (Date.to_locale_time_string (Date.now ())) ]
-  in
+  let h1 = Vnode.h1 [] [ Vnode.text "Hello World" ] in
+  let tick () = Vnode.h2 [] [ Vnode.text (Date.to_locale_time_string (Date.now ())) ] in
   let svg_node =
     Vnode.make_node
       "svg"
-      (Jv.obj [| "attrs", Jv.obj [| "width", Jv.of_int 100; "height", Jv.of_int 100 |] |])
+      Attr.[ int "width" 100; int "height" 100 ]
       [ Vnode.make_node
           "circle"
-          (Jv.obj
-             [| ( "attrs"
-                , Jv.obj
-                    [| "cx", Jv.of_int 50
-                     ; "cy", Jv.of_int 50
-                     ; "r", Jv.of_int 40
-                     ; "stroke", Jv.of_string "green"
-                     ; "stroke-width", Jv.of_int 4
-                     ; "fill", Jv.of_string "yellow"
-                    |] )
-             |])
+          Attr.
+            [ int "cx" 50
+            ; int "cy" 50
+            ; int "r" 40
+            ; string "stroke" "green"
+            ; int "stroke-width" 4
+            ; string "fill" "yellow"
+            ]
           []
       ]
   in
-  let make_counter count = Vnode.p Jv.null [ Vnode.text (Int.to_string count) ] in
+  let make_counter count = Vnode.p [] [ Vnode.text (Int.to_string count) ] in
   let count = ref 0 in
   let counter = ref (make_counter !count) in
-  let on_click () =
+  let on_click _ =
     incr count;
     let new_counter = make_counter !count in
     patch (`Vnode !counter) new_counter;
     counter := new_counter
   in
-  let btn =
-    Vnode.button
-      (Jv.obj [| "on", Jv.obj [| "click", Jv.repr on_click |] |])
-      [ Vnode.text "Click me" ]
-  in
+  let btn = Vnode.button Attr.[ click on_click ] [ Vnode.text "Click me" ] in
   let h2 = ref (tick ()) in
-  patch (`Element container) (Vnode.div Jv.null [ svg_node; h1; !h2; !counter; btn ]);
+  patch (`Element container) (Vnode.div [] [ svg_node; h1; !h2; !counter; btn ]);
   ignore
     (G.set_interval ~ms:1000 (fun () ->
          let new_node = tick () in

lib/attr.ml

@@ -0,0 +1,55 @@
+module StringSet = Set.Make (struct
+  type t = string
+
+  let compare a b =
+    let a = String.lowercase_ascii a in
+    let b = String.lowercase_ascii b in
+    String.compare a b
+end)
+
+let attributes_to_skip = StringSet.of_list [ "xmlns"; "xmlns:xlink" ]
+
+module Event_handler = struct
+  type t =
+    | Mouse of (Brr.Ev.Mouse.t Brr.Ev.t -> unit)
+    | Keyboard of (Brr.Ev.Keyboard.t Brr.Ev.t -> unit)
+    | Raw of (Jv.t -> unit)
+end
+
+type t =
+  | Attr of string * Jv.t
+  | Event of
+      { on : string
+      ; handler : Event_handler.t
+      }
+
+type attrs =
+  { attr : (string * Jv.t) list
+  ; event : (string * Jv.t) list
+  }
+
+let make_attr k f x = Attr (k, f x)
+let bool k v = make_attr k Jv.of_bool v
+let int k v = make_attr k Jv.of_int v
+let float k v = make_attr k Jv.of_float v
+let string k v = make_attr k Jv.of_string v
+let click handler = Event { on = "click"; handler = Event_handler.Mouse handler }
+let mouse_event on handler = Event { on; handler = Event_handler.Mouse handler }
+let keyboard_event on handler = Event { on; handler = Event_handler.Keyboard handler }
+let unsafe_event on handler = Event { on; handler = Event_handler.Raw handler }
+
+let attrs_to_jv xs =
+  let obj =
+    List.fold_left
+      (fun acc attr ->
+        match attr with
+        | Attr (k, v) ->
+          if StringSet.mem k attributes_to_skip
+          then acc
+          else { acc with attr = (k, v) :: acc.attr }
+        | Event { on; handler } -> { acc with event = (on, Jv.repr handler) :: acc.event })
+      { attr = []; event = [] }
+      xs
+  in
+  Jv.obj
+    [| "attrs", Jv.obj (Array.of_list obj.attr); "on", Jv.obj (Array.of_list obj.event) |]

lib/attr.mli

@@ -0,0 +1,11 @@
+type t
+
+val bool : string -> bool -> t
+val int : string -> int -> t
+val float : string -> float -> t
+val string : string -> string -> t
+val click : (Brr.Ev.Mouse.t Brr.Ev.t -> unit) -> t
+val mouse_event : string -> (Brr.Ev.Mouse.t Brr.Ev.t -> unit) -> t
+val keyboard_event : string -> (Brr.Ev.Keyboard.t Brr.Ev.t -> unit) -> t
+val unsafe_event : string -> (Jv.t -> unit) -> t
+val attrs_to_jv : t list -> Jv.t

lib/snabbdom.ml

@@ -12,6 +12,7 @@ module M = struct
   let dataset_module = get_global "datasetModule"
 end
 
+module Attr = Attr
 module Vnode = Vnode
 
 let init modules =

lib/snabbdom.mli

@@ -9,6 +9,7 @@ module M : sig
   val dataset_module : t
 end
 
+module Attr = Attr
 module Vnode = Vnode
 
 val init : M.t list -> [< `Element of Brr.El.t | `Vnode of Vnode.t ] -> Vnode.t -> unit

lib/vnode.ml

@@ -5,13 +5,14 @@ type t = Jv.t
 let h = get_global "h"
 let to_jv t = t
 
-type vnode_data = Jv.t
 type children = Jv.t list
-type create_with_children = vnode_data -> children -> t
-type create_without_children = vnode_data -> t
+type create_with_children = Attr.t list -> children -> t
+type create_without_children = Attr.t list -> t
 
 let make_node selector vnode_data children =
-  Jv.apply h [| Jv.of_string selector; vnode_data; Jv.of_jv_list children |]
+  Jv.apply
+    h
+    [| Jv.of_string selector; Attr.attrs_to_jv vnode_data; Jv.of_jv_list children |]
 
 let text t = Jv.of_string t
 let br data = make_node "br" data []

lib/vnode.mli

@@ -2,8 +2,8 @@ type t
 
 val to_jv : t -> Jv.t
 
-type create_with_children = Jv.t -> t list -> t
-type create_without_children = Jv.t -> t
+type create_with_children = Attr.t list -> t list -> t
+type create_without_children = Attr.t list -> t
 
 val make_node : string -> create_with_children
 val text : string -> t

tyxml/snabbdom_tyxml.ml

@@ -15,59 +15,36 @@ module Xml_vnode = struct
   type mouse_event_handler = Brr.Ev.Mouse.t Brr.Ev.t -> unit
   type keyboard_event_handler = Brr.Ev.Keyboard.t Brr.Ev.t -> unit
   type touch_event_handler = Jv.t -> unit
-  type attrib = [ `Event of string | `Attr of string ] * Jv.t
+  type attrib = Attr.t
 
-  let float_attrib name f = `Attr name, Jv.of_float f
-  let int_attrib name f = `Attr name, Jv.of_int f
-  let string_attrib name f = `Attr name, Jv.of_string f
-  let space_sep_attrib name xs = `Attr name, Jv.of_string (String.concat " " xs)
-  let comma_sep_attrib name xs = `Attr name, Jv.of_string (String.concat "," xs)
-  let event_handler_attrib name handler = `Event name, Jv.repr handler
-  let mouse_event_handler_attrib name handler = `Event name, Jv.repr handler
-  let touch_event_handler_attrib name handler = `Event name, Jv.repr handler
-  let keyboard_event_handler_attrib name handler = `Event name, Jv.repr handler
-  let uri_attrib name value = `Attr name, Jv.of_string value
-  let uris_attrib name values = `Attr name, Jv.of_string (String.concat " " values)
+  (* TODO: This is just temporary to verify that this approach can work. Tyxml sends
+     events like [onclick] but snabbdom expects keys like [click] *)
+  let make_event_name name = String.sub name 2 (String.length name - 2)
+  let float_attrib name f = Attr.float name f
+  let int_attrib name f = Attr.int name f
+  let string_attrib name f = Attr.string name f
+  let space_sep_attrib name xs = string_attrib name (String.concat " " xs)
+  let comma_sep_attrib name xs = string_attrib name (String.concat "," xs)
+  let event_handler_attrib name handler = Attr.unsafe_event (make_event_name name) handler
 
-  type aname = string
-  type elt = Vnode.t
-  type ename = string
+  let mouse_event_handler_attrib name handler =
+    Attr.mouse_event (make_event_name name) handler
 
-  module StringSet = Set.Make (struct
-    type t = string
+  let touch_event_handler_attrib name handler =
+    Attr.unsafe_event (make_event_name name) handler
 
-    let compare a b =
-      let a = String.lowercase_ascii a in
-      let b = String.lowercase_ascii b in
-      String.compare a b
-  end)
+  let keyboard_event_handler_attrib name handler =
+    Attr.keyboard_event (make_event_name name) handler
 
-  let attributes_to_skip = StringSet.of_list [ "xmlns"; "xmlns:xlink" ]
+  let uri_attrib name value = string_attrib name value
+  let uris_attrib name values = string_attrib name (String.concat " " values)
 
-  let make_attrs (a : attrib list option) =
-    match a with
-    | None -> Jv.null
-    | Some attrs ->
-      let events, attrs =
-        List.fold_left
-          (fun (events, attrs) t ->
-            match t with
-            | `Attr name, v ->
-              if StringSet.mem name attributes_to_skip
-              then events, attrs
-              else events, (name, v) :: attrs
-            (* TODO: This is just temporary to verify that this approach can work. Tyxml
-               sends events like [onclick] but snabbdom expects keys like [click] *)
-            | `Event name, v ->
-              (String.sub name 2 (String.length name - 2), v) :: events, attrs)
-          ([], [])
-          attrs
-      in
-      Jv.obj
-        [| "attrs", Jv.obj (Array.of_list attrs); "on", Jv.obj (Array.of_list events) |]
+  type aname = string
+  type elt = Vnode.t
+  type ename = string
 
-  let leaf ?a name = Vnode.make_node name (make_attrs a) []
-  let node ?a name children = Vnode.make_node name (make_attrs a) children
+  let leaf ?(a = []) name = Vnode.make_node name a []
+  let node ?(a = []) name children = Vnode.make_node name a children
   let empty () = assert false
   let comment _c = assert false
   let pcdata = Vnode.text