[js] Place conversion functions on their own file.

ejgallego · Oct 1, 2024 · 5cca781 · 5cca781
1 parent 94f321c
commit 5cca781
Show file tree

Hide file tree

Showing 3 changed files with 74 additions and 65 deletions.
diff --git a/controller-js/coq_lsp_worker.ml b/controller-js/coq_lsp_worker.ml
@@ -14,59 +14,6 @@ module LSP = Lsp.Base
 open Js_of_ocaml
 open Controller
 
-let rec obj_to_json (cobj : < .. > Js.t) : Yojson.Safe.t =
-  let open Js in
-  let open Js.Unsafe in
-  let typeof_cobj = to_string (typeof cobj) in
-  match typeof_cobj with
-  | "string" -> `String (to_string @@ coerce cobj)
-  | "boolean" -> `Bool (to_bool @@ coerce cobj)
-  | "number" -> `Int (int_of_float @@ float_of_number @@ coerce cobj)
-  | _ ->
-    if instanceof cobj array_empty then
-      `List Array.(to_list @@ map obj_to_json @@ to_array @@ coerce cobj)
-    else if instanceof cobj Typed_array.arrayBuffer then
-      `String (Typed_array.String.of_arrayBuffer @@ coerce cobj)
-    else if instanceof cobj Typed_array.uint8Array then
-      `String (Typed_array.String.of_uint8Array @@ coerce cobj)
-      (* Careful in case we miss cases here *)
-    else if instanceof cobj Unsafe.global##._Object then
-      Js.array_map
-        (fun key -> (Js.to_string key, obj_to_json (Js.Unsafe.get cobj key)))
-        (Js.object_keys cobj)
-      |> Js.to_array |> Array.to_list
-      |> fun al -> `Assoc al
-    else if Js.Opt.(strict_equals (some cobj) null) then `Null
-    else if Js.Optdef.(strict_equals (def cobj) undefined) then (
-      Firebug.console##info "undefined branch!!!!";
-      `Null)
-    else (
-      Firebug.console##error "failure in coq_lsp_worker:obj_to_json";
-      Firebug.console##error cobj;
-      Firebug.console##error (Json.output cobj);
-      raise (Failure "coq_lsp_worker:obj_to_json"))
-
-(* Old code, which is only useful for debug *)
-(* let json_string = Js.to_string (Json.output cobj) in *)
-(* Yojson.Safe.from_string json_string *)
-
-let rec json_to_obj (cobj : < .. > Js.t) (json : Yojson.Safe.t) : < .. > Js.t =
-  let open Js.Unsafe in
-  let ofresh j = json_to_obj (obj [||]) j in
-  match json with
-  | `Bool b -> coerce @@ Js.bool b
-  | `Null -> pure_js_expr "null"
-  | `Assoc l ->
-    List.iter (fun (p, js) -> set cobj p (ofresh js)) l;
-    cobj
-  | `List l -> Array.(Js.array @@ map ofresh (of_list l))
-  | `Float f -> coerce @@ Js.number_of_float f
-  | `String s -> coerce @@ Js.string s
-  | `Int m -> coerce @@ Js.number_of_float (float_of_int m)
-  | `Intlit s -> coerce @@ Js.number_of_float (float_of_string s)
-  | `Tuple t -> Array.(Js.array @@ map ofresh (of_list t))
-  | `Variant (_, _) -> pure_js_expr "undefined"
-
 let findlib_conf = "\ndestdir=\"/static/lib\"path=\"/static/lib\""
 let findlib_path = "/static/lib/findlib.conf"
 
@@ -82,7 +29,7 @@ let setup_std_printers () =
 
 let post_message (msg : Lsp.Base.Message.t) =
   let json = Lsp.Base.Message.to_yojson msg in
-  let js = json_to_obj (Js.Unsafe.obj [||]) json in
+  let js = Jsso.json_to_obj json in
   Worker.post_message js
 
 type opaque
@@ -91,15 +38,6 @@ external interrupt_setup : opaque (* Uint32Array *) -> unit = "interrupt_setup"
 
 let interrupt_is_setup = ref false
 
-let parse_msg msg =
-  if Js.instanceof msg Js.array_length then (
-    let _method_ = Js.array_get msg 0 in
-    let handle = Js.array_get msg 1 |> Obj.magic in
-    interrupt_setup handle;
-    interrupt_is_setup := true;
-    Error "processed interrupt_setup")
-  else obj_to_json msg |> Lsp.Base.Message.of_yojson
-
 let log_interrupt () =
   let lvl, message =
     if not !interrupt_is_setup then
@@ -109,11 +47,20 @@ let log_interrupt () =
   in
   Lsp.Io.logMessage ~lvl ~message
 
+let parse_msg msg =
+  if Js.instanceof msg Js.array_empty then (
+    let _method_ = Js.array_get msg 0 in
+    let handle = Js.array_get msg 1 |> Obj.magic in
+    interrupt_setup handle;
+    interrupt_is_setup := true;
+    Error "processed interrupt_setup")
+  else Jsso.obj_to_json msg |> Lsp.Base.Message.of_yojson
+
 let on_msg msg =
   match parse_msg msg with
   | Error _ ->
-    Lsp.Io.logMessage ~lvl:Lsp.Io.Lvl.Error
-      ~message:"Error in JSON RPC Message Parsing"
+    let message = "Error in JSON RPC Message Parsing" in
+    Lsp.Io.logMessage ~lvl:Lsp.Io.Lvl.Error ~message
   | Ok msg ->
     (* Lsp.Io.trace "interrupt_setup" (string_of_bool !interrupt_is_setup); *)
     Lsp_core.enqueue_message msg

diff --git a/controller-js/jsso.ml b/controller-js/jsso.ml
@@ -0,0 +1,57 @@
+open Js_of_ocaml
+
+let rec obj_to_json (cobj : < .. > Js.t) : Yojson.Safe.t =
+  let open Js in
+  let open Js.Unsafe in
+  let typeof_cobj = to_string (typeof cobj) in
+  match typeof_cobj with
+  | "string" -> `String (to_string @@ coerce cobj)
+  | "boolean" -> `Bool (to_bool @@ coerce cobj)
+  | "number" -> `Int (int_of_float @@ float_of_number @@ coerce cobj)
+  | _ ->
+    if instanceof cobj array_empty then
+      `List Array.(to_list @@ map obj_to_json @@ to_array @@ coerce cobj)
+    else if instanceof cobj Typed_array.arrayBuffer then
+      `String (Typed_array.String.of_arrayBuffer @@ coerce cobj)
+    else if instanceof cobj Typed_array.uint8Array then
+      `String (Typed_array.String.of_uint8Array @@ coerce cobj)
+      (* Careful in case we miss cases here, what about '{}' for example, we
+         should also stop on functions? *)
+    else if instanceof cobj Unsafe.global##._Object then
+      Js.array_map
+        (fun key -> (Js.to_string key, obj_to_json (Js.Unsafe.get cobj key)))
+        (Js.object_keys cobj)
+      |> Js.to_array |> Array.to_list
+      |> fun al -> `Assoc al
+    else if Js.Opt.(strict_equals (some cobj) null) then `Null
+    else if Js.Optdef.(strict_equals (def cobj) undefined) then (
+      Firebug.console##info "undefined branch!!!!";
+      `Null)
+    else (
+      Firebug.console##error "failure in coq_lsp_worker:obj_to_json";
+      Firebug.console##error cobj;
+      Firebug.console##error (Json.output cobj);
+      raise (Failure "coq_lsp_worker:obj_to_json"))
+
+(* Old code, which is only useful for debug *)
+(* let json_string = Js.to_string (Json.output cobj) in *)
+(* Yojson.Safe.from_string json_string *)
+
+let rec json_to_obj (cobj : < .. > Js.t) (json : Yojson.Safe.t) : < .. > Js.t =
+  let open Js.Unsafe in
+  let ofresh j = json_to_obj (obj [||]) j in
+  match json with
+  | `Bool b -> coerce @@ Js.bool b
+  | `Null -> pure_js_expr "null"
+  | `Assoc l ->
+    List.iter (fun (p, js) -> set cobj p (ofresh js)) l;
+    coerce @@ cobj
+  | `List l -> coerce @@ Array.(Js.array @@ map ofresh (of_list l))
+  | `Float f -> coerce @@ Js.number_of_float f
+  | `String s -> coerce @@ Js.string s
+  | `Int m -> coerce @@ Js.number_of_float (float_of_int m)
+  | `Intlit s -> coerce @@ Js.number_of_float (float_of_string s)
+  | `Tuple t -> coerce @@ Array.(Js.array @@ map ofresh (of_list t))
+  | `Variant (_, _) -> pure_js_expr "undefined"
+
+let json_to_obj json = json_to_obj (Js.Unsafe.obj [||]) json
diff --git a/controller-js/jsso.mli b/controller-js/jsso.mli
@@ -0,0 +1,5 @@
+open Js_of_ocaml
+
+(* Object to Yojson converter *)
+val obj_to_json : < .. > Js.t -> Yojson.Safe.t
+val json_to_obj : Yojson.Safe.t -> < .. > Js.t