Patchworks tools as Hazel Exolivelit

Makefile

@@ -1,6 +1,6 @@
 TEST_DIR="$(shell pwd)/_build/default/test"
 HTML_DIR="$(shell pwd)/_build/default/src/web/www"
-SERVER="http://0.0.0.0:8000/"
+SERVER="http://0.0.0.0:8009/"
 
 .PHONY: all deps change-deps setup-instructor setup-student dev dev-helper dev-student fmt watch watch-release release release-student grade echo-html-dir serve serve2 repl test clean setup-zarith
 
@@ -30,7 +30,7 @@ change-deps:
 setup-instructor:
 	cp src/web/exercises/settings/ExerciseSettings_instructor.re src/web/exercises/settings/ExerciseSettings.re
 
-setup-student: 
+setup-student:
 	cp src/web/exercises/settings/ExerciseSettings_student.re src/web/exercises/settings/ExerciseSettings.re
 
 dev-helper: setup-zarith
@@ -66,7 +66,7 @@ echo-html-dir:
 	@echo $(HTML_DIR)
 
 serve:
-	cd $(HTML_DIR); python3 -m http.server 8000 --bind 0.0.0.0
+	cd $(HTML_DIR); python3 -m http.server 8014 --bind 0.0.0.0
 
 hot:
 	npx vite
@@ -97,7 +97,7 @@ coverage:
 ci: setup-zarith
 	dune build --profile dev
 	dune runtest --instrument-with bisect_ppx --force
-	
+
 generate-coverage-html:
 	bisect-ppx-report html
 

package.json

@@ -10,16 +10,24 @@
   },
   "homepage": "https://hazel.org",
   "dependencies": {
+    "@automerge/automerge-repo-keyhive": "^0.0.0-alpha.53",
+    "@automerge/vanillajs": "^2.5.0",
     "@esbuild-plugins/node-resolve": "^0.2.2",
+    "@inkandswitch/patchwork-bootloader": "^0.0.4",
+    "@inkandswitch/patchwork-elements": "^0.0.5",
+    "@inkandswitch/patchwork-filesystem": "^0.0.3",
+    "@inkandswitch/patchwork-plugins": "^0.0.5",
     "@observablehq/plot": "^0.6.17",
     "algebrite": "^1.4.0",
     "hotkeys-js": "^3.8.7",
     "ninja-keys": "^1.2.2",
+    "resolve.exports": "^2.0.3",
     "web-worker": "^1.5.0"
   },
   "devDependencies": {
     "@types/node": "^22.14.0",
     "esbuild": "^0.25.1",
+    "esbuild-plugin-wasm": "^1.1.0",
     "vite": "^6.4.1",
     "vite-plugin-static-copy": "^2.3.0"
   }

src/haz3lcore/ExternalProjectorBridge.re

@@ -267,7 +267,9 @@ let listener = (event: _) => {
     | Some(entry) => dispatch(msg, entry)
     | None => prerr_endline("listener: projector not found")
     }
-  | None => prerr_endline("listener: invalid message format")
+  | None =>
+    //prerr_endline("listener: invalid message format")
+    ()
   };
   Js._true;
 };

src/haz3lcore/HazelProtocol.re

@@ -98,8 +98,8 @@ let parse_to_hazel_message = (data: Js.t(_)): option(to_hazel_message) =>
       None;
     }
   | None =>
-    prerr_endline("parse_to_hazel_message: missing id or wrong id format");
-    None;
+    //prerr_endline("parse_to_hazel_message: missing id or wrong id format");
+    None
   };
 
 /* Convert from_hazel_message to JavaScript object */

src/haz3lcore/projectors/ProjectorInit.re

@@ -26,6 +26,7 @@ let to_module = (kind: ProjectorCore.Kind.t): (module Cooked) =>
 
      ))
   | Graph => (module Cook(GraphProj.M))
+  | Patchwork => (module Cook(PatchworkProj.M))
   | ObservablePlot => (module Cook(ObservablePlotProj.M))
   };
 

src/haz3lcore/projectors/implementations/PatchworkProj.re

@@ -0,0 +1,193 @@
+open Util;
+open Virtual_dom.Vdom;
+open ProjectorBase;
+open Language;
+
+type patchwork_config = {
+  doc_url: string,
+  tool_id: string,
+};
+
+module Decode = {
+  let warn = (warnings: ref(list(string)), message: string): unit =>
+    warnings := [message, ...warnings^];
+
+  let rec strip_parens = (exp: Exp.t): Exp.t =>
+    switch (exp.term) {
+    | Parens(inner) => strip_parens(inner)
+    | _ => exp
+    };
+
+  let string_literal = (exp: Exp.t): option(string) =>
+    switch (exp.term) {
+    | Atom(String(text)) => Some(text)
+    | _ => None
+    };
+
+  let decode_tuple =
+      (exp: Exp.t, warnings: ref(list(string))): option(patchwork_config) => {
+    let normalized: Exp.t = strip_parens(exp);
+    switch (normalized.term) {
+    | Tuple([doc_exp, tool_exp]) =>
+      let doc_opt: option(string) = string_literal(doc_exp);
+      let tool_opt: option(string) = string_literal(tool_exp);
+      switch (doc_opt, tool_opt) {
+      | (Some(doc_url), Some(tool_id)) =>
+        Some({
+          doc_url,
+          tool_id,
+        })
+      | _ =>
+        if (doc_opt == None) {
+          warn(
+            warnings,
+            "Patchwork projector doc-url argument must be a string literal.",
+          );
+        };
+        if (tool_opt == None) {
+          warn(
+            warnings,
+            "Patchwork projector tool-id argument must be a string literal.",
+          );
+        };
+        None;
+      };
+    | Tuple(_) =>
+      warn(
+        warnings,
+        "Patchwork projector expects exactly two arguments (doc-url, tool-id).",
+      );
+      None;
+    | _ =>
+      warn(
+        warnings,
+        "Patchwork projector arguments must be provided as a tuple literal.",
+      );
+      None;
+    };
+  };
+
+  let decode_any =
+      (term: Any.t, warnings: ref(list(string))): option(patchwork_config) =>
+    switch (term) {
+    | Exp(exp_term) => decode_tuple(exp_term, warnings)
+    | _ =>
+      warn(
+        warnings,
+        "Patchwork projector is only supported for expression syntax.",
+      );
+      None;
+    };
+
+  let decode_info = (info: info): (option(patchwork_config), list(string)) => {
+    let warnings: ref(list(string)) = ref([]);
+    let config_opt: option(patchwork_config) =
+      switch (info.syntax |> info.utility.seg_to_term) {
+      | Some(term) => decode_any(term, warnings)
+      | None =>
+        warn(
+          warnings,
+          "Patchwork projector could not read the underlying syntax.",
+        );
+        None;
+      };
+    (config_opt, List.rev(warnings^));
+  };
+
+  let decode_for_init = (term: Any.t): option(patchwork_config) => {
+    let warnings: ref(list(string)) = ref([]);
+    decode_any(term, warnings);
+  };
+};
+
+let warning_list = (warnings: list(string)): Node.t =>
+  Node.div(
+    ~attrs=[Attr.classes(["patchwork-warning-list"])],
+    List.map(
+      (message: string) =>
+        Node.div(
+          ~attrs=[Attr.classes(["patchwork-warning-item"])],
+          [Node.text(message)],
+        ),
+      warnings,
+    ),
+  );
+
+let patchwork_element = (config: patchwork_config): Node.t =>
+  Node.create(
+    "patchwork-view",
+    ~attrs=[
+      Attr.create("doc-url", config.doc_url),
+      Attr.create("tool-id", config.tool_id),
+    ],
+    [],
+  );
+
+let error_node = (warnings: list(string)): Node.t => {
+  let extra_children: list(Node.t) =
+    switch (warnings) {
+    | [] => []
+    | _ => [warning_list(warnings)]
+    };
+  Node.div(
+    ~attrs=[Attr.classes(["patchwork-error"])],
+    [Node.text("Unable to render Patchwork projector.")] @ extra_children,
+  );
+};
+
+let content_with_warnings = (content: Node.t, warnings: list(string)): Node.t =>
+  switch (warnings) {
+  | [] => content
+  | _ =>
+    Node.div(
+      ~attrs=[Attr.classes(["patchwork-container"])],
+      [content, warning_list(warnings)],
+    )
+  };
+
+module M: Projector = {
+  [@deriving (show({with_path: false}), sexp, yojson)]
+  type model = unit;
+  [@deriving (show({with_path: false}), sexp, yojson)]
+  type action = unit;
+
+  let default_model: model = ();
+
+  let init = (term: Language.Any.t): option(model) =>
+    switch (Decode.decode_for_init(term)) {
+    | Some(_) => Some(default_model)
+    | None => None
+    };
+
+  let focusable: Focusable.t = Focusable.non;
+
+  let dynamics: bool = false;
+
+  let placeholder_size: ProjectorCore.Shape.t = {
+    horizontal: 48,
+    vertical: Block(18),
+  };
+
+  let placeholder = (_model: model, _info: info): ProjectorCore.Shape.t => placeholder_size;
+
+  let update = (model: model, _info: info, _action: action): model => model;
+
+  let view = ({info, status, _}: View.args(model, action)): View.t => {
+    let indicated_class: list(string) =
+      switch (status.indication) {
+      | Some(_) => ["indicated"]
+      | None => []
+      };
+    let class_list: list(string) =
+      ["projector", "Patchwork"] @ indicated_class;
+    let (config_opt, warnings) = Decode.decode_info(info);
+    let body: Node.t =
+      switch (config_opt) {
+      | Some(config) =>
+        let element: Node.t = patchwork_element(config);
+        content_with_warnings(element, warnings);
+      | None => error_node(warnings)
+      };
+    View.mk(Node.div(~attrs=[Attr.classes(class_list)], [body]));
+  };
+};

src/language/ProjectorKind.re

@@ -27,6 +27,7 @@ type t =
   | Csv
   | Graph
   | ObservablePlot
+  | Patchwork
   | Exo(exo);
 
 let livelit_projectors: list(t) =
@@ -43,7 +44,8 @@ let livelit_projectors: list(t) =
   @ List.map(x => Exo(x), all_of_exo);
 
 /* Note: Probe intentionally excluded - probes use separate action path */
-let projectors: list(t) = livelit_projectors @ [Fold, Graph, ObservablePlot];
+let projectors: list(t) =
+  livelit_projectors @ [Fold, Graph, ObservablePlot, Patchwork];
 
 /* Refractors are like probes - additive decorations, not syntax-replacing */
 let refractors: list(t) = [Probe, Statics];
@@ -66,6 +68,7 @@ let name = (p: t): string =>
   | Csv => "csv"
   | Graph => "graph"
   | ObservablePlot => "ObservablePlot"
+  | Patchwork => "Patchwork"
   | Exo(exo_kind) => show_exo(exo_kind)
   };
 
@@ -85,6 +88,7 @@ let of_name = (p: string): t =>
   | "card" => Card
   | "csv" => Csv
   | "graph" => Graph
+  | "Patchwork" => Patchwork
   | "ObservablePlot" => ObservablePlot
   | _ => Exo(p |> Sexplib.Sexp.of_string |> exo_of_sexp)
   };

src/web/app/editors/code/ContextMenu.re

@@ -421,6 +421,7 @@ module Projectors = {
     | Livelit => "Livelit"
     | Probe => "Probe" /* shouldn't appear in menu */
     | Graph => "Graph"
+    | Patchwork => "Patchwork"
     | ObservablePlot => "Plot"
     | Exo(exo_kind) => Exo.name(exo_kind)
     };

src/web/www/build-prebundle.mjs

@@ -0,0 +1,33 @@
+#!/usr/bin/env node
+
+import {build} from "esbuild"
+import {wasmLoader} from "esbuild-plugin-wasm"
+import {fileURLToPath} from "node:url"
+import path from "node:path"
+import externals from "@inkandswitch/patchwork-bootloader/externals"
+
+const __filename = fileURLToPath(import.meta.url)
+const __dirname = path.dirname(__filename)
+
+const entryPoint = path.join(__dirname, "prebundle.js")
+const outFile = path.join(__dirname, "bundled.js")
+
+async function run() {
+	await build({
+		entryPoints: [entryPoint],
+		bundle: true,
+		outfile: outFile,
+		absWorkingDir: __dirname,
+		format: "esm",
+		platform: "browser",
+		target: "esnext",
+		logLevel: "info",
+		plugins: [wasmLoader()],
+		external: externals,
+	})
+}
+
+run().catch(error => {
+	console.error(error)
+	process.exit(1)
+})

src/web/www/dune

@@ -6,10 +6,10 @@
 
 (rule
  (targets bundled.js)
- (deps prebundle.js)
+ (deps
+  prebundle.js
+  (source_tree %{workspace_root}/node_modules))
  (action
-  (run
-   %{project_root}/node_modules/esbuild/bin/esbuild
-   prebundle.js
-   --bundle
-   --outfile=bundled.js)))
+  (chdir
+   %{workspace_root}
+   (run node %{dep:build-prebundle.mjs}))))