create global undo

src/haz3lweb/Main.re

@@ -83,7 +83,7 @@ let apply =
 let start = {
   let%sub save_scheduler = BonsaiUtil.Alarm.alarm;
   let%sub (app_model, app_inject) =
-    Bonsai.state_machine1(
+    BonsaiUndo.state_machine_with_undo(
       (module Page.Model),
       (module Page.Update),
       ~apply_action=
@@ -98,6 +98,7 @@ let start = {
           apply(~schedule_action, ~schedule_autosave);
         },
       ~default_model=Page.Store.load(),
+      ~can_undo=Page.Update.can_undo,
       save_scheduler,
     );
 

src/haz3lweb/Settings.re

@@ -93,6 +93,13 @@ module Update = {
     | Evaluation(evaluation)
     | ExplainThis(ExplainThisModel.Settings.action);
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | Evaluation(ShowSettings) => false
+    | _ => true
+    };
+  };
+
   let update = (action, settings: Model.t): Updated.t(Model.t) => {
     (
       switch (action) {

src/haz3lweb/app/editors/Editors.re

@@ -75,6 +75,14 @@ module Update = {
     // Exercises
     | Exercises(ExercisesMode.Update.t);
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | SwitchMode(_) => true
+    | Scratch(action) => ScratchMode.Update.can_undo(action)
+    | Exercises(action) => ExercisesMode.Update.can_undo(action)
+    };
+  };
+
   let update = (~globals: Globals.t, ~schedule_action, action, model: Model.t) => {
     switch (action, model) {
     | (Scratch(action), Scratch(m)) =>

src/haz3lweb/app/editors/cell/CellEditor.re

@@ -35,6 +35,13 @@ module Update = {
     | MainEditor(CodeEditable.Update.t)
     | ResultAction(EvalResult.Update.t);
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | MainEditor(action) => CodeEditable.Update.can_undo(action)
+    | ResultAction(action) => EvalResult.Update.can_undo(action)
+    };
+  };
+
   let update = (~settings, action, model: Model.t) => {
     switch (action) {
     | MainEditor(action) =>

src/haz3lweb/app/editors/code/CodeEditable.re

@@ -20,6 +20,16 @@ module Update = {
 
   exception CantReset;
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | Perform(action) => Action.is_historic(action)
+    | Undo => false
+    | Redo => false
+    | TAB => true
+    | DebugConsole(_) => false
+    };
+  };
+
   let update =
       (~settings: Settings.t, action: t, model: Model.t): Updated.t(Model.t) => {
     let perform = (action, model: Model.t) =>

src/haz3lweb/app/editors/code/CodeSelectable.re

@@ -16,6 +16,16 @@ module Update = {
     | Unselect(option(Util.Direction.t))
     | Copy;
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | Move(move) => Action.is_historic(Move(move))
+    | Jump(target) => Action.is_historic(Jump(target))
+    | Select(select) => Action.is_historic(Select(select))
+    | Unselect(dir) => Action.is_historic(Unselect(dir))
+    | Copy => false
+    };
+  };
+
   let update = (~settings, action: t, model: Model.t): Updated.t(Model.t) => {
     let action': CodeEditable.Update.t =
       switch (action) {

src/haz3lweb/app/editors/mode/ExercisesMode.re

@@ -182,6 +182,16 @@ module Update = {
     | ExportTransitionary
     | ExportGrading;
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | SwitchExercise(_) => true
+    | Exercise(action) => ExerciseMode.Update.can_undo(action)
+    | ExportModule => false
+    | ExportSubmission => false
+    | ExportTransitionary => false
+    | ExportGrading => false
+    };
+  };
   let export_exercise_module = (exercises: Model.t): unit => {
     let exercise = Model.get_current(exercises);
     let module_name = exercise.editors.module_name;

src/haz3lweb/app/editors/result/EvalResult.re

@@ -100,6 +100,15 @@ module Update = {
     | EvalEditorAction(CodeSelectable.Update.t)
     | UpdateResult(Haz3lcore.ProgramResult.t(Haz3lcore.ProgramResult.inner));
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | ToggleStepper => true
+    | StepperAction(action) => StepperView.Update.can_undo(action)
+    | EvalEditorAction(action) => CodeSelectable.Update.can_undo(action)
+    | UpdateResult(_) => false
+    };
+  };
+
   // Update is meant to make minimal changes to the model, and calculate will do the rest.
   let update = (~settings, action, model: Model.t): Updated.t(Model.t) =>
     switch (action, model) {

src/haz3lweb/app/editors/result/StepperEditor.re

@@ -30,6 +30,8 @@ module Update = {
     };
   };
 
+  let can_undo = CodeSelectable.Update.can_undo;
+
   let calculate =
       (
         ~settings,

src/haz3lweb/app/globals/Globals.re

@@ -88,6 +88,22 @@ module Update = {
     ...model,
     color_highlights,
   };
+
+  let can_undo = (action: t) => {
+    switch (action) {
+    | SetMousedown(_) => false
+    | SetShowBackpackTargets(_) => false
+    | SetFontMetrics(_) => false
+    | Set(action) => Settings.Update.can_undo(action)
+    | JumpToTile(_) => false
+    | InitImportAll(_) => true
+    | FinishImportAll(_) => true
+    | ExportPersistentData => false
+    | ActiveEditor(_) => false
+    | Undo => false
+    | Redo => false
+    };
+  };
 };
 
 type t = Model.t;

src/haz3lweb/explainthis/ExplainThisUpdate.re

@@ -9,6 +9,15 @@ type update =
   | ToggleExampleFeedback(group_id, form_id, example_id, feedback_option)
   | UpdateGroupSelection(group_id, form_id);
 
+let can_undo = (action: update) => {
+  switch (action) {
+  | SpecificityOpen(_) => false
+  | ToggleExplanationFeedback(_) => false
+  | ToggleExampleFeedback(_) => false
+  | UpdateGroupSelection(_) => false
+  };
+};
+
 let set_update =
     (explainThisModel: ExplainThisModel.t, u: update)
     : Updated.t(ExplainThisModel.t) => {

src/haz3lweb/view/ExerciseMode.re

@@ -56,6 +56,14 @@ module Update = {
     | ResetEditor(Exercise.pos)
     | ResetExercise;
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | Editor(_, action) => CellEditor.Update.can_undo(action)
+    | ResetEditor(_) => true
+    | ResetExercise => true
+    };
+  };
+
   let update =
       (~settings: Settings.t, ~schedule_action as _, action, model: Model.t)
       : Updated.t(Model.t) => {

src/haz3lweb/view/Page.re

@@ -67,6 +67,8 @@ module Update = {
     | Start
     | Save;
 
+  let equal = (===);
+
   let update_global =
       (
         ~import_log,
@@ -248,6 +250,18 @@ module Update = {
     };
   };
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | Globals(action) => Globals.Update.can_undo(action)
+    | Editors(action) => Editors.Update.can_undo(action)
+    | ExplainThis(action) => ExplainThisUpdate.can_undo(action)
+    | MakeActive(_) => false
+    | Benchmark(_) => false
+    | Start => false
+    | Save => false
+    };
+  };
+
   let calculate = (~schedule_action, ~is_edited, model: Model.t) => {
     let editors =
       Editors.Update.calculate(
@@ -409,6 +423,15 @@ module View = {
                 ++ Keyboard.meta(Os.is_mac^ ? Mac : PC)
                 ++ " + k)",
             ),
+            {
+              let undo = BonsaiUndo.UndoController.get_undo();
+              button_d(
+                Icons.undo,
+                ~disabled=undo == None,
+                undo |> Option.value(~default=Effect.Ignore),
+                ~tooltip="Undo (Test)",
+              );
+            },
             link(
               Icons.github,
               "https://github.com/hazelgrove/hazel",

src/haz3lweb/view/ScratchMode.re

@@ -73,6 +73,17 @@ module Update = {
     | FinishImportScratchpad(option(string))
     | Export;
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | CellAction(action) => CellEditor.Update.can_undo(action)
+    | SwitchSlide(_) => true
+    | ResetCurrent => true
+    | InitImportScratchpad(_) => true
+    | FinishImportScratchpad(_) => false
+    | Export => false
+    };
+  };
+
   let export_scratch_slide = (model: Model.t): unit => {
     Store.save(model |> Model.persist);
     let data = Store.export();

src/haz3lweb/view/StepperView.re

@@ -98,6 +98,14 @@ module Update = {
     | StepForward(int)
     | StepBackward;
 
+  let can_undo = (action: t) => {
+    switch (action) {
+    | StepperEditor(_, action) => StepperEditor.Update.can_undo(action)
+    | StepForward(_) => true
+    | StepBackward => true
+    };
+  };
+
   let update = (~settings, action: t, model: Model.t): Updated.t(Model.t) => {
     switch (action) {
     | StepForward(idx) =>

src/util/Aba.re

@@ -1,7 +1,7 @@
 open Sexplib.Std;
 open Ppx_yojson_conv_lib.Yojson_conv;
 // invariant: List.length(as) == List.length(bs) + 1
-[@deriving (show({with_path: false}), sexp, yojson)]
+[@deriving (show({with_path: false}), sexp, yojson, eq)]
 type t('a, 'b) = (list('a), list('b));
 
 let mk = (as_: list('a), bs: list('b)): t('a, 'b) => {
@@ -79,6 +79,14 @@ let map_hd = (f_a: 'a => 'a, (as_, bs): t('a, 'b)): t('a, 'b) => (
   bs,
 );
 
+let pop = ((as_, bs): t('a, 'b)): option(('a, 'b, t('a, 'b))) =>
+  switch (bs) {
+  | [] => None
+  | [b, ...bs] =>
+    let (a, as_) = ListUtil.split_first(as_);
+    Some((a, b, mk(as_, bs)));
+  };
+
 let trim = ((as_, bs): t('a, 'b)): option(('a, t('b, 'a), 'a)) =>
   switch (bs) {
   | [] => None