@kaiko.io/rescript-deser 6.0.0 → 7.0.0-alpha.1

package/README.md

@@ -50,7 +50,7 @@ The resultant module has type:
 module type Deserializer = {
   type t
   let name: string
-  let fromJSON: Js.Json.t => result<t, string>
+  let fromJSON: RescriptCore.JSON.t => result<t, string>
 }
 ```
 
@@ -80,10 +80,10 @@ module type Serializable = {
   JS representation of the object that comes from the JSON data.
 
 - `Date`, parses either a string representation of a date (datetime) or a
-  floating point representation of date (datetime) into `Js.Date.t`; we make
+  floating point representation of date (datetime) into `Date.t`; we make
   sure the result is valid and won't return NaN afterwards.
 
-  This basically calls, `Js.Date.fromString` or `Js.Date.fromFloat`; and tests
+  This basically calls, `Date.fromString` or `Date.fromTime`; and tests
   the resulting value.
 
   `Datetime` is an alias for `Date`.

package/lib/bs/.bsdeps

@@ -2,8 +2,8 @@
 /home/manu/src/kaiko/rescript-deser
 0
 0
-rescript.json	0x1.9d272e38c4598p+30
-tests	0x1.9d272e38c7c35p+30
-src/	0x1.a024aa053ad05p+30
+rescript.json	0x1.a0f2462508cf1p+30
+tests	0x1.a472319d551bdp+30
+src/	0x1.a4721291940c2p+30
 ===
-/home/manu/src/kaiko/rescript-deser/node_modules/rescript/linux/rescript.exe	0x1.a0f1eb2331822p+30
+/home/manu/src/kaiko/rescript-deser/node_modules/rescript/linux/rescript.exe	0x1.a4720d14765c9p+30

package/lib/bs/.compiler.log

@@ -1,2 +1,2 @@
-#Start(1748794171703)
-#Done(1748794171704)
+#Start(1763479665497)
+#Done(1763479665497)

package/lib/bs/.ninja_log

@@ -1,45 +1,57 @@
 # ninja log v6
-1	9	1732888969609093921	tests/index.ast	901a254e17150891
-0	9	1732888969605760485	tests/QUnit.ast	24679400da87e6b0
-0	11	1732888969609093921	src/Deser.ast	60777bbe51986b3b
+1	18	1732888969609093921	tests/QUnit.cmi	f57b53b8aff27629
+82	114	1763477825207250407	../es6/tests/index.js	fe0b84000747f3c8
+82	114	1763477825207250407	tests/index.cmj	fe0b84000747f3c8
+6	8	1748799957991823370	tests/index.d	44655d60e4c70d26
+23	82	1763477825165250216	../es6/src/Deser.js	9301f060e01e8bd6
 9	11	1732888969609093921	tests/QUnit.d	f74946ee3200f9fa
-9	12	1732888969609093921	tests/index.d	44655d60e4c70d26
-11	13	1732888969612427357	src/Deser.d	691c816990b589e8
-11	18	1732888969615760793	tests/QUnit.cmj	dfd5051a1aed6ad1
-11	18	1732888969615760793	tests/QUnit.cmi	dfd5051a1aed6ad1
-11	18	1732888969615760793	../es6/tests/QUnit.js	dfd5051a1aed6ad1
-11	18	1732888969615760793	../js/tests/QUnit.js	dfd5051a1aed6ad1
-14	36	1732888969635761410	src/Deser.cmj	59c93988df369be8
-14	36	1732888969635761410	src/Deser.cmi	59c93988df369be8
-14	36	1732888969635761410	../es6/src/Deser.js	59c93988df369be8
-14	36	1732888969635761410	../js/src/Deser.js	59c93988df369be8
-36	48	1732888969645761719	tests/index.cmj	1492142736e6fe59
-36	48	1732888969645761719	tests/index.cmi	1492142736e6fe59
-36	48	1732888969645761719	../es6/tests/index.js	1492142736e6fe59
-36	48	1732888969645761719	../js/tests/index.js	1492142736e6fe59
-1	7	1732889720608155890	tests/index.ast	901a254e17150891
-7	9	1732889720608155890	tests/index.d	44655d60e4c70d26
-1	9	1732889720611489309	src/Deser.ast	60777bbe51986b3b
-9	10	1732889720611489309	src/Deser.d	691c816990b589e8
-10	29	1732889720611489309	src/Deser.cmj	59c93988df369be8
-10	29	1732889720611489309	src/Deser.cmi	59c93988df369be8
-10	29	1732889720611489309	../es6/src/Deser.js	59c93988df369be8
-10	29	1732889720611489309	../js/src/Deser.js	59c93988df369be8
-29	43	1732889720608155890	tests/index.cmj	1492142736e6fe59
-29	43	1732889720608155890	tests/index.cmi	1492142736e6fe59
-29	43	1732889720608155890	../es6/tests/index.js	1492142736e6fe59
-29	43	1732889720608155890	../js/tests/index.js	1492142736e6fe59
-1	10	1748794057621698671	src/Deser.ast	60777bbe51986b3b
-1	12	1732888969609093921	tests/QUnit.cmj	61e1b54782097a96
-1	12	1732888969609093921	tests/QUnit.cmi	61e1b54782097a96
-1	12	1732888969609093921	../es6/tests/QUnit.js	61e1b54782097a96
-1	12	1732888969609093921	../js/tests/QUnit.js	61e1b54782097a96
-10	12	1748794057621698671	src/Deser.d	691c816990b589e8
-12	36	1748794057621698671	src/Deser.cmj	4b6956c2ed469aef
-12	36	1748794057621698671	src/Deser.cmi	4b6956c2ed469aef
-12	36	1748794057621698671	../es6/src/Deser.js	4b6956c2ed469aef
-12	36	1748794057621698671	../js/src/Deser.js	4b6956c2ed469aef
-36	52	1732889720608155890	tests/index.cmj	436d06e8f796c935
-36	52	1732889720608155890	tests/index.cmi	436d06e8f796c935
-36	52	1732889720608155890	../es6/tests/index.js	436d06e8f796c935
-36	52	1732889720608155890	../js/tests/index.js	436d06e8f796c935
+1	18	1732888969609093921	../es6/tests/QUnit.js	f57b53b8aff27629
+23	82	1763477825165250216	src/Deser.cmj	9301f060e01e8bd6
+1	18	1732888969609093921	../js/tests/QUnit.js	f57b53b8aff27629
+23	82	1763477825165250216	src/Deser.cmi	9301f060e01e8bd6
+1	17	1763477825165250216	src/Deser.ast	60777bbe51986b3b
+82	114	1763477825207250407	../js/tests/index.js	fe0b84000747f3c8
+82	114	1763477825207250407	tests/index.cmi	fe0b84000747f3c8
+23	82	1763477825165250216	../js/src/Deser.js	9301f060e01e8bd6
+1	18	1732888969609093921	tests/QUnit.cmj	f57b53b8aff27629
+18	23	1763477825165250216	src/Deser.d	691c816990b589e8
+0	9	1732888969605760485	tests/QUnit.ast	24679400da87e6b0
+0	6	1748799957991823370	tests/index.ast	901a254e17150891
+0	14	1732888969609093921	tests/QUnit.cmj	d4cd0d743e9dbdc2
+0	14	1732888969609093921	tests/QUnit.cmi	d4cd0d743e9dbdc2
+0	14	1732888969609093921	../es6/tests/QUnit.js	d4cd0d743e9dbdc2
+0	14	1732888969609093921	../js/tests/QUnit.js	d4cd0d743e9dbdc2
+1	44	1763477825165250216	src/Deser.cmj	d1ae51e3ae7660c0
+1	44	1763477825165250216	src/Deser.cmi	d1ae51e3ae7660c0
+1	44	1763477825165250216	../es6/src/Deser.js	d1ae51e3ae7660c0
+1	44	1763477825165250216	../js/src/Deser.js	d1ae51e3ae7660c0
+44	66	1763477825207250407	tests/index.cmj	d34384b01ad99c82
+44	66	1763477825207250407	tests/index.cmi	d34384b01ad99c82
+44	66	1763477825207250407	../es6/tests/index.js	d34384b01ad99c82
+44	66	1763477825207250407	../js/tests/index.js	d34384b01ad99c82
+0	14	1763477953358547914	tests/index.ast	901a254e17150891
+14	18	1763477953358547914	tests/index.d	44655d60e4c70d26
+0	19	1732888969609093921	tests/QUnit.cmj	eee74ca8670f321f
+0	19	1732888969609093921	tests/QUnit.cmi	eee74ca8670f321f
+0	19	1732888969609093921	../es6/tests/QUnit.js	eee74ca8670f321f
+0	19	1732888969609093921	../js/tests/QUnit.js	eee74ca8670f321f
+0	55	1763477825165250216	src/Deser.cmj	53951e70cb585c7f
+0	55	1763477825165250216	src/Deser.cmi	53951e70cb585c7f
+0	55	1763477825165250216	../es6/src/Deser.js	53951e70cb585c7f
+0	55	1763477825165250216	../js/src/Deser.js	53951e70cb585c7f
+55	82	1763477953358547914	tests/index.cmj	3635592f4bb018fd
+55	82	1763477953358547914	tests/index.cmi	3635592f4bb018fd
+55	82	1763477953358547914	../es6/tests/index.js	3635592f4bb018fd
+55	82	1763477953358547914	../js/tests/index.js	3635592f4bb018fd
+0	15	1732888969609093921	tests/QUnit.cmj	808e7abe2ed23b68
+0	15	1732888969609093921	tests/QUnit.cmi	808e7abe2ed23b68
+0	15	1732888969609093921	../es6/tests/QUnit.js	808e7abe2ed23b68
+0	15	1732888969609093921	../js/tests/QUnit.js	808e7abe2ed23b68
+0	43	1763477825165250216	src/Deser.cmj	d15a15aaf540f200
+0	43	1763477825165250216	src/Deser.cmi	d15a15aaf540f200
+0	43	1763477825165250216	../es6/src/Deser.js	d15a15aaf540f200
+0	43	1763477825165250216	../js/src/Deser.js	d15a15aaf540f200
+43	65	1763477953358547914	tests/index.cmj	6ccb61e0c25bd9c7
+43	65	1763477953358547914	tests/index.cmi	6ccb61e0c25bd9c7
+43	65	1763477953358547914	../es6/tests/index.js	6ccb61e0c25bd9c7
+43	65	1763477953358547914	../js/tests/index.js	6ccb61e0c25bd9c7

package/lib/bs/___incremental/Deser.res

@@ -0,0 +1,351 @@
+open RescriptCore
+
+module FieldValue = {
+  type t
+  external string: string => t = "%identity"
+  external int: int => t = "%identity"
+  external float: float => t = "%identity"
+  external boolean: bool => t = "%identity"
+  external array: array<t> => t = "%identity"
+  external object: Dict.t<t> => t = "%identity"
+  external mapping: Dict.t<t> => t = "%identity"
+  external any: 'a => t = "%identity"
+  @val external null: t = "undefined"
+
+  external asString: t => string = "%identity"
+  external asInt: t => int = "%identity"
+  external asFloat: t => float = "%identity"
+  external asBoolean: t => bool = "%identity"
+  external asArray: t => array<'a> = "%identity"
+  external asObject: t => 'a = "%identity"
+}
+
+exception TypeError(string)
+
+@doc("The module type of a built deserializer which is suitable to add as a subparser.")
+module type Deserializer = {
+  type t
+  let name: string
+  let fromJSON: JSON.t => result<t, string>
+  let checkFieldsSanity: unit => result<unit, string>
+}
+
+module Field = {
+  type rec t =
+    | Any
+    | String
+    | Literal(string)
+    | Int
+    | Float
+    | Boolean
+    | Array(t)
+    // These SHOULD strings in ISO format, but we only validate the string
+    // can be represented in Js.Date without spewing NaN all over the place;
+    // Js.Date.fromString("xxx") returns an object that is mostly unusable.
+    ///
+    // We also allow floats and then use Date.fromTime
+    | Date
+    | Datetime // alias of Date
+
+    | Tuple(array<t>)
+    | Object(array<(string, t)>)
+    | Optional(t)
+    | OptionalWithDefault(t, FieldValue.t)
+    // An arbitrary mapping from names to other arbitrary fields.  The
+    // difference with Object, is that you don't know the names of the
+    // expected entries.
+    | Mapping(t)
+
+    | Deserializer(module(Deserializer))
+
+    // A specialized Array of deserialized items that ignores unparsable
+    // items and returns the valid collection.  This saves the user from
+    // writing 'Array(DefaultWhenInvalid(Optional(Deserializer(module(M)))))'
+    // and then post-process the list of items with 'Array.keepSome'
+    | Collection(module(Deserializer))
+    | DefaultWhenInvalid(t, FieldValue.t)
+
+    // FIXME: this is used to add additional restrictions like variadictInt or
+    // variadicString; but I find it too type-unsafe.  I might consider having
+    // a Constraints for this in the future.
+    | Morphism(t, FieldValue.t => FieldValue.t)
+
+    | Self
+
+  let usingString = (f: string => 'a) => value => value->FieldValue.asString->f->FieldValue.any
+  let usingInt = (f: int => 'a) => value => value->FieldValue.asInt->f->FieldValue.any
+  let usingFloat = (f: float => 'a) => value => value->FieldValue.asFloat->f->FieldValue.any
+  let usingBoolean = (f: bool => 'a) => value => value->FieldValue.asBoolean->f->FieldValue.any
+  let usingArray = (f: array<'a> => 'b) => value => value->FieldValue.asArray->f->FieldValue.any
+  let usingObject = (f: 'a => 'b) => value => value->FieldValue.asObject->f->FieldValue.any
+
+  let variadicInt = (hint: string, fromJs: int => option<'variadicType>) => Morphism(
+    Int,
+    usingInt(i => {
+      switch i->fromJs {
+      | Some(internalValue) => internalValue
+      | None =>
+        raise(TypeError(`This Int(${i->Int.toString}) not a valid value here. Hint: ${hint}`))
+      }
+    }),
+  )
+  let variadicString = (hint: string, fromJs: string => option<'variadicType>) => Morphism(
+    String,
+    usingString(i => {
+      switch i->fromJs {
+      | Some(internalValue) => internalValue
+      | None => raise(TypeError(`This String("${i}") not a valid value here. Hint: ${hint}`))
+      }
+    }),
+  )
+
+  let rec toString = (type_: t) =>
+    switch type_ {
+    | Any => "Any"
+    | String => "String"
+    | Literal(lit) => `Literal: ${lit}`
+    | Int => "Integer"
+    | Float => "Float"
+    | Boolean => "Boolean"
+    | Datetime
+    | Date => "Date"
+    | Self => "Self (recursive)"
+    | Collection(m) => {
+        module M = unpack(m: Deserializer)
+        "Collection of " ++ M.name
+      }
+
+    | Array(t) => "Array of " ++ t->toString
+    | Tuple(bases) => `Tuple of (${bases->Array.map(toString)->Array.join(", ")})`
+    | Object(fields) => {
+        let desc = fields->Array.map(((field, t)) => `${field}: ${t->toString}`)->Array.join(", ")
+        `Object of {${desc}}`
+      }
+
+    | OptionalWithDefault(t, _)
+    | Optional(t) =>
+      "Null of " ++ t->toString
+    | Mapping(t) => `Mapping of ${t->toString}`
+    | Morphism(t, _) => t->toString ++ " to apply a morphism"
+    | Deserializer(m) => {
+        module M = unpack(m: Deserializer)
+        M.name
+      }
+
+    | DefaultWhenInvalid(t, _) => `Protected ${t->toString}`
+    }
+
+  let _taggedToString = (tagged: JSON.t) => {
+    switch tagged {
+    | Boolean(false) => "Boolean(false)"
+    | Boolean(true) => "Boolean(true)"
+    | Null => "Null"
+    | String(text) => `String("${text}")`
+    | Number(number) => `Number(${number->Float.toString})`
+    | Object(obj) => `Object(${obj->JSON.stringifyAny->Option.getOr("...")})`
+    | Array(array) => `Array(${array->JSON.stringifyAny->Option.getOr("...")})`
+    }
+  }
+
+  let rec extractValue = (
+    values: Dict.t<JSON.t>,
+    field: string,
+    shape: t,
+    self: t,
+  ): FieldValue.t => {
+    switch values->Dict.get(field) {
+    | Some(value) => value->fromUntagged(shape, self)
+    | None =>
+      switch shape {
+      | DefaultWhenInvalid(_, _) => JSON.Null->fromUntagged(shape, self)
+      | Optional(_) => JSON.Null->fromUntagged(shape, self)
+      | OptionalWithDefault(_, default) => default
+      | _ => raise(TypeError(`Missing non-optional field '${field}'`))
+      }
+    }
+  }
+  and fromUntagged: (JSON.t, t, t) => FieldValue.t = (untagged, shape, self) => {
+    switch (shape, untagged) {
+    | (Any, _) => untagged->FieldValue.any
+
+    | (Literal(expected), String(text)) if text == expected => FieldValue.string(text)
+    | (Literal(expected), String(text)) =>
+      raise(TypeError(`Expecting literal ${expected}, got ${text}`))
+
+    | (String, String(text)) => FieldValue.string(text)
+
+    | (Int, Number(number)) => FieldValue.int(number->Float.toInt)
+
+    | (Float, Number(number)) => FieldValue.float(number)
+
+    | (Boolean, Boolean(v)) => FieldValue.boolean(v)
+
+    | (Tuple(bases), Array(items)) => {
+        let lenbases = bases->Array.length
+        let lenitems = items->Array.length
+        if lenbases == lenitems {
+          let values = Belt.Array.zipBy(items, bases, (i, b) => fromUntagged(i, b, self))
+          values->FieldValue.array
+        } else {
+          raise(
+            TypeError(`Expecting ${lenbases->Int.toString} items, got ${lenitems->Int.toString}`),
+          )
+        }
+      }
+
+    | (Datetime | Date, String(s)) =>
+      let r = Date.fromString(s)
+      if r->Date.getDate->Int.toFloat->Float.isNaN {
+        raise(TypeError(`Invalid date ${s}`))
+      }
+      r->FieldValue.any
+
+    | (Datetime | Date, Number(f)) =>
+      let r = Date.fromTime(f)
+      if r->Date.getDate->Int.toFloat->Float.isNaN {
+        raise(TypeError(`Invalid date ${f->Float.toString}`))
+      }
+      r->FieldValue.any
+
+    | (Array(shape), Array(items)) =>
+      FieldValue.array(items->Array.map(item => item->fromUntagged(shape, self)))
+
+    | (Mapping(f), Object(values)) =>
+      values->Dict.mapValues(v => v->fromUntagged(f, self))->FieldValue.mapping
+
+    | (Object(fields), Object(values)) =>
+      fields
+      ->Array.map(((field, shape)) => {
+        let value = switch extractValue(values, field, shape, self) {
+        | value => value
+        | exception TypeError(msg) => raise(TypeError(`Field "${field}": ${msg}`))
+        }
+        (field, value)
+      })
+      ->Dict.fromArray
+      ->FieldValue.object
+
+    | (OptionalWithDefault(_, value), Null) => value
+    | (OptionalWithDefault(shape, _), _) => untagged->fromUntagged(shape, self)
+    | (Optional(_), Null) => FieldValue.null
+    | (Optional(shape), _) => untagged->fromUntagged(shape, self)
+    | (Morphism(shape, f), _) => untagged->fromUntagged(shape, self)->f->FieldValue.any
+
+    | (Collection(m), Array(items)) => {
+        module M = unpack(m: Deserializer)
+        items
+        ->Array.map(M.fromJSON)
+        ->Array.filterMap(x =>
+          switch x {
+          | Ok(v) => Some(v)
+          | Error(msg) =>
+            Console.warn3(__MODULE__, "Could not deserialize value in the collection", msg)
+            None
+          }
+        )
+        ->Array.map(FieldValue.any)
+        ->FieldValue.array
+      }
+
+    | (Deserializer(m), _) => {
+        module M = unpack(m: Deserializer)
+        switch untagged->M.fromJSON {
+        | Ok(res) => res->FieldValue.any
+        | Error(msg) => raise(TypeError(msg))
+        }
+      }
+
+    | (DefaultWhenInvalid(t, default), _) =>
+      switch untagged->fromUntagged(t, self) {
+      | res => res
+      | exception TypeError(msg) => {
+          Console.warn2("Detected and ignore (with default): ", msg)
+          default
+        }
+      }
+    | (Self, _) => untagged->fromUntagged(self, self)
+    | (expected, actual) =>
+      raise(TypeError(`Expected ${expected->toString}, but got ${actual->_taggedToString} instead`))
+    }
+  }
+
+  let rec checkFieldsSanity = (name: string, fields: t, optional: bool): result<unit, string> =>
+    switch (fields, optional) {
+    | (Self, false) => Error(`${name}: Trivial infinite recursion 'let fields = Self'`)
+    | (Self, true) => Ok()
+
+    | (Any, _) => Ok()
+    | (String, _) | (Float, _) | (Int, _) | (Literal(_), _) => Ok()
+    | (Boolean, _) | (Date, _) | (Datetime, _) => Ok()
+    | (Morphism(_, _), _) => Ok()
+
+    | (Collection(mod), _)
+    | (Deserializer(mod), _) => {
+        module M = unpack(mod: Deserializer)
+        switch M.checkFieldsSanity() {
+        | Ok() => Ok()
+        | Error(msg) => Error(`${name}/ ${msg}`)
+        }
+      }
+
+    | (DefaultWhenInvalid(fields, _), _)
+    | (OptionalWithDefault(fields, _), _)
+    | (Optional(fields), _) =>
+      checkFieldsSanity(name, fields, true)
+
+    | (Object(fields), optional) =>
+      fields
+      ->Array.map(((fieldName, field)) => () =>
+        checkFieldsSanity(`${name}::${fieldName}`, field, optional))
+      ->Array.reduce(Ok([]), (res, nextitem) =>
+        res->Result.flatMap(arr => nextitem()->Result.map(i => arr->Array.concat([i])))
+      )
+      ->Result.map(_ => ())
+
+    // Mappings and arrays can be empty, so their payloads are
+    // automatically optional.
+    | (Mapping(field), _) | (Array(field), _) => checkFieldsSanity(name, field, true)
+
+    | (Tuple(fields), optional) =>
+      fields
+      ->Array.mapWithIndex((field, index) => () =>
+        checkFieldsSanity(`${name}[${index->Int.toString}]`, field, optional))
+      ->Array.reduce(Ok([]), (res, nextitem) =>
+        res->Result.flatMap(arr => nextitem()->Result.map(i => arr->Array.concat([i])))
+      )
+      ->Result.map(_ => ())
+    }
+}
+
+module type Serializable = {
+  type t
+  let fields: Field.t
+}
+
+module MakeDeserializer = (S: Serializable): (Deserializer with type t = S.t) => {
+  type t = S.t
+  let fields = S.fields
+  %%private(let (loc, _f) = __LOC_OF__(module(S: Serializable)))
+  let name = `Deserializer ${__MODULE__}, ${loc}`
+
+  %%private(external _toNativeType: FieldValue.t => t = "%identity")
+
+  @doc("Checks for trivial infinite-recursion in the fields of the module.
+
+  Notice this algorithm is just an heuristic, and it might happen that are
+  cases of infinite-recursion not detected and cases where detection is a
+  false positive.
+
+  You should use this only while debugging/developing to verify your data.
+
+  ")
+  let checkFieldsSanity = () => Field.checkFieldsSanity(name, fields, false)
+
+  @doc("Parse a `'a` into `result<t, string>`")
+  let fromJSON: JSON.t => result<t, _> = json => {
+    switch json->Field.fromUntagged(fields, fields) {
+    | res => Ok(res->_toNativeType)
+    | exception TypeError(e) => Error(e)
+    }
+  }
+}