Use first-class sequences, iterators, & generators

This also cleans up some of the decoding functions.
johnridesabike · Nov 23, 2024 · a027715 · a027715
1 parent be94352
commit a027715
Show file tree

Hide file tree

Showing 11 changed files with 1,301 additions and 1,415 deletions.
diff --git a/acutis.ml b/acutis.ml
diff --git a/acutis.mli b/acutis.mli
@@ -171,22 +171,23 @@ end
 module type DECODABLE = sig
   (** Decode and encode input data. *)
 
-  (** {1 Container types.} *)
-
-  type 'a linear
-  (** A linear container such as a list or array. *)
-
-  val length : 'a linear -> int
-  val iteri : (int -> 'a -> unit) -> 'a linear -> unit
+  type t
 
   type 'a assoc
   (** A key-value container such as an association list or a string map. *)
 
+  (** {1 Decoding} *)
+
+  val get_int : t -> int option
+  val get_string : t -> string option
+  val get_float : t -> float option
+  val get_bool : t -> bool option
+  val get_some : t -> t option
+  val get_seq : t -> t Seq.t option
+  val get_assoc : t -> t assoc option
   val assoc_find : string -> 'a assoc -> 'a
   val assoc_mem : string -> 'a assoc -> bool
-  val assoc_iter : (string -> 'a -> unit) -> 'a assoc -> unit
-
-  type t
+  val assoc_to_seq : 'a assoc -> (string * 'a) Seq.t
 
   (** {1 Encoding} *)
 
@@ -196,18 +197,8 @@ module type DECODABLE = sig
   val of_string : string -> t
   val of_bool : bool -> t
   val of_int : int -> t
-  val of_array : t array -> t
-  val of_assoc : (string * t) Seq.t -> t
-
-  (** {1 Decoding} *)
-
-  val decode_int : t -> int option
-  val decode_string : t -> string option
-  val decode_float : t -> float option
-  val decode_bool : t -> bool option
-  val decode_some : t -> t option
-  val decode_linear : t -> t linear option
-  val decode_assoc : t -> t assoc option
+  val of_seq : t Seq.t -> t
+  val of_seq_assoc : (string * t) Seq.t -> t
 
   (** {1 Debugging} *)
 

diff --git a/acutis_cli.ml b/acutis_cli.ml
@@ -9,34 +9,32 @@
 (**************************************************************************)
 
 module Json = struct
-  type 'a linear = 'a list
+  type t = Yojson.Basic.t
+  type 'a assoc = (string * 'a) list
 
-  let length = List.length
-  let iteri = List.iteri
+  let get_int = function `Int x -> Some x | _ -> None
+  let get_string = function `String x -> Some x | _ -> None
 
-  type 'a assoc = (string * 'a) list
+  let get_float = function
+    | `Float x -> Some x
+    | `Int x -> Some (Float.of_int x)
+    | _ -> None
 
+  let get_bool = function `Bool x -> Some x | _ -> None
+  let get_some = function `Null -> None | x -> Some x
+  let get_seq = function `List x -> Some (List.to_seq x) | _ -> None
+  let get_assoc = function `Assoc x -> Some x | _ -> None
   let assoc_find = List.assoc
   let assoc_mem = List.mem_assoc
-  let assoc_iter f l = List.iter (fun (k, v) -> f k v) l
-
-  type t = Yojson.Basic.t
-
+  let assoc_to_seq = List.to_seq
   let null = `Null
   let some = Fun.id
   let of_float x = `Float x
   let of_string x = `String x
   let of_bool x = `Bool x
   let of_int x = `Int x
-  let of_array x = `List (Array.to_list x)
-  let of_assoc x = `Assoc (List.of_seq x)
-  let decode_int = function `Int x -> Some x | _ -> None
-  let decode_string = function `String x -> Some x | _ -> None
-  let decode_float = function `Float x -> Some x | _ -> None
-  let decode_bool = function `Bool x -> Some x | _ -> None
-  let decode_linear = function `List x -> Some x | _ -> None
-  let decode_assoc = function `Assoc x -> Some x | _ -> None
-  let decode_some = function `Null -> None | x -> Some x
+  let of_seq x = `List (List.of_seq x)
+  let of_seq_assoc x = `Assoc (List.of_seq x)
   let to_string t = Yojson.Basic.pretty_to_string t
 end
 

diff --git a/acutis_js.ml b/acutis_js.ml
@@ -11,10 +11,7 @@
 open Js_of_ocaml
 
 module DecodeJs = struct
-  type 'a linear = 'a Js.js_array Js.t
-
-  let length a = a##.length
-  let iteri f a = a##forEach (Js.wrap_callback (fun v i _ -> f i v))
+  type t = Js.Unsafe.any
 
   type 'a assoc = Js.Unsafe.any
   (** When we convert JavaScript objects into Acutis records, we cannot convert
@@ -24,63 +21,74 @@ module DecodeJs = struct
       accessing the precise values that we need, we avoid triggering unexpected
       behavior. *)
 
-  let assoc_find : string -> 'a assoc -> 'a =
-   fun k m -> Js.Unsafe.get m (Js.string k)
-
-  let assoc_mem : string -> 'a assoc -> bool =
-   fun k m -> Js.Unsafe.global##._Object##hasOwn m (Js.string k) |> Js.to_bool
-
-  let assoc_iter : (string -> 'a -> unit) -> 'a assoc -> unit =
-   fun f m ->
-    (Js.object_keys m)##forEach
-      (Js.wrap_callback (fun k _ _ -> f (Js.to_string k) (Js.Unsafe.get m k)))
-
-  type t = Js.Unsafe.any
-
   let coerce = Js.Unsafe.coerce
-  let null = Js.Unsafe.inject Js.null
-  let some = Fun.id
-  let of_float x = Js.number_of_float x |> coerce
-  let of_string x = Js.string x |> coerce
-  let of_bool x = Js.bool x |> coerce
-  let of_int x = Float.of_int x |> Js.number_of_float |> coerce
-  let of_array x = Js.array x |> coerce
-  let of_assoc x = Array.of_seq x |> Js.Unsafe.obj
 
-  let decode_int j =
+  let get_int j =
     match Js.to_string (Js.typeof j) with
     | "number" ->
         let n = coerce j |> Js.float_of_number in
         if Float.is_integer n then Some (Float.to_int n) else None
     | _ -> None
 
-  let decode_string j =
+  let get_string j =
     match Js.to_string (Js.typeof j) with
     | "string" -> Some (coerce j |> Js.to_string)
     | _ -> None
 
-  let decode_float j =
+  let get_float j =
     match Js.to_string (Js.typeof j) with
     | "number" -> Some (coerce j |> Js.float_of_number)
     | _ -> None
 
-  let decode_bool j =
+  let get_bool j =
     match Js.to_string (Js.typeof j) with
     | "boolean" -> Some (coerce j |> Js.to_bool)
     | _ -> None
 
-  let decode_linear j =
-    if Js.Unsafe.global##._Array##isArray j then Some (coerce j) else None
+  let get_some j =
+    match Js.to_string (Js.typeof j) with
+    | "undefined" -> None
+    | _ -> Js.Opt.to_option (Js.Opt.return j)
 
-  let decode_assoc j =
+  let get_seq j =
+    if Js.Unsafe.global##._Array##isArray j then
+      let a = coerce j in
+      let rec aux i () =
+        Js.Optdef.case (Js.array_get a i)
+          (fun () -> Seq.Nil)
+          (fun x -> Seq.Cons (x, aux (succ i)))
+      in
+      Some (aux 0)
+    else None
+
+  let get_assoc j =
     match Js.to_string (Js.typeof j) with
     | "object" -> Js.Opt.to_option (Js.Opt.return j)
     | _ -> None
 
-  let decode_some j =
-    match Js.to_string (Js.typeof j) with
-    | "undefined" -> None
-    | _ -> Js.Opt.to_option (Js.Opt.return j)
+  let assoc_find : string -> 'a assoc -> 'a =
+   fun k m -> Js.Unsafe.get m (Js.string k)
+
+  let assoc_mem : string -> 'a assoc -> bool =
+   fun k m -> Js.Unsafe.global##._Object##hasOwn m (Js.string k) |> Js.to_bool
+
+  let assoc_to_seq m =
+    let keys = Js.object_keys m in
+    let rec aux i () =
+      Js.Optdef.case (Js.array_get keys i)
+        (fun () -> Seq.Nil)
+        (fun k -> Seq.Cons ((Js.to_string k, Js.Unsafe.get m k), aux (succ i)))
+    in
+    aux 0
+
+  let null = Js.Unsafe.inject Js.null
+  let some = Fun.id
+  let of_float x = Js.number_of_float x |> coerce
+  let of_string x = Js.string x |> coerce
+  let of_bool x = Js.bool x |> coerce
+  let of_int x = Float.of_int x |> Js.number_of_float |> coerce
+  let of_seq x = Array.of_seq x |> Js.array |> coerce
+  let of_seq_assoc x = Array.of_seq x |> Js.Unsafe.obj
 
   let to_string j =
     Js.Unsafe.fun_call Js.Unsafe.global##._String [| j |] |> Js.to_string