From d614d2f6f3e4455fdbdf5b7883b13eb8fa477c41 Mon Sep 17 00:00:00 2001 From: Gregory Croisdale Date: Wed, 11 Dec 2024 10:39:51 -0500 Subject: [PATCH 1/2] init --- Makefile | 2 +- hazel.opam | 1 + hazel.opam.locked | 2 +- src/haz3lweb/Main.re | 1 + src/haz3lweb/Store.re | 23 +++++++++--- src/haz3lweb/Update.re | 10 +++++ src/haz3lweb/UpdateAction.re | 1 + src/haz3lweb/view/NutMenu.re | 6 ++- src/haz3lweb/view/ScratchMode.re | 6 +++ src/util/JsUtil.re | 64 ++++++++++++++++++++++++++++++++ src/util/StringUtil.re | 17 +++++++++ src/util/dune | 2 +- 12 files changed, 126 insertions(+), 9 deletions(-) diff --git a/Makefile b/Makefile index 5eef59a1d4..4fba1cf098 100644 --- a/Makefile +++ b/Makefile @@ -50,7 +50,7 @@ echo-html-dir: @echo $(HTML_DIR) serve: - cd $(HTML_DIR); python3 -m http.server 8000 + cd $(HTML_DIR); python3 -m http.server 8000 --bind 127.0.0.1 serve2: cd $(HTML_DIR); python3 -m http.server 8001 diff --git a/hazel.opam b/hazel.opam index 09ee887ab3..6f43cbbd17 100644 --- a/hazel.opam +++ b/hazel.opam @@ -14,6 +14,7 @@ depends: [ "reason" {>= "3.12.0"} "ppx_yojson_conv_lib" "ppx_yojson_conv" + "incr_dom" "bisect_ppx" "omd" {>= "2.0.0~alpha4"} "ezjs_idb" diff --git a/hazel.opam.locked b/hazel.opam.locked index 856b83ad33..aedd111ccb 100644 --- a/hazel.opam.locked +++ b/hazel.opam.locked @@ -38,8 +38,8 @@ depends: [ "bignum" {= "v0.16.0"} "bigstringaf" {= "0.10.0"} "bin_prot" {= "v0.16.0"} - "bonsai" {= "v0.16.0"} "bisect_ppx" {= "2.8.3"} + "bonsai" {= "v0.16.0"} "camlp-streams" {= "5.0.1"} "chrome-trace" {= "3.16.0"} "cmdliner" {= "1.3.0"} diff --git a/src/haz3lweb/Main.re b/src/haz3lweb/Main.re index 16811a32cb..d6bf9a92eb 100644 --- a/src/haz3lweb/Main.re +++ b/src/haz3lweb/Main.re @@ -46,6 +46,7 @@ let apply = (model, action, ~schedule_action, ~schedule_autosave): Model.t => { "ERROR: Exception during apply: %s\n", Printexc.to_string(exc), ); + Printf.printf("Action: %s\n", action |> UpdateAction.show); Error(Exception(Printexc.to_string(exc))); } ) { diff --git a/src/haz3lweb/Store.re b/src/haz3lweb/Store.re index f30a18ab85..3ac6b2f2ba 100644 --- a/src/haz3lweb/Store.re +++ b/src/haz3lweb/Store.re @@ -1,5 +1,6 @@ open Haz3lcore; open Util; +open StringUtil; // A generic key-value store for saving/loading data to/from local storage module Generic = { @@ -160,14 +161,26 @@ module Scratch = { scratch; }; - let load = (~settings: CoreSettings.t): t => - switch (JsUtil.get_localstore(save_scratch_key)) { - | None => init(~settings) + let load = (~settings: CoreSettings.t): t => { + switch (JsUtil.QueryParams.get_param("scratch")) { | Some(data) => - try(deserialize(~settings, data)) { - | _ => init(~settings) + switch (decompress(data)) { + | None => init(~settings) + | Some(data) => + try(deserialize(data, ~settings)) { + | _ => init(~settings) + } + } + | None => + switch (JsUtil.get_localstore(save_scratch_key)) { + | None => init(~settings) + | Some(data) => + try(deserialize(~settings, data)) { + | _ => init(~settings) + } } }; + }; let export = (~settings: CoreSettings.t): string => serialize(load(~settings)); diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 778df5114a..40b62ba51c 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -465,6 +465,16 @@ let apply = (model: Model.t, update: t, ~schedule_action): Result.t(Model.t) => let editor = Editors.get_editor(model.editors); export_scratch_slide(editor); Ok(model); + | Export(EncodeScratchSlide) => + Model.save(model); + let editor = Editors.get_editor(model.editors); + let json_data = ScratchSlide.export(editor); + let compressed = + StringUtil.compress(json_data |> Yojson.Safe.to_string); + JsUtil.log(json_data); + JsUtil.log(compressed); + JsUtil.QueryParams.set_param("scratch", compressed); + Ok(model); | Export(ExerciseModule) => Model.save(model); instructor_exercise_update(model, export_exercise_module); diff --git a/src/haz3lweb/UpdateAction.re b/src/haz3lweb/UpdateAction.re index cd2f145f3e..c92d1f40ec 100644 --- a/src/haz3lweb/UpdateAction.re +++ b/src/haz3lweb/UpdateAction.re @@ -47,6 +47,7 @@ type benchmark_action = [@deriving (show({with_path: false}), sexp, yojson)] type export_action = + | EncodeScratchSlide | ExportScratchSlide | ExportPersistentData | ExerciseModule diff --git a/src/haz3lweb/view/NutMenu.re b/src/haz3lweb/view/NutMenu.re index b67f406504..6516731607 100644 --- a/src/haz3lweb/view/NutMenu.re +++ b/src/haz3lweb/view/NutMenu.re @@ -129,7 +129,11 @@ let file_group_scratch = (~inject) => item_group( ~inject, "File", - [ScratchMode.export_button(inject), ScratchMode.import_button(inject)], + [ + ScratchMode.export_button(inject), + ScratchMode.encode_button(inject), + ScratchMode.import_button(inject), + ], ); let reset_group_scratch = (~inject) => diff --git a/src/haz3lweb/view/ScratchMode.re b/src/haz3lweb/view/ScratchMode.re index 7fdc8eb361..64f2b560ef 100644 --- a/src/haz3lweb/view/ScratchMode.re +++ b/src/haz3lweb/view/ScratchMode.re @@ -50,6 +50,12 @@ let export_button = (inject: Update.t => Ui_effect.t(unit)) => _ => inject(Export(ExportScratchSlide)), ~tooltip="Export Scratchpad", ); +let encode_button = (inject: Update.t => Ui_effect.t(unit)) => + Widgets.button_named( + Icons.export, + _ => inject(Export(EncodeScratchSlide)), + ~tooltip="Encode Scratchpad", + ); let import_button = inject => Widgets.file_select_button_named( "import-scratchpad", diff --git a/src/util/JsUtil.re b/src/util/JsUtil.re index bd8388b7ad..1ea6465325 100644 --- a/src/util/JsUtil.re +++ b/src/util/JsUtil.re @@ -1,5 +1,6 @@ open Js_of_ocaml; open Virtual_dom.Vdom; +open Js_of_ocaml.Url; let get_elem_by_id = id => { let doc = Dom_html.document; @@ -174,3 +175,66 @@ module Fragment = { Url.Current.get() |> Option.map(fragment_of_url); }; }; + +module QueryParams = { + let get_arguments = (url: Url.url): list((string, string)) => + switch (url) { + | Http({hu_arguments, _}) => hu_arguments + | Https({hu_arguments, _}) => hu_arguments + | File({fu_arguments, _}) => fu_arguments + }; + + let set_arguments = (url: Url.url, args: list((string, string))): Url.url => + switch (url) { + | Http(u) => Http({...u, hu_arguments: args}) + | Https(u) => Https({...u, hu_arguments: args}) + | File(u) => File({...u, fu_arguments: args}) + }; + + let get_param = (name: string) => { + let q_opt = + Url.Current.get() + |> Option.map(url => + url |> get_arguments |> List.find_opt(((k, _)) => k == name) + ); + switch (q_opt) { + | Some(Some((_, v))) => Some(v) + | _ => None + }; + }; + + let set_param = (name: string, value: string) => { + Url.Current.get() + |> Option.iter(url => { + let args = + get_arguments(url) + |> List.filter(((k, _)) => k != name) + |> List.cons((name, value)); + + let new_url = set_arguments(url, args); + let href = Url.string_of_url(new_url); + + Dom_html.window##.history##pushState( + Js.null, + Js.string(""), + Js.some(Js.string(href)), + ); + }); + }; + + let remove_param = (name: string) => + Url.Current.get() + |> Option.iter(url => { + let args = + get_arguments(url) |> List.filter(((k, _)) => k != name); + + let new_url = set_arguments(url, args); + let href = Url.string_of_url(new_url); + + Dom_html.window##.history##pushState( + Js.null, + Js.string(""), + Js.some(Js.string(href)), + ); + }); +}; diff --git a/src/util/StringUtil.re b/src/util/StringUtil.re index a4fedde846..a4b181f1a6 100644 --- a/src/util/StringUtil.re +++ b/src/util/StringUtil.re @@ -63,3 +63,20 @@ let unescape_linebreaks: string => string = Re.Str.global_replace(Re.Str.regexp("\\\\n"), "\n"); let trim_leading = Re.Str.global_replace(Re.Str.regexp("\n[ ]*"), "\n"); + +let compress = (s: string): string => { + let result = + Js_of_ocaml.Js.Unsafe.eval_string("encodeURIComponent(`" ++ s ++ "`)") + |> Js_of_ocaml.Js.to_string; + JsUtil.log(result); + result; +}; + +let decompress = (s: string): option(string) => { + let result = + Js_of_ocaml.Js.Unsafe.eval_string("decodeURIComponent(`" ++ s ++ "`)") + |> Js_of_ocaml.Js.Optdef.to_option + |> Option.map(Js_of_ocaml.Js.to_string); + JsUtil.log(result); + result; +}; diff --git a/src/util/dune b/src/util/dune index f50e6ac0f7..db6b0b8589 100644 --- a/src/util/dune +++ b/src/util/dune @@ -1,6 +1,6 @@ (library (name util) - (libraries re base ptmap bonsai bonsai.web virtual_dom yojson) + (libraries re base ptmap bonsai bonsai.web virtual_dom yojson ezgzip) (js_of_ocaml) (instrumentation (backend bisect_ppx)) From 968b46d36265c2a6d850ebbd87cb2a383b626f1e Mon Sep 17 00:00:00 2001 From: Gregory Croisdale Date: Wed, 11 Dec 2024 16:30:20 -0500 Subject: [PATCH 2/2] for now, rely on text backup --- src/haz3lcore/zipper/PersistentZipper.re | 4 ++++ src/haz3lcore/zipper/Zipper.re | 2 ++ src/haz3lweb/Store.re | 12 +++++------- src/haz3lweb/Update.re | 7 ++----- src/util/StringUtil.re | 13 +++++-------- src/util/dune | 2 +- 6 files changed, 19 insertions(+), 21 deletions(-) diff --git a/src/haz3lcore/zipper/PersistentZipper.re b/src/haz3lcore/zipper/PersistentZipper.re index a1bbc094d2..80d40b04d1 100644 --- a/src/haz3lcore/zipper/PersistentZipper.re +++ b/src/haz3lcore/zipper/PersistentZipper.re @@ -13,6 +13,10 @@ let persist = (zipper: Zipper.t) => { }; }; +let persist_text_only = (s: string) => { + {zipper: "", backup_text: s}; +}; + let unpersist = (persisted: t) => try(Sexplib.Sexp.of_string(persisted.zipper) |> Zipper.t_of_sexp) { | _ => diff --git a/src/haz3lcore/zipper/Zipper.re b/src/haz3lcore/zipper/Zipper.re index f87fb964e6..7bc34b5ae8 100644 --- a/src/haz3lcore/zipper/Zipper.re +++ b/src/haz3lcore/zipper/Zipper.re @@ -311,6 +311,8 @@ let serialize = (z: t): string => { sexp_of_t(z) |> Sexplib.Sexp.to_string; }; +let to_sexp = (z: t): Sexplib.Sexp.t => sexp_of_t(z); + let deserialize = (data: string): t => { Sexplib.Sexp.of_string(data) |> t_of_sexp; }; diff --git a/src/haz3lweb/Store.re b/src/haz3lweb/Store.re index 3ac6b2f2ba..ab08fbb9bc 100644 --- a/src/haz3lweb/Store.re +++ b/src/haz3lweb/Store.re @@ -164,13 +164,11 @@ module Scratch = { let load = (~settings: CoreSettings.t): t => { switch (JsUtil.QueryParams.get_param("scratch")) { | Some(data) => - switch (decompress(data)) { - | None => init(~settings) - | Some(data) => - try(deserialize(data, ~settings)) { - | _ => init(~settings) - } - } + let zip = decompress(data); + of_persistent( + ~settings, + (0, [PersistentZipper.persist_text_only(zip)], []), + ); | None => switch (JsUtil.get_localstore(save_scratch_key)) { | None => init(~settings) diff --git a/src/haz3lweb/Update.re b/src/haz3lweb/Update.re index 40b62ba51c..4fbc91c5ca 100644 --- a/src/haz3lweb/Update.re +++ b/src/haz3lweb/Update.re @@ -468,11 +468,8 @@ let apply = (model: Model.t, update: t, ~schedule_action): Result.t(Model.t) => | Export(EncodeScratchSlide) => Model.save(model); let editor = Editors.get_editor(model.editors); - let json_data = ScratchSlide.export(editor); - let compressed = - StringUtil.compress(json_data |> Yojson.Safe.to_string); - JsUtil.log(json_data); - JsUtil.log(compressed); + let printed = Printer.to_string_basic(editor.state.zipper); + let compressed = StringUtil.compress(printed); JsUtil.QueryParams.set_param("scratch", compressed); Ok(model); | Export(ExerciseModule) => diff --git a/src/util/StringUtil.re b/src/util/StringUtil.re index a4b181f1a6..f572a5070b 100644 --- a/src/util/StringUtil.re +++ b/src/util/StringUtil.re @@ -65,18 +65,15 @@ let unescape_linebreaks: string => string = let trim_leading = Re.Str.global_replace(Re.Str.regexp("\n[ ]*"), "\n"); let compress = (s: string): string => { + let js_string = "encodeURIComponent(`" ++ s ++ "`)"; let result = - Js_of_ocaml.Js.Unsafe.eval_string("encodeURIComponent(`" ++ s ++ "`)") - |> Js_of_ocaml.Js.to_string; - JsUtil.log(result); + Js_of_ocaml.Js.Unsafe.eval_string(js_string) |> Js_of_ocaml.Js.to_string; result; }; -let decompress = (s: string): option(string) => { +let decompress = (s: string): string => { + let js_string = "decodeURIComponent(`" ++ s ++ "`)"; let result = - Js_of_ocaml.Js.Unsafe.eval_string("decodeURIComponent(`" ++ s ++ "`)") - |> Js_of_ocaml.Js.Optdef.to_option - |> Option.map(Js_of_ocaml.Js.to_string); - JsUtil.log(result); + Js_of_ocaml.Js.Unsafe.eval_string(js_string) |> Js_of_ocaml.Js.to_string; result; }; diff --git a/src/util/dune b/src/util/dune index db6b0b8589..f50e6ac0f7 100644 --- a/src/util/dune +++ b/src/util/dune @@ -1,6 +1,6 @@ (library (name util) - (libraries re base ptmap bonsai bonsai.web virtual_dom yojson ezgzip) + (libraries re base ptmap bonsai bonsai.web virtual_dom yojson) (js_of_ocaml) (instrumentation (backend bisect_ppx))