@tellahq/rescript 10.1.4-republish-2 → 10.1.4-republish-3

package/lib/ocaml/js_json.ml

@@ -0,0 +1,195 @@
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+(** Efficient JSON encoding using JavaScript API *)
+
+type t
+
+type _ kind =
+  | String : Js_string.t kind
+  | Number : float kind
+  | Object : t Js_dict.t kind
+  | Array : t array kind
+  | Boolean : bool kind
+  | Null : Js_types.null_val kind
+
+
+type tagged_t =
+  | JSONFalse
+  | JSONTrue
+  | JSONNull
+  | JSONString of string
+  | JSONNumber of float
+  | JSONObject of t Js_dict.t
+  | JSONArray of t array
+
+let classify  (x : t) : tagged_t =
+  let ty = Js.typeof x in
+  if ty = "string" then
+    JSONString (Obj.magic x)
+  else if ty = "number" then
+    JSONNumber (Obj.magic x )
+  else if ty = "boolean" then
+    if (Obj.magic x) = true then JSONTrue
+    else JSONFalse
+  else if (Obj.magic x) == Js.null then
+    JSONNull
+  else if Js_array2.isArray x  then
+    JSONArray (Obj.magic x)
+  else
+    JSONObject (Obj.magic x)
+
+
+let test (type a) (x : 'a) (v : a kind) : bool =
+  match v with
+  | Number -> Js.typeof x = "number"
+  | Boolean -> Js.typeof x = "boolean"
+  | String -> Js.typeof x = "string"
+  | Null -> (Obj.magic x) == Js.null
+  | Array -> Js_array2.isArray x
+  | Object -> (Obj.magic x) != Js.null && Js.typeof x = "object" && not (Js_array2.isArray x )
+
+let decodeString json =
+  if Js.typeof json = "string"
+  then Some (Obj.magic (json:t) : string)
+  else None
+
+let decodeNumber json =
+  if Js.typeof json = "number"
+  then Some (Obj.magic (json:t) : float)
+  else None
+
+let decodeObject json =
+  if  Js.typeof json = "object" &&
+      not (Js_array2.isArray json) &&
+      not ((Obj.magic json : 'a Js.null) == Js.null)
+  then Some (Obj.magic (json:t) : t Js_dict.t)
+  else None
+
+let decodeArray json =
+  if Js_array2.isArray json
+  then Some (Obj.magic (json:t) : t array)
+  else None
+
+let decodeBoolean (json : t) =
+  if Js.typeof json = "boolean"
+  then Some (Obj.magic (json:t) : bool)
+  else None
+
+let decodeNull json : _ Js.null option =
+  if (Obj.magic json : 'a Js.null) == Js.null
+  then Some Js.null
+  else None
+
+(* external parse : string -> t = "parse"
+  [@@bs.val][@@bs.scope "JSON"] *)
+
+external parseExn : string -> t = "parse"
+  [@@bs.val] [@@bs.scope "JSON"]
+
+external stringifyAny : 'a -> string option =
+"stringify" [@@bs.val]  [@@bs.scope "JSON"]
+(* TODO: more docs when parse error happens or stringify non-stringfy value *)
+
+external null : t = "null" [@@bs.val]
+external string : string -> t = "%identity"
+external number : float -> t = "%identity"
+external boolean : bool -> t = "%identity"
+external object_ : t Js_dict.t -> t = "%identity"
+
+(* external array_ : t array -> t = "%identity" *)
+
+external array : t array -> t = "%identity"
+external stringArray : string array -> t = "%identity"
+external numberArray : float array -> t = "%identity"
+external booleanArray : bool array -> t = "%identity"
+external objectArray : t Js_dict.t array -> t = "%identity"
+external stringify: t -> string = "stringify"
+  [@@bs.val] [@@bs.scope "JSON"]
+external stringifyWithSpace: t -> (_ [@bs.as {json|null|json}]) -> int -> string = "stringify"
+  [@@bs.val] [@@bs.scope "JSON"]
+
+
+(* in memory modification does not work until your root is
+   actually None, so we need wrap it as ``v`` and
+   return the first element instead *)
+
+let patch : _ -> _ = [%raw{|function (json) {
+  var x = [json];
+  var q = [{ kind: 0, i: 0, parent: x }];
+  while (q.length !== 0) {
+    // begin pop the stack
+    var cur = q[q.length - 1];
+    if (cur.kind === 0) {
+      cur.val = cur.parent[cur.i]; // patch the undefined value for array
+      if (++cur.i === cur.parent.length) {
+        q.pop();
+      }
+    } else {
+      q.pop();
+    }
+    // finish
+    var task = cur.val;
+    if (typeof task === "object") {
+      if (Array.isArray(task) && task.length !== 0) {
+        q.push({ kind: 0, i: 0, parent: task, val: undefined });
+      } else {
+        for (var k in task) {
+          if (k === "RE_PRIVATE_NONE") {
+            if (cur.kind === 0) {
+              cur.parent[cur.i - 1] = undefined;
+            } else {
+              cur.parent[cur.i] = undefined;
+            }
+            continue;
+          }
+          q.push({ kind: 1, i: k, parent: task, val: task[k] });
+        }
+      }
+    }
+  }
+  return x[0];
+}
+|}]
+
+
+let serializeExn (type t) (x : t) : string  = [%raw{| function(obj){
+  var output= JSON.stringify(obj,function(_,value){
+      if(value===undefined){
+          return {RE_PRIVATE_NONE : true}
+      }
+    return value
+  });
+  
+ if(output === undefined){
+   // JSON.stringify will raise TypeError when it detects cylic objects
+   throw new TypeError("output is undefined")
+ }
+ return output 
+ }
+|}] x 
+
+let deserializeUnsafe (s: string) : 'a = 
+  patch (parseExn s)
+

package/lib/ocaml/js_json.mli

@@ -0,0 +1,244 @@
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+(**
+  Efficient JSON encoding using JavaScript API
+
+  **see** [MDN](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/JSON)
+*)
+
+(** ## Types *)
+
+type t
+(** The JSON data structure *)
+
+(** Underlying type of a JSON value *)
+type _ kind =
+  | String : Js_string.t kind
+  | Number : float kind
+  | Object : t Js_dict.t kind
+  | Array : t array kind
+  | Boolean : bool kind
+  | Null : Js_types.null_val kind
+
+type tagged_t =
+  | JSONFalse
+  | JSONTrue
+  | JSONNull
+  | JSONString of string
+  | JSONNumber of float
+  | JSONObject of t Js_dict.t
+  | JSONArray of t array
+
+(** ## Accessor *)
+
+val classify : t -> tagged_t
+
+val test : 'a -> 'b kind -> bool
+(** `test(v, kind)` returns `true` if `v` is of `kind`. *)
+
+val decodeString : t -> Js_string.t option
+(** `decodeString(json)` returns `Some(s)` if `json` is a `string`, `None` otherwise. *)
+
+val decodeNumber : t -> float option
+(** `decodeNumber(json)` returns `Some(n)` if `json` is a `number`, `None` otherwise. *)
+
+val decodeObject : t -> t Js_dict.t option
+(** `decodeObject(json)` returns `Some(o)` if `json` is an `object`, `None` otherwise. *)
+
+val decodeArray : t -> t array option
+(** `decodeArray(json)` returns `Some(a)` if `json` is an `array`, `None` otherwise. *)
+
+val decodeBoolean : t -> bool option
+(** `decodeBoolean(json)` returns `Some(b)` if `json` is a `boolean`, `None` otherwise. *)
+
+val decodeNull : t -> 'a Js_null.t option
+(** `decodeNull(json)` returns `Some(null)` if `json` is a `null`, `None` otherwise. *)
+
+(** ## Construtors *)
+
+(*
+   Those functions allows the construction of an arbitrary complex
+   JSON values.
+*)
+
+external null : t = "null"
+  [@@bs.val]
+(** `null` is the singleton null JSON value. *)
+
+external string : string -> t = "%identity"
+(** `string(s)` makes a JSON string of the `string` `s`. *)
+
+external number : float -> t = "%identity"
+(** `number(n)` makes a JSON number of the `float` `n`. *)
+
+external boolean : bool -> t = "%identity"
+(** `boolean(b)` makes a JSON boolean of the `bool` `b`. *)
+
+external object_ : t Js_dict.t -> t = "%identity"
+(** `object_(dict)` makes a JSON object of the `Js.Dict.t` `dict`. *)
+
+external array : t array -> t = "%identity"
+(** `array_(a)` makes a JSON array of the `Js.Json.t` array `a`. *)
+
+(*
+  The functions below are specialized for specific array type which
+  happened to be already JSON object in the ReScript runtime. Therefore
+  they are more efficient (constant time rather than linear conversion).
+*)
+
+external stringArray : string array -> t = "%identity"
+(** `stringArray(a)` makes a JSON array of the `string` array `a`. *)
+
+external numberArray : float array -> t = "%identity"
+(** `numberArray(a)` makes a JSON array of the `float` array `a`. *)
+
+external booleanArray : bool array -> t = "%identity"
+(** `booleanArray(a)` makes a JSON array of the `bool` array `a`. *)
+
+external objectArray : t Js_dict.t array -> t = "%identity"
+(** `objectArray(a) makes a JSON array of the `JsDict.t` array `a`. *)
+
+(** ## String conversion *)
+
+external parseExn : string -> t = "parse"
+  [@@bs.val] [@@bs.scope "JSON"]
+(**
+`parseExn(s)` parses the `string` `s` into a JSON data structure.
+Returns a JSON data structure.
+Raises `SyntaxError` if the given string is not a valid JSON. Note: `SyntaxError` is a JavaScript exception.
+
+**See** [MDN](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/JSON/parse)
+
+```res example
+/* parse a simple JSON string */
+
+let json = try Js.Json.parseExn(` "hello" `) catch {
+| _ => failwith("Error parsing JSON string")
+}
+
+switch Js.Json.classify(json) {
+| Js.Json.JSONString(value) => Js.log(value)
+| _ => failwith("Expected a string")
+}
+```
+
+```res example
+/* parse a complex JSON string */
+
+let getIds = s => {
+  let json = try Js.Json.parseExn(s) catch {
+  | _ => failwith("Error parsing JSON string")
+  }
+
+  switch Js.Json.classify(json) {
+  | Js.Json.JSONObject(value) =>
+    /* In this branch, compiler infer value : Js.Json.t Js.Dict.t */
+    switch Js.Dict.get(value, "ids") {
+    | Some(ids) =>
+      switch Js.Json.classify(ids) {
+      | Js.Json.JSONArray(ids) => /* In this branch compiler infer ids : Js.Json.t array */
+        ids
+      | _ => failwith("Expected an array")
+      }
+    | None => failwith("Expected an `ids` property")
+    }
+  | _ => failwith("Expected an object")
+  }
+}
+
+/* prints `1, 2, 3` */
+Js.log(getIds(` { "ids" : [1, 2, 3 ] } `))
+```
+*)
+
+external stringify : t -> string = "stringify"
+  [@@bs.val] [@@bs.scope "JSON"]
+(**
+`stringify(json)` formats the JSON data structure as a `string`.
+Returns the string representation of a given JSON data structure.
+
+**See** [MDN](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/JSON/stringify)
+
+```res example
+/* Creates and stringifies a simple JS object */
+
+let dict = Js.Dict.empty()
+Js.Dict.set(dict, "name", Js.Json.string("John Doe"))
+Js.Dict.set(dict, "age", Js.Json.number(30.0))
+Js.Dict.set(dict, "likes", Js.Json.stringArray(["bucklescript", "ocaml", "js"]))
+
+Js.log(Js.Json.stringify(Js.Json.object_(dict)))
+```
+*)
+
+external stringifyWithSpace : t -> (_[@bs.as {json|null|json}]) -> int -> string
+  = "stringify"
+  [@@bs.val] [@@bs.scope "JSON"]
+(**
+`stringifyWithSpace(json)` formats the JSON data structure as a `string`.
+Returns the string representation of a given JSON data structure with spacing.
+
+**See** [MDN](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/JSON/stringify)
+
+```res example
+/* Creates and stringifies a simple JS object with spacing */
+
+let dict = Js.Dict.empty()
+Js.Dict.set(dict, "name", Js.Json.string("John Doe"))
+Js.Dict.set(dict, "age", Js.Json.number(30.0))
+Js.Dict.set(dict, "likes", Js.Json.stringArray(["bucklescript", "ocaml", "js"]))
+
+Js.log(Js.Json.stringifyWithSpace(Js.Json.object_(dict), 2))
+```
+*)
+
+external stringifyAny : 'a -> string option = "stringify"
+  [@@bs.val] [@@bs.scope "JSON"]
+(**
+`stringifyAny(value)` formats any value into a JSON string.
+
+```res example
+/* prints `["hello", "world"]` */
+Js.log(Js.Json.stringifyAny(["hello", "world"]))
+```
+*)
+
+val deserializeUnsafe : string -> 'a
+(**
+  Best-effort serialization, it tries to seralize as
+  many objects as possible and deserialize it back
+
+  It is unsafe in two aspects
+  - It may throw during  parsing
+  - when you cast it to a specific type, it may have a type mismatch
+*)
+
+val serializeExn : 'a -> string
+(**
+  It will raise in such situations:
+  - The object can not be serlialized to a JSON
+  - There are cycles
+  - Some JS engines can not stringify deeply nested json objects
+*)

package/lib/ocaml/js_list.ml

@@ -0,0 +1,174 @@
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+[@@@warning "-3"]
+
+type 'a t = 'a list
+
+
+
+let rec lengthAux len = function
+  | [] -> len
+  | _::l -> lengthAux (len + 1) l
+
+let length l = lengthAux 0 l
+
+let cons  x xs = x :: xs
+
+let isEmpty x =  x = []
+
+let hd = function
+  | [] -> None
+  | a::_ -> Some a
+
+let tl = function
+  | [] -> None
+  | _::l -> Some l
+
+let nth l n =
+  if n < 0 then None else
+    let rec nth_aux l n =
+      match l with
+      | [] -> None
+      | a::l -> if n = 0 then Some a else nth_aux l (n-1)
+    in nth_aux l n
+
+
+
+let rec revAppend l1 l2 =
+  match l1 with
+  | [] -> l2
+  | a :: l -> revAppend l (a :: l2)
+
+let rev l = revAppend l []
+
+
+let rec mapRevAux f acc ls =
+  match ls with
+  | [] ->  acc
+  | a::l ->
+    mapRevAux f (f a [@bs] :: acc) l
+
+let mapRev f ls = mapRevAux f [] ls
+
+let map f ls = rev (mapRevAux f [] ls )
+
+let rec iter f = function
+    [] -> ()
+  | a::l -> f a [@bs]; iter f l
+
+let rec iteri i f = function
+    [] -> ()
+  | a::l -> f i a [@bs]; iteri (i + 1) f l
+
+let iteri f l = iteri 0 f l
+
+let rec foldLeft f accu l =
+  match l with
+    [] -> accu
+  | a::l -> foldLeft f (f accu a [@bs]) l
+
+let foldRightMaxStack = 1000
+
+
+let rec tailLoop f  acc = function
+  | [] -> acc
+  | h :: t -> tailLoop f (f h acc [@bs]) t
+
+let foldRight f l init =
+  let rec loop n = function
+    | [] -> init
+    | h :: t ->
+      if n < foldRightMaxStack then
+        f h (loop (n+1) t) [@bs]
+      else
+        f h (tailLoop f init (rev t)) [@bs]
+  in
+  loop 0 l
+
+
+let rec flattenAux  acc  lx =
+  match lx with
+  | [] -> rev acc
+  | y::ys -> flattenAux  (revAppend  y   acc )  ys
+
+let flatten  lx =
+  flattenAux  [] lx
+
+
+let rec filterRevAux f acc xs =
+  match xs with
+  | [] ->  acc
+  | y :: ys ->
+    begin match f y [@bs] with
+      | false ->   filterRevAux f acc ys
+      | true -> filterRevAux f  (y::acc) ys
+    end
+
+let filter f xs  =  rev (filterRevAux f [] xs )
+
+let rec filterMapRevAux (f:  'a -> 'b option [@bs]) acc xs =
+  match xs with
+  | [] ->  acc
+  | y :: ys ->
+    begin match f y [@bs] with
+      | None ->   filterMapRevAux f acc ys
+      | Some z -> filterMapRevAux f  (z::acc) ys
+    end
+
+let filterMap f xs =
+  rev (filterMapRevAux f [] xs)
+
+
+let rec countByAux f acc xs =
+  match xs with
+  | [] -> acc
+  | y::ys ->
+    countByAux f (if f y [@bs] then acc + 1 else acc) ys
+
+let countBy f xs = countByAux f 0 xs
+
+let init n f =
+  Js_vector.toList (Js_vector.init n f )
+
+external createUnsafe : int -> 'a array =
+  "Array" [@@bs.new]
+
+let toVector xs =
+  match xs with
+  | [] -> [||]
+  | l ->
+    let a = createUnsafe (length l) in
+    let rec fill i = function
+      | [] -> a
+      | hd::tl -> Js_array2.unsafe_set a i hd; fill (i+1) tl in
+    fill 0 l
+
+let rec equal cmp xs ys =
+  match xs,ys with
+  | [], [] -> true
+  | x::xs, y::ys ->
+    if cmp x y [@bs] then equal cmp xs ys
+    else false
+  | _, _ -> false

package/lib/ocaml/js_list.mli

@@ -0,0 +1,72 @@
+(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+[@@@deprecated "Use Belt.List instead"]
+
+type 'a t  = 'a list 
+
+val length : 'a t -> int
+
+val cons : 'a -> 'a t -> 'a t 
+
+val isEmpty : 'a t -> bool 
+
+val hd : 'a t -> 'a option
+
+val tl : 'a t -> 'a t option
+
+val nth : 'a t -> int -> 'a option
+
+val revAppend : 'a t -> 'a t -> 'a t
+
+val rev : 'a t -> 'a t
+
+val mapRev : ('a -> 'b [@bs]) -> 'a t -> 'b t
+
+val map : ('a -> 'b [@bs]) -> 'a t -> 'b t
+
+val iter : ('a -> unit [@bs]) -> 'a t -> unit 
+
+val iteri : (int -> 'a -> unit [@bs]) -> 'a t -> unit 
+
+val foldLeft : ('a -> 'b -> 'a [@bs]) -> 'a -> 'b list -> 'a
+(** Application order is left to right, tail recurisve *)
+
+val foldRight : ('a -> 'b -> 'b [@bs]) -> 'a list -> 'b -> 'b
+(** Application order is right to left
+    tail-recursive. *)
+
+val flatten : 'a t t  -> 'a t
+
+val filter : ('a -> bool [@bs]) -> 'a t -> 'a t 
+
+val filterMap : ('a -> 'b option [@bs]) -> 'a t -> 'b t
+
+val countBy : ('a -> bool [@bs]) -> 'a list -> int 
+
+val init : int -> (int -> 'a [@bs]) -> 'a t 
+
+val toVector : 'a t -> 'a array
+
+val equal : ('a -> 'a -> bool [@bs]) -> 'a list -> 'a list -> bool

package/lib/ocaml/js_map.ml

@@ -0,0 +1,3 @@
+(** ES6 Map API *)
+
+type ('k, 'v) t