Serialisation/parsing of custom structures in JSON (#60)

This patch adds traits for types to describe how they can be serialised and reified when using a JSON encoding. The approach here favours control over reification to avoid issues with arbitrary code being able to construct capability-bearing types by simply stating their names; here the person describing the JSON types must provide a mapping for them that describes the lowering and the reification passes.

In order to support custom serialisation, the package forks JSON into standard JSON (`json` object), and "extended" JSON (`extended-json`) object. The extended JSON object stores non-standard types as the dictionary `{"@type": "unique-tag", "value": ... }`, it then uses the mapping contained in the extended JSON type to both serialise and reify these types.

Moving the extended JSON portion to a separate type avoids issues with JSON payloads that may use this convention in a different way, and also discourages a single object with all mappings.

Example usage:

```
let My-domain = #json-serialisation bare
  | tag: "project" type: #project
  | tag: "package" type: #pkg;
let Json = #extended-json with-serialisation: My-domain;

assert (Json parse: (Json serialise: new project("title", new pkg("name", "filename"))))
  === new project("title", new pkg("name", "filename"));
```

source/vm/primitives/location.ts

@@ -2,6 +2,7 @@ import { inspect } from "util";
 import { CrochetActivation, NativeActivation } from "..";
 import * as IR from "../../ir";
 import { unreachable } from "../../utils/utils";
+import * as im from "immutable";
 import {
   Activation,
   ActivationTag,
@@ -192,6 +193,8 @@ export function simple_value(x: CrochetValue): string {
       const repr =
         x.payload instanceof CrochetValue
           ? simple_value(x.payload)
+          : im.isImmutable(x.payload)
+          ? immutable_repr(x.payload)
           : `native ${inspect(x.payload, false, 3)}`;
       return `<unknown>(${repr})`;
     }
@@ -216,6 +219,36 @@ export function simple_value(x: CrochetValue): string {
   }
 }
 
+function immutable_repr(x: unknown) {
+  if (im.isList(x)) {
+    return `<native list>[\n${block(
+      2,
+      x
+        .toArray()
+        .map((x) => simple_value(x as any))
+        .join(", ")
+    )}\n]`;
+  } else if (im.isMap(x)) {
+    if (x.size === 0) {
+      return "<native map>[->]";
+    }
+    const pairs = [...x.entries()].map(
+      ([k, v]) => `${simple_value(k as any)} -> ${simple_value(v as any)}`
+    );
+    return `<native map>[\n${block(2, pairs.join(",\n"))}\n]`;
+  } else if (im.isSet(x)) {
+    return `<native set>[\n${block(
+      2,
+      x
+        .toArray()
+        .map((x) => simple_value(x as any))
+        .join(", ")
+    )}\n]`;
+  } else {
+    return `<native collection>`;
+  }
+}
+
 export function simple_op(op: IR.Op, index: number | null): string {
   const entries = Object.entries(op)
     .filter(

stdlib/crochet.core/source/collection/equality.crochet

@@ -25,7 +25,8 @@ implement equality for set;
 
 /// True if two sets have equal values.
 command set === (That is set) do
-  foreign set.equals(self.box, That.box);
+  (self count =:= That count)
+    and (self values all: (That contains: _));
 test
   assert (#set from: [1, 2, 3]) === (#set from: [1, 2, 3]);
   assert (#set from: [3, 2, 1]) === (#set from: [3, 2, 1]);
@@ -38,10 +39,20 @@ implement equality for map;
 
 /// True if two maps have equal values.
 command map === (That is map) do
-  foreign map.equals(self.box, That.box);
+  (self count =:= That count)
+    and (self entries all: { Pair in
+          condition
+            when That contains-key: Pair key => (That at: Pair key) === Pair value;
+            otherwise => false;
+          end
+        });
 test
   assert #map empty === #map empty;
   assert (#map empty | at: 1 put: 2 | at: 3 put: 4) === (#map empty | at: 3 put: 4 | at: 1 put: 2);
   assert not ((#map empty | at: 1 put: 2 | at: 3 put: 4) === (#map empty | at: 1 put: 2));
   assert not ((#map empty | at: 1 put: 2) === (#map empty | at: 3 put: 4));
+
+  let A = #map from: [a -> [1.0, 2.0], b -> #map from: [c -> 3.0]];
+  let B = #map from: [a -> [1.0, 2.0], b -> #map from: [c -> 3.0]];
+  assert A === B;
 end

stdlib/crochet.core/source/traits/conversion.crochet

@@ -69,6 +69,10 @@ test
   assert (#integer try-parse: "nope") is error;
 end
 
+command #integer parse: (X is text) =
+  #integer try-parse: X
+    | value-or-panic: "invalid integer";
+
 /// Attempts to parse a piece of text as a floating point number. The
 /// grammar is similar to the JavaScript's floating point grammar.
 command #float-64bit try-parse: (X is text) -> result do
@@ -85,6 +89,10 @@ test
   assert (#float-64bit try-parse: "nope") is error;
 end
 
+command #float-64bit parse: (X is text) =
+  #float-64bit try-parse: X
+    | value-or-panic: "invalid float";
+
 /// Converts an integer to a piece of trusted text.
 command integer to-text = foreign integer.to-text(self);
 

stdlib/crochet.language.json/crochet.json

@@ -4,7 +4,14 @@
   "stability": "experimental",
   "native_sources": ["native/json.js"],
   "dependencies": ["crochet.core"],
-  "sources": ["source/json.crochet"],
+  "sources": [
+    "source/capabilities.crochet",
+    "source/json.crochet",
+    "source/types.crochet",
+    "source/custom-serialisation.crochet",
+    "source/trait-instances.crochet",
+    "source/serialisation.crochet"
+  ],
   "capabilities": {
     "requires": [],
     "provides": []

stdlib/crochet.language.json/native/json.ts

@@ -1,49 +1,221 @@
 import type { ForeignInterface, CrochetValue } from "../../../build/crochet";
 
 export default (ffi: ForeignInterface) => {
-  function to_json(x: unknown): unknown {
-    if (typeof x === "bigint") {
-      return Number(x);
-    } else if (Array.isArray(x)) {
-      return x.map(to_json);
-    } else if (x instanceof Map) {
-      const value = Object.create(null);
-      for (const [k, v] of x.entries()) {
-        value[k] = to_json(v);
-      }
-      return value;
-    } else {
-      return x;
+  abstract class Json {
+    abstract toJSON(): any;
+  }
+
+  class JsonNull extends Json {
+    toJSON() {
+      return null;
+    }
+  }
+
+  class JsonNumber extends Json {
+    constructor(readonly value: number) {
+      super();
+    }
+
+    toJSON() {
+      return this.value;
+    }
+  }
+
+  class JsonText extends Json {
+    constructor(readonly value: string) {
+      super();
+    }
+
+    toJSON() {
+      return this.value;
+    }
+  }
+
+  class JsonBoolean extends Json {
+    constructor(readonly value: boolean) {
+      super();
+    }
+
+    toJSON() {
+      return this.value;
     }
   }
 
-  function from_json(x: unknown): unknown {
-    if (Array.isArray(x)) {
-      return x.map((a) => from_json(a));
-    } else if (typeof x === "object" && x != null) {
-      const result = new Map<string, unknown>();
-      for (const [k, v] of Object.entries(x)) {
-        result.set(k, from_json(v));
+  class JsonList extends Json {
+    constructor(readonly values: Json[]) {
+      super();
+    }
+
+    toJSON() {
+      return this.values;
+    }
+  }
+
+  class JsonRecord extends Json {
+    constructor(readonly entries: [string, Json][]) {
+      super();
+    }
+
+    toJSON() {
+      const result = Object.create(null);
+      for (const [k, v] of this.entries) {
+        result[k] = v;
       }
       return result;
-    } else {
-      return x;
     }
   }
 
+  class JsonTyped extends Json {
+    constructor(readonly tag: string, readonly value: Json) {
+      super();
+    }
+
+    toJSON() {
+      return {
+        "@type": this.tag,
+        value: this.value,
+      };
+    }
+  }
+
+  const _null = new JsonNull();
+
+  function make_reify(extended: boolean) {
+    function reify_json(key: string, value: unknown) {
+      if (value instanceof Json) {
+        return value;
+      } else if (value == null) {
+        return _null;
+      } else if (typeof value === "number") {
+        return new JsonNumber(value);
+      } else if (typeof value === "boolean") {
+        return new JsonBoolean(value);
+      } else if (typeof value === "string") {
+        return new JsonText(value);
+      } else if (Array.isArray(value)) {
+        return new JsonList(value);
+      } else if (extended && "@type" in (value as any)) {
+        const v = value as { "@type": any; value: Json };
+        if (!(v["@type"] instanceof JsonText)) {
+          throw ffi.panic("invalid-type", "expected text");
+        }
+        if (!("value" in v) || !(v.value instanceof Json)) {
+          throw ffi.panic("invalid-type", "expected a proper typed json");
+        }
+        const type = (v["@type"] as JsonText).value;
+        return new JsonTyped(type, v.value);
+      } else {
+        return new JsonRecord(Object.entries(value as any));
+      }
+    }
+
+    return reify_json;
+  }
+
+  ffi.defun("json.typed", (tag, value) => {
+    return ffi.box(
+      new JsonTyped(ffi.text_to_string(tag), ffi.unbox_typed(Json, value))
+    );
+  });
+
+  ffi.defun("json.null", () => {
+    return ffi.box(_null);
+  });
+
+  ffi.defun("json.boolean", (x) => {
+    return ffi.box(new JsonBoolean(ffi.to_js_boolean(x)));
+  });
+
+  ffi.defun("json.number", (x) => {
+    return ffi.box(new JsonNumber(ffi.float_to_number(x)));
+  });
+
+  ffi.defun("json.text", (x) => {
+    return ffi.box(new JsonText(ffi.text_to_string(x)));
+  });
+
+  ffi.defun("json.list", (x) => {
+    return ffi.box(
+      new JsonList(ffi.list_to_array(x).map((x) => ffi.unbox_typed(Json, x)))
+    );
+  });
+
+  ffi.defun("json.record", (x) => {
+    return ffi.box(
+      new JsonRecord(
+        ffi.list_to_array(x).map((p) => {
+          const [k, v] = ffi.list_to_array(p);
+          return [ffi.text_to_string(k), ffi.unbox_typed(Json, v)];
+        })
+      )
+    );
+  });
+
   ffi.defun("json.untrusted", (text) => {
     return ffi.untrusted_text(ffi.text_to_string(text));
   });
 
-  ffi.defun("json.parse", (text, trusted) => {
-    return ffi.from_plain_native(
-      from_json(JSON.parse(ffi.text_to_string(text))),
-      ffi.to_js_boolean(trusted)
+  ffi.defun("json.parse", (text, extended0) => {
+    const extended = ffi.to_js_boolean(extended0);
+    const value = JSON.parse(ffi.text_to_string(text), make_reify(extended));
+    return ffi.box(value);
+  });
+
+  ffi.defun("json.get-type", (x0) => {
+    const x = ffi.unbox_typed(Json, x0);
+    if (x instanceof JsonNull) {
+      return ffi.text("null");
+    } else if (x instanceof JsonNumber) {
+      return ffi.text("number");
+    } else if (x instanceof JsonText) {
+      return ffi.text("text");
+    } else if (x instanceof JsonBoolean) {
+      return ffi.text("boolean");
+    } else if (x instanceof JsonList) {
+      return ffi.text("list");
+    } else if (x instanceof JsonRecord) {
+      return ffi.text("record");
+    } else if (x instanceof JsonTyped) {
+      return ffi.text("typed");
+    } else {
+      throw ffi.panic("invalid-type", "invalid json type");
+    }
+  });
+
+  ffi.defun("json.get-number", (x) => {
+    return ffi.float_64(ffi.unbox_typed(JsonNumber, x).value);
+  });
+
+  ffi.defun("json.get-boolean", (x) => {
+    return ffi.boolean(ffi.unbox_typed(JsonBoolean, x).value);
+  });
+
+  ffi.defun("json.get-text", (x) => {
+    return ffi.text(ffi.unbox_typed(JsonText, x).value);
+  });
+
+  ffi.defun("json.get-list", (x) => {
+    return ffi.list(ffi.unbox_typed(JsonList, x).values.map((x) => ffi.box(x)));
+  });
+
+  ffi.defun("json.get-record-entries", (x) => {
+    return ffi.list(
+      ffi.unbox_typed(JsonRecord, x).entries.map(([k, v]) => {
+        return ffi.list([ffi.text(k), ffi.box(v)]);
+      })
     );
   });
 
+  ffi.defun("json.get-typed-tag", (x) => {
+    return ffi.text(ffi.unbox_typed(JsonTyped, x).tag);
+  });
+
+  ffi.defun("json.get-typed-value", (x) => {
+    return ffi.box(ffi.unbox_typed(JsonTyped, x).value);
+  });
+
   ffi.defun("json.serialise", (value, trusted) => {
-    const json = to_json(ffi.to_plain_native(value));
+    const json = ffi.unbox_typed(Json, value);
     const json_text = JSON.stringify(json);
     if (ffi.to_js_boolean(trusted)) {
       return ffi.text(json_text);
@@ -53,7 +225,7 @@ export default (ffi: ForeignInterface) => {
   });
 
   ffi.defun("json.pretty-print", (value, indent, trusted) => {
-    const json = to_json(ffi.to_plain_native(value));
+    const json = ffi.unbox_typed(Json, value);
     const json_text = JSON.stringify(
       json,
       null,

stdlib/crochet.language.json/source/capabilities.crochet

@@ -0,0 +1,7 @@
+% crochet
+
+singleton internal;
+capability internal;
+
+protect type internal with internal;
+protect global internal with internal;