Lib: add message event types and PerformanceObserver

CHANGES.md

@@ -1,6 +1,8 @@
 # dev (2021-??-??) - ??
 ## Features/Changes
 * Compiler: static evaluation of backend_type
+* Lib: add messageEvent to Dom_html
+* Lib: add PerformanceObserver API
 
 ## Bug fixes
 * Compiler: fix sourcemap warning for empty cma

lib/js_of_ocaml/dom_html.ml

@@ -619,6 +619,15 @@ and mediaEvent =
     inherit event
   end
 
+and messageEvent =
+  object
+    inherit event
+
+    method data : Unsafe.any opt readonly_prop
+
+    method source : Unsafe.any opt readonly_prop
+  end
+
 and nodeSelector =
   object
     method querySelector : js_string t -> element t opt meth
@@ -881,6 +890,8 @@ module Event = struct
 
   let lostpointercapture = Dom.Event.make "lostpointercapture"
 
+  let message = Dom.Event.make "message"
+
   let pause = Dom.Event.make "pause"
 
   let play = Dom.Event.make "play"
@@ -2815,6 +2826,8 @@ module CoerceTo = struct
   let mouseScrollEvent ev = unsafeCoerceEvent Js.Unsafe.global##._MouseScrollEvent ev
 
   let popStateEvent ev = unsafeCoerceEvent Js.Unsafe.global##._PopStateEvent ev
+
+  let messageEvent ev = unsafeCoerceEvent Js.Unsafe.global##._MessageEvent ev
 end
 
 (****)
@@ -3550,6 +3563,7 @@ let opt_tagged e = Opt.case e (fun () -> None) (fun e -> Some (tagged e))
 type taggedEvent =
   | MouseEvent of mouseEvent t
   | KeyboardEvent of keyboardEvent t
+  | MessageEvent of messageEvent t
   | MousewheelEvent of mousewheelEvent t
   | MouseScrollEvent of mouseScrollEvent t
   | PopStateEvent of popStateEvent t
@@ -3570,7 +3584,11 @@ let taggedEvent (ev : #event Js.t) =
                 (fun () ->
                   Js.Opt.case
                     (CoerceTo.popStateEvent ev)
-                    (fun () -> OtherEvent (ev :> event t))
+                    (fun () ->
+                      Js.Opt.case
+                        (CoerceTo.messageEvent ev)
+                        (fun () -> OtherEvent (ev :> event t))
+                        (fun ev -> MessageEvent ev))
                     (fun ev -> PopStateEvent ev))
                 (fun ev -> MouseScrollEvent ev))
             (fun ev -> MousewheelEvent ev))

lib/js_of_ocaml/dom_html.mli

@@ -631,6 +631,15 @@ and mediaEvent =
     inherit event
   end
 
+and messageEvent =
+  object
+    inherit event
+
+    method data : Unsafe.any opt readonly_prop
+
+    method source : Unsafe.any opt readonly_prop
+  end
+
 (** {2 HTML elements} *)
 
 and nodeSelector =
@@ -2439,6 +2448,8 @@ module Event : sig
 
   val lostpointercapture : pointerEvent t typ
 
+  val message : messageEvent t typ
+
   val pause : mediaEvent t typ
 
   val play : mediaEvent t typ
@@ -2972,6 +2983,7 @@ val opt_tagged : #element t opt -> taggedElement option
 type taggedEvent =
   | MouseEvent of mouseEvent t
   | KeyboardEvent of keyboardEvent t
+  | MessageEvent of messageEvent t
   | MousewheelEvent of mousewheelEvent t
   | MouseScrollEvent of mouseScrollEvent t
   | PopStateEvent of popStateEvent t
@@ -3123,6 +3135,8 @@ module CoerceTo : sig
   val mouseScrollEvent : #event t -> mouseScrollEvent t opt
 
   val popStateEvent : #event t -> popStateEvent t opt
+
+  val messageEvent : #event t -> messageEvent t opt
 end
 
 type timeout_id_safe

lib/js_of_ocaml/js_of_ocaml.ml

@@ -33,6 +33,7 @@ module Js = Js
 module Json = Json
 module Jstable = Jstable
 module MutationObserver = MutationObserver
+module PerformanceObserver = PerformanceObserver
 module ResizeObserver = ResizeObserver
 module Regexp = Regexp
 module Sys_js = Sys_js

lib/js_of_ocaml/performanceObserver.ml

@@ -0,0 +1,49 @@
+open! Import
+
+class type performanceObserverInit =
+  object
+    method entryTypes : Js.js_string Js.t Js.js_array Js.t Js.writeonly_prop
+  end
+
+class type performanceEntry =
+  object
+    method name : Js.js_string Js.t Js.readonly_prop
+
+    method entryType : Js.js_string Js.t Js.readonly_prop
+
+    method startTime : float Js.readonly_prop
+
+    method duration : float Js.readonly_prop
+  end
+
+class type performanceObserverEntryList =
+  object
+    method getEntries : performanceEntry Js.t Js.js_array Js.t Js.meth
+  end
+
+class type performanceObserver =
+  object
+    method observe : performanceObserverInit Js.t -> unit Js.meth
+
+    method disconnect : unit Js.meth
+
+    method takeRecords : performanceEntry Js.t Js.js_array Js.t Js.meth
+  end
+
+let performanceObserver = Js.Unsafe.global##._PerformanceObserver
+
+let is_supported () = Js.Optdef.test performanceObserver
+
+let performanceObserver :
+    (   (performanceObserverEntryList Js.t -> performanceObserver Js.t -> unit) Js.callback
+     -> performanceObserver Js.t)
+    Js.constr =
+  performanceObserver
+
+let observe ~entry_types ~f =
+  let entry_types = entry_types |> List.map Js.string |> Array.of_list |> Js.array in
+  let performance_observer_init : performanceObserverInit Js.t = Js.Unsafe.obj [||] in
+  let () = performance_observer_init##.entryTypes := entry_types in
+  let obs = new%js performanceObserver (Js.wrap_callback f) in
+  let () = obs##observe performance_observer_init in
+  obs

lib/js_of_ocaml/performanceObserver.mli

@@ -0,0 +1,59 @@
+(** PerformanceObserver API
+
+    A code example:
+    {[
+      if (PerformanceObserver.is_supported()) then
+        let entry_types = [ "measure" ] in
+        let f entries observer =
+          let entries = entries##getEntries in
+          Firebug.console##debug entries ;
+          Firebug.console##debug observer
+        in
+        PerformanceObserver.observe ~entry_types ~f
+        ()
+   ]}
+
+   @see <https://developer.mozilla.org/en-US/docs/Web/API/PerformanceObserver> for API documentation.
+*)
+
+class type performanceObserverInit =
+  object
+    method entryTypes : Js.js_string Js.t Js.js_array Js.t Js.writeonly_prop
+  end
+
+class type performanceEntry =
+  object
+    method name : Js.js_string Js.t Js.readonly_prop
+
+    method entryType : Js.js_string Js.t Js.readonly_prop
+
+    method startTime : float Js.readonly_prop
+
+    method duration : float Js.readonly_prop
+  end
+
+class type performanceObserverEntryList =
+  object
+    method getEntries : performanceEntry Js.t Js.js_array Js.t Js.meth
+  end
+
+class type performanceObserver =
+  object
+    method observe : performanceObserverInit Js.t -> unit Js.meth
+
+    method disconnect : unit Js.meth
+
+    method takeRecords : performanceEntry Js.t Js.js_array Js.t Js.meth
+  end
+
+val performanceObserver :
+  (   (performanceObserverEntryList Js.t -> performanceObserver Js.t -> unit) Js.callback
+   -> performanceObserver Js.t)
+  Js.constr
+
+val is_supported : unit -> bool
+
+val observe :
+     entry_types:string list
+  -> f:(performanceObserverEntryList Js.t -> performanceObserver Js.t -> unit)
+  -> performanceObserver Js.t