@kaiko.io/rescript-deser 4.0.0-rc.2 → 4.0.0-rc.4

package/lib/bs/.bsdeps

@@ -3,6 +3,6 @@
 0
 rescript.json	0x1.94b3a6a1d2ba4p+30
 tests	0x1.93fb8b23e3f01p+30
-src/	0x1.94b3a6a1d2ba4p+30
+src/	0x1.957e56214e505p+30
 ===
 /home/manu/src/kaiko/rescript-deser/node_modules/rescript/linux/rescript.exe	0x1.9578a22fcfdf4p+30

package/lib/bs/.compiler.log

@@ -1,2 +1,2 @@
-#Start(1700670041426)
-#Done(1700670041426)
+#Start(1700765549343)
+#Done(1700765549343)

package/lib/bs/.ninja_log

@@ -1,19 +1,27 @@
 # ninja log v6
-0	6	1700670039254870652	tests/QUnit.ast	a6a94a20e20f8557
-1	7	1700670039254870652	tests/index.ast	3c91d8240b8bb4b8
-1	8	1700670039254870652	src/JSON.ast	54dacc9e71f78ec4
-6	9	1700670039254870652	tests/QUnit.d	4a2631c992d93ce7
-7	9	1700670039254870652	tests/index.d	5a4db9cdecd186b3
-8	10	1700670039258204077	src/JSON.d	cd2d6773c781340f
-9	15	1700670039261537502	tests/QUnit.cmj	1baf089a71e93e14
-9	15	1700670039261537502	tests/QUnit.cmi	1baf089a71e93e14
-9	15	1700670039261537502	../es6/tests/QUnit.js	1baf089a71e93e14
-9	15	1700670039261537502	../js/tests/QUnit.js	1baf089a71e93e14
-10	28	1700670039274871200	src/JSON.cmj	5c6bd34c8b98f8b9
-10	28	1700670039274871200	src/JSON.cmi	5c6bd34c8b98f8b9
-10	28	1700670039274871200	../es6/src/JSON.js	5c6bd34c8b98f8b9
-10	28	1700670039274871200	../js/src/JSON.js	5c6bd34c8b98f8b9
-28	38	1700670039284871474	tests/index.cmj	8a0bf0b0432467b0
-28	38	1700670039284871474	tests/index.cmi	8a0bf0b0432467b0
-28	38	1700670039284871474	../es6/tests/index.js	8a0bf0b0432467b0
-28	38	1700670039284871474	../js/tests/index.js	8a0bf0b0432467b0
+0	7	1700763106509919117	src/JSON.ast	3df97f11bfe4e9b4
+7	9	1700763106513252576	src/JSON.d	54f2190af6eab30f
+9	26	1700763106529919867	src/JSON.cmj	f5326fd4af8f39e2
+9	26	1700763106529919867	src/JSON.cmi	f5326fd4af8f39e2
+9	26	1700763106529919867	../es6/src/JSON.js	f5326fd4af8f39e2
+0	16	1700763106513252576	src/JSON.cmj	9477bd76994296b7
+0	16	1700763106513252576	src/JSON.cmi	9477bd76994296b7
+0	16	1700763106513252576	../es6/src/JSON.js	9477bd76994296b7
+0	6	1700765531805623915	tests/QUnit.ast	a6a94a20e20f8557
+1	6	1700765531805623915	tests/index.ast	3c91d8240b8bb4b8
+0	8	1700765531808957333	src/JSON.ast	54dacc9e71f78ec4
+6	8	1700765531808957333	tests/QUnit.d	4a2631c992d93ce7
+6	8	1700765531808957333	tests/index.d	5a4db9cdecd186b3
+8	10	1700765531808957333	src/JSON.d	cd2d6773c781340f
+8	15	1700765531815624169	tests/QUnit.cmj	e2ba8efce8af03b9
+8	15	1700765531815624169	tests/QUnit.cmi	e2ba8efce8af03b9
+8	15	1700765531815624169	../es6/tests/QUnit.js	e2ba8efce8af03b9
+8	15	1700765531815624169	../js/tests/QUnit.js	e2ba8efce8af03b9
+10	28	1700765531828957841	src/JSON.cmj	3da9e5f359841f1a
+10	28	1700765531828957841	src/JSON.cmi	3da9e5f359841f1a
+10	28	1700765531828957841	../es6/src/JSON.js	3da9e5f359841f1a
+10	28	1700765531828957841	../js/src/JSON.js	3da9e5f359841f1a
+28	38	1700765531838958094	tests/index.cmj	630554c615a94d8d
+28	38	1700765531838958094	tests/index.cmi	630554c615a94d8d
+28	38	1700765531838958094	../es6/tests/index.js	630554c615a94d8d
+28	38	1700765531838958094	../js/tests/index.js	630554c615a94d8d

package/lib/es6/src/JSON.js

@@ -110,11 +110,11 @@ function toString(type_) {
       case "Array" :
           return "Array of " + toString(type_._0);
       case "Tuple" :
-          return "Tuple of (" + Prelude.$$Array.map(type_._0, toString).join(", ") + ")";
+          return "Tuple of (" + type_._0.map(toString).join(", ") + ")";
       case "Object" :
-          var desc = Prelude.$$Array.map(type_._0, (function (param) {
-                    return param[0] + ": " + toString(param[1]);
-                  })).join(", ");
+          var desc = type_._0.map(function (param) {
+                  return param[0] + ": " + toString(param[1]);
+                }).join(", ");
           return "Object of {" + desc + "}";
       case "Optional" :
       case "OptionalWithDefault" :
@@ -306,7 +306,7 @@ function fromUntagged(untagged, _shape, self) {
             } else {
               if (match.TAG === "JSONArray") {
                 var shape$1 = shape._0;
-                return Prelude.$$Array.map(match._0, (function(shape$1){
+                return match._0.map((function(shape$1){
                           return function (item) {
                             return fromUntagged(item, shape$1, self);
                           }
@@ -344,7 +344,7 @@ function fromUntagged(untagged, _shape, self) {
             } else {
               if (match.TAG === "JSONObject") {
                 var values = match._0;
-                return Curry._1(Prelude.Dict.fromArray, Prelude.$$Array.map(shape._0, (function(values){
+                return Curry._1(Prelude.Dict.fromArray, shape._0.map((function(values){
                               return function (param) {
                                 var field = param[0];
                                 var value;
@@ -426,9 +426,13 @@ function fromUntagged(untagged, _shape, self) {
               exit = 1;
             } else {
               if (match.TAG === "JSONArray") {
-                return Prelude.$$Array.map(Prelude.$$Array.keepSome(Prelude.$$Array.map(Prelude.$$Array.map(match._0, shape._0.fromJSON), Prelude.Result.warn)), (function (prim) {
-                              return prim;
-                            }));
+                return Prelude.$$Array.keepSome(match._0.map((function(shape){
+                                  return function (param) {
+                                    return Curry._1(shape._0.fromJSON, param);
+                                  }
+                                  }(shape))).map(Prelude.Result.warn)).map(function (prim) {
+                            return prim;
+                          });
               }
               exit = 1;
             }
@@ -518,7 +522,7 @@ function checkFieldsSanity(name, _fields, _optional) {
     } else {
       switch (fields.TAG) {
         case "Tuple" :
-            return Curry._2(Prelude.ManyResults.map, Prelude.ManyResults.bailU(Prelude.$$Array.mapWithIndex(fields._0, (function(optional){
+            return Curry._2(Prelude.ManyResults.map, Prelude.ManyResults.bailU(fields._0.map((function(optional){
                               return function (field, index) {
                                 return function () {
                                   return checkFieldsSanity(name + "[" + String(index) + "]", field, optional);
@@ -528,7 +532,7 @@ function checkFieldsSanity(name, _fields, _optional) {
                           
                         }));
         case "Object" :
-            return Curry._2(Prelude.ManyResults.map, Prelude.ManyResults.bailU(Prelude.$$Array.map(fields._0, (function(optional){
+            return Curry._2(Prelude.ManyResults.map, Prelude.ManyResults.bailU(fields._0.map((function(optional){
                               return function (param) {
                                 var field = param[1];
                                 var fieldName = param[0];
@@ -606,7 +610,7 @@ var Field = {
 
 function MakeDeserializer(S) {
   var fields = S.fields;
-  var name = "Deserializer " + "JSON" + ", " + "File \"JSON.res\", line 329, characters 39-47";
+  var name = "Deserializer " + "JSON" + ", " + "File \"JSON.res\", line 320, characters 39-47";
   var checkFieldsSanity$1 = function () {
     return checkFieldsSanity(name, fields, false);
   };
@@ -630,35 +634,9 @@ function MakeDeserializer(S) {
             _0: res
           };
   };
-  var fromAny = function (any) {
-    var match = typeof any;
-    if (match === "string") {
-      var parsed;
-      try {
-        parsed = JSON.parse(any);
-      }
-      catch (exn){
-        return {
-                TAG: "Error",
-                _0: "Could parse string as JSON"
-              };
-      }
-      return fromJSON(parsed);
-    }
-    try {
-      return fromJSON(any);
-    }
-    catch (exn$1){
-      return {
-              TAG: "Error",
-              _0: "Could not deserialize the data"
-            };
-    }
-  };
   return {
           name: name,
           fromJSON: fromJSON,
-          fromAny: fromAny,
           checkFieldsSanity: checkFieldsSanity$1
         };
 }

package/lib/es6/tests/index.js

@@ -234,11 +234,7 @@ Qunit.module("Recursive deserializer", (function (param) {
                       "records",
                       {
                         TAG: "Deserializer",
-                        _0: {
-                          name: List.name,
-                          fromJSON: List.fromJSON,
-                          checkFieldsSanity: List.checkFieldsSanity
-                        }
+                        _0: List
                       }
                     ],
                     [

package/lib/js/src/JSON.js

@@ -111,11 +111,11 @@ function toString(type_) {
       case "Array" :
           return "Array of " + toString(type_._0);
       case "Tuple" :
-          return "Tuple of (" + Prelude.$$Array.map(type_._0, toString).join(", ") + ")";
+          return "Tuple of (" + type_._0.map(toString).join(", ") + ")";
       case "Object" :
-          var desc = Prelude.$$Array.map(type_._0, (function (param) {
-                    return param[0] + ": " + toString(param[1]);
-                  })).join(", ");
+          var desc = type_._0.map(function (param) {
+                  return param[0] + ": " + toString(param[1]);
+                }).join(", ");
           return "Object of {" + desc + "}";
       case "Optional" :
       case "OptionalWithDefault" :
@@ -307,7 +307,7 @@ function fromUntagged(untagged, _shape, self) {
             } else {
               if (match.TAG === "JSONArray") {
                 var shape$1 = shape._0;
-                return Prelude.$$Array.map(match._0, (function(shape$1){
+                return match._0.map((function(shape$1){
                           return function (item) {
                             return fromUntagged(item, shape$1, self);
                           }
@@ -345,7 +345,7 @@ function fromUntagged(untagged, _shape, self) {
             } else {
               if (match.TAG === "JSONObject") {
                 var values = match._0;
-                return Curry._1(Prelude.Dict.fromArray, Prelude.$$Array.map(shape._0, (function(values){
+                return Curry._1(Prelude.Dict.fromArray, shape._0.map((function(values){
                               return function (param) {
                                 var field = param[0];
                                 var value;
@@ -427,9 +427,13 @@ function fromUntagged(untagged, _shape, self) {
               exit = 1;
             } else {
               if (match.TAG === "JSONArray") {
-                return Prelude.$$Array.map(Prelude.$$Array.keepSome(Prelude.$$Array.map(Prelude.$$Array.map(match._0, shape._0.fromJSON), Prelude.Result.warn)), (function (prim) {
-                              return prim;
-                            }));
+                return Prelude.$$Array.keepSome(match._0.map((function(shape){
+                                  return function (param) {
+                                    return Curry._1(shape._0.fromJSON, param);
+                                  }
+                                  }(shape))).map(Prelude.Result.warn)).map(function (prim) {
+                            return prim;
+                          });
               }
               exit = 1;
             }
@@ -519,7 +523,7 @@ function checkFieldsSanity(name, _fields, _optional) {
     } else {
       switch (fields.TAG) {
         case "Tuple" :
-            return Curry._2(Prelude.ManyResults.map, Prelude.ManyResults.bailU(Prelude.$$Array.mapWithIndex(fields._0, (function(optional){
+            return Curry._2(Prelude.ManyResults.map, Prelude.ManyResults.bailU(fields._0.map((function(optional){
                               return function (field, index) {
                                 return function () {
                                   return checkFieldsSanity(name + "[" + String(index) + "]", field, optional);
@@ -529,7 +533,7 @@ function checkFieldsSanity(name, _fields, _optional) {
                           
                         }));
         case "Object" :
-            return Curry._2(Prelude.ManyResults.map, Prelude.ManyResults.bailU(Prelude.$$Array.map(fields._0, (function(optional){
+            return Curry._2(Prelude.ManyResults.map, Prelude.ManyResults.bailU(fields._0.map((function(optional){
                               return function (param) {
                                 var field = param[1];
                                 var fieldName = param[0];
@@ -607,7 +611,7 @@ var Field = {
 
 function MakeDeserializer(S) {
   var fields = S.fields;
-  var name = "Deserializer " + "JSON" + ", " + "File \"JSON.res\", line 329, characters 39-47";
+  var name = "Deserializer " + "JSON" + ", " + "File \"JSON.res\", line 320, characters 39-47";
   var checkFieldsSanity$1 = function () {
     return checkFieldsSanity(name, fields, false);
   };
@@ -631,35 +635,9 @@ function MakeDeserializer(S) {
             _0: res
           };
   };
-  var fromAny = function (any) {
-    var match = typeof any;
-    if (match === "string") {
-      var parsed;
-      try {
-        parsed = JSON.parse(any);
-      }
-      catch (exn){
-        return {
-                TAG: "Error",
-                _0: "Could parse string as JSON"
-              };
-      }
-      return fromJSON(parsed);
-    }
-    try {
-      return fromJSON(any);
-    }
-    catch (exn$1){
-      return {
-              TAG: "Error",
-              _0: "Could not deserialize the data"
-            };
-    }
-  };
   return {
           name: name,
           fromJSON: fromJSON,
-          fromAny: fromAny,
           checkFieldsSanity: checkFieldsSanity$1
         };
 }

package/lib/js/tests/index.js

@@ -235,11 +235,7 @@ Qunit.module("Recursive deserializer", (function (param) {
                       "records",
                       {
                         TAG: "Deserializer",
-                        _0: {
-                          name: List.name,
-                          fromJSON: List.fromJSON,
-                          checkFieldsSanity: List.checkFieldsSanity
-                        }
+                        _0: List
                       }
                     ],
                     [

package/lib/ocaml/.compiler.log

@@ -0,0 +1,2 @@
+#Start(1700763494807)
+#Done(1700763494809)

package/lib/ocaml/.ninja_log

@@ -0,0 +1,7 @@
+# ninja log v6
+0	3	1700763106533253326	JSON.cmi	bafb789a597a23fb
+0	3	1700763106533253326	JSON.cmj	e0df0c7e15c09f8e
+0	3	1700763106533253326	JSON.cmt	cb51be205f02087e
+1	3	1700763106533253326	JSON.res	b4c17270ea3dc72d
+3	4	1700763106536586783	install.stamp	cff5a5b4c02d30cf
+0	2	1700763494803628812	JSON.cmt	cb51be205f02087e

package/lib/ocaml/JSON.res

@@ -0,0 +1,343 @@
+@@uncurried
+open Prelude
+
+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: Js.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 Js.Date.fromFloat.
+    | 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: Js.Json.tagged_t) => {
+    switch tagged {
+    | Js.Json.JSONFalse => "Boolean(false)"
+    | Js.Json.JSONTrue => "Boolean(true)"
+    | Js.Json.JSONNull => "Null"
+    | Js.Json.JSONString(text) => `String("${text}")`
+    | Js.Json.JSONNumber(number) => `Number(${number->Float.toString})`
+    | Js.Json.JSONObject(obj) => `Object(${obj->Js.Json.stringifyAny->default("...")})`
+    | Js.Json.JSONArray(array) => `Array(${array->Js.Json.stringifyAny->default("...")})`
+    }
+  }
+
+  let rec extractValue = (
+    values: Dict.t<Js.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(_, _) => Js.Json.null->fromUntagged(shape, self)
+      | Optional(_) => Js.Json.null->fromUntagged(shape, self)
+      | OptionalWithDefault(_, default) => default
+      | _ => raise(TypeError(`Missing non-optional field '${field}'`))
+      }
+    }
+  }
+  and fromUntagged = (untagged: Js.Json.t, shape: t, self: t): FieldValue.t => {
+    switch (shape, untagged->Js.Json.classify) {
+    | (Any, _) => untagged->FieldValue.any
+    | (Literal(expected), Js.Json.JSONString(text)) =>
+      if text == expected {
+        FieldValue.string(text)
+      } else {
+        raise(TypeError(`Expecting literal ${expected}, got ${text}`))
+      }
+    | (String, Js.Json.JSONString(text)) => FieldValue.string(text)
+    | (Int, Js.Json.JSONNumber(number)) => FieldValue.int(number->Float.toInt)
+    | (Float, Js.Json.JSONNumber(number)) => FieldValue.float(number)
+    | (Boolean, Js.Json.JSONTrue) => FieldValue.boolean(true)
+    | (Boolean, Js.Json.JSONFalse) => FieldValue.boolean(false)
+    | (Tuple(bases), Js.Json.JSONArray(items)) => {
+        let lenbases = bases->Array.length
+        let lenitems = items->Array.length
+        if lenbases == lenitems {
+          let values = 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, Js.Json.JSONString(s))
+    | (Date, Js.Json.JSONString(s)) => {
+        let r = Js.Date.fromString(s)
+        if r->Js.Date.getDate->Js.Float.isNaN {
+          raise(TypeError(`Invalid date ${s}`))
+        }
+        r->FieldValue.any
+      }
+
+    | (Datetime, Js.Json.JSONNumber(f))
+    | (Date, Js.Json.JSONNumber(f)) => {
+        let r = Js.Date.fromFloat(f)
+        if r->Js.Date.getDate->Js.Float.isNaN {
+          raise(TypeError(`Invalid date ${f->Js.Float.toString}`))
+        }
+        r->FieldValue.any
+      }
+
+    | (Array(shape), Js.Json.JSONArray(items)) =>
+      FieldValue.array(items->Array.map(item => item->fromUntagged(shape, self)))
+    | (Mapping(f), Js.Json.JSONObject(values)) =>
+      values->Dict.mapValues(v => v->fromUntagged(f, self))->FieldValue.mapping
+    | (Object(fields), Js.Json.JSONObject(values)) =>
+      FieldValue.object(
+        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,
+      )
+
+    | (OptionalWithDefault(_, value), Js.Json.JSONNull) => value
+    | (OptionalWithDefault(shape, _), _) => untagged->fromUntagged(shape, self)
+    | (Optional(_), Js.Json.JSONNull) => FieldValue.null
+    | (Optional(shape), _) => untagged->fromUntagged(shape, self)
+    | (Morphism(shape, f), _) => untagged->fromUntagged(shape, self)->f->FieldValue.any
+
+    | (Collection(m), Js.Json.JSONArray(items)) => {
+        module M = unpack(m: Deserializer)
+        items
+        ->Array.map(M.fromJSON)
+        ->Array.map(Result.warn)
+        ->Array.keepSome
+        ->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) => {
+          Js.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))
+      ->ManyResults.bailU
+      ->ManyResults.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))
+      ->ManyResults.bailU
+      ->ManyResults.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 `Js.Json.t` into `result<t, string>`")
+  let fromJSON = (json: Js.Json.t): result<t, _> => {
+    switch json->Field.fromUntagged(fields, fields) {
+    | res => Ok(res->_toNativeType)
+    | exception TypeError(e) => Error(e)
+    }
+  }
+}

package/package.json

@@ -1,6 +1,6 @@
 {
   "name": "@kaiko.io/rescript-deser",
-  "version": "4.0.0-rc.2",
+  "version": "4.0.0-rc.4",
   "keywords": [
     "json",
     "deserializer",
@@ -20,7 +20,7 @@
     "README.md"
   ],
   "dependencies": {
-    "@kaiko.io/rescript-prelude": "7.0.0-rc.3"
+    "@kaiko.io/rescript-prelude": "7.0.0-rc.4"
   },
   "devDependencies": {
     "esbuild": "^0.15.7",

package/src/JSON.res

@@ -23,20 +23,11 @@ module FieldValue = {
 
 exception TypeError(string)
 
-@doc("The module type of a deserializer which is suitable to add as a subparser.")
-module type ArgDeserializer = {
-  type t
-  let name: string
-  let fromJSON: Js.Json.t => result<t, string>
-  let checkFieldsSanity: unit => result<unit, string>
-}
-
-@doc("The module type of a built deserializer.")
+@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: Js.Json.t => result<t, string>
-  let fromAny: 'a => result<t, string>
   let checkFieldsSanity: unit => result<unit, string>
 }
 
@@ -66,13 +57,13 @@ module Field = {
     /// expected entries.
     | Mapping(t)
 
-    | Deserializer(module(ArgDeserializer))
+    | 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(ArgDeserializer))
+    | Collection(module(Deserializer))
     | DefaultWhenInvalid(t, FieldValue.t)
 
     // FIXME: this is used to add additional restrictions like variadictInt or
@@ -121,7 +112,7 @@ module Field = {
     | Date => "Date"
     | Self => "Self (recursive)"
     | Collection(m) => {
-        module M = unpack(m: ArgDeserializer)
+        module M = unpack(m: Deserializer)
         "Collection of " ++ M.name
       }
 
@@ -138,7 +129,7 @@ module Field = {
     | Mapping(t) => `Mapping of ${t->toString}`
     | Morphism(t, _) => t->toString ++ " to apply a morphism"
     | Deserializer(m) => {
-        module M = unpack(m: ArgDeserializer)
+        module M = unpack(m: Deserializer)
         M.name
       }
 
@@ -243,7 +234,7 @@ module Field = {
     | (Morphism(shape, f), _) => untagged->fromUntagged(shape, self)->f->FieldValue.any
 
     | (Collection(m), Js.Json.JSONArray(items)) => {
-        module M = unpack(m: ArgDeserializer)
+        module M = unpack(m: Deserializer)
         items
         ->Array.map(M.fromJSON)
         ->Array.map(Result.warn)
@@ -253,7 +244,7 @@ module Field = {
       }
 
     | (Deserializer(m), _) => {
-        module M = unpack(m: ArgDeserializer)
+        module M = unpack(m: Deserializer)
         switch untagged->M.fromJSON {
         | Ok(res) => res->FieldValue.any
         | Error(msg) => raise(TypeError(msg))
@@ -286,7 +277,7 @@ module Field = {
 
     | (Collection(mod), _)
     | (Deserializer(mod), _) => {
-        module M = unpack(mod: ArgDeserializer)
+        module M = unpack(mod: Deserializer)
         switch M.checkFieldsSanity() {
         | Ok() => Ok()
         | Error(msg) => Error(`${name}/ ${msg}`)
@@ -329,10 +320,7 @@ module MakeDeserializer = (S: Serializable): (Deserializer with type t = S.t) =>
   %%private(let (loc, _f) = __LOC_OF__(module(S: Serializable)))
   let name = `Deserializer ${__MODULE__}, ${loc}`
 
-  %%private(
-    external _toNativeType: FieldValue.t => t = "%identity"
-    external cast: 'a => 'b = "%identity"
-  )
+  %%private(external _toNativeType: FieldValue.t => t = "%identity")
 
   @doc("Checks for trivial infinite-recursion in the fields of the module.
 
@@ -352,20 +340,4 @@ module MakeDeserializer = (S: Serializable): (Deserializer with type t = S.t) =>
     | exception TypeError(e) => Error(e)
     }
   }
-
-  @doc("Try to parse anything")
-  let fromAny = any => {
-    switch Js.typeof(any) {
-    | "string" =>
-      switch any->cast->Js.Json.parseExn {
-      | parsed => fromJSON(parsed)
-      | exception _ => Error("Could parse string as JSON")
-      }
-    | _ =>
-      switch any->cast->fromJSON {
-      | result => result
-      | exception _ => Error("Could not deserialize the data")
-      }
-    }
-  }
 }