Command Palette (#1261)

src/haz3lweb/Keyboard.re

@@ -4,6 +4,229 @@ open Util;
 let is_digit = s => StringUtil.(match(regexp("^[0-9]$"), s));
 let is_f_key = s => StringUtil.(match(regexp("^F[0-9][0-9]*$"), s));
 
+type shortcut = {
+  update_action: option(UpdateAction.t),
+  hotkey: option(string),
+  label: string,
+  mdIcon: option(string),
+  section: option(string),
+};
+
+let meta = (sys: Key.sys): string => {
+  switch (sys) {
+  | Mac => "cmd"
+  | PC => "ctrl"
+  };
+};
+
+let mk_shortcut =
+    (~hotkey=?, ~mdIcon=?, ~section=?, label, update_action): shortcut => {
+  {update_action: Some(update_action), hotkey, label, mdIcon, section};
+};
+
+let instructor_shortcuts: list(shortcut) = [
+  mk_shortcut(
+    ~mdIcon="download",
+    ~section="Export",
+    "Export All Persistent Data",
+    Export(ExportPersistentData),
+  ),
+  mk_shortcut(
+    ~mdIcon="download",
+    ~section="Export",
+    "Export Exercise Module",
+    Export(ExerciseModule) // TODO Would we rather skip contextual stuff for now or include it and have it fail
+  ),
+  mk_shortcut(
+    ~mdIcon="download",
+    ~section="Export",
+    "Export Transitionary Exercise Module",
+    Export(TransitionaryExerciseModule) // TODO Would we rather skip contextual stuff for now or include it and have it fail
+  ),
+  mk_shortcut(
+    ~mdIcon="download",
+    ~section="Export",
+    "Export Grading Exercise Module",
+    Export(GradingExerciseModule) // TODO Would we rather skip contextual stuff for now or include it and have it fail
+  ),
+];
+
+// List of shortcuts configured to show up in the command palette and have hotkey support
+let shortcuts = (sys: Key.sys): list(shortcut) =>
+  [
+    mk_shortcut(~mdIcon="undo", ~hotkey=meta(sys) ++ "+z", "Undo", Undo),
+    mk_shortcut(
+      ~hotkey=meta(sys) ++ "+shift+z",
+      ~mdIcon="redo",
+      "Redo",
+      Redo,
+    ),
+    mk_shortcut(
+      ~hotkey="F12",
+      ~mdIcon="arrow_forward",
+      ~section="Navigation",
+      "Go to Definition",
+      PerformAction(Jump(BindingSiteOfIndicatedVar)),
+    ),
+    mk_shortcut(
+      ~hotkey="shift+tab",
+      ~mdIcon="swipe_left_alt",
+      ~section="Navigation",
+      "Go to Previous Hole",
+      PerformAction(Move(Goal(Piece(Grout, Left)))),
+    ),
+    mk_shortcut(
+      ~mdIcon="swipe_right_alt",
+      ~section="Navigation",
+      "Go To Next Hole",
+      PerformAction(Move(Goal(Piece(Grout, Right)))),
+      // Tab is overloaded so not setting it here
+    ),
+    mk_shortcut(
+      ~hotkey=meta(sys) ++ "+d",
+      ~mdIcon="select_all",
+      ~section="Selection",
+      "Select current term",
+      PerformAction(Select(Term(Current))),
+    ),
+    mk_shortcut(
+      ~hotkey=meta(sys) ++ "+p",
+      ~mdIcon="backpack",
+      "Pick up selected term",
+      PerformAction(Pick_up),
+    ),
+    mk_shortcut(
+      ~mdIcon="select_all",
+      ~hotkey=meta(sys) ++ "+a",
+      ~section="Selection",
+      "Select All",
+      PerformAction(Select(All)),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Statics",
+      UpdateAction.Set(Statics),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Completion",
+      UpdateAction.Set(Assist),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show Whitespace",
+      UpdateAction.Set(SecondaryIcons),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Print Benchmarks",
+      UpdateAction.Set(Benchmark),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Toggle Dynamics",
+      UpdateAction.Set(Dynamics),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show Elaboration",
+      UpdateAction.Set(Elaborate),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show Function Bodies",
+      UpdateAction.Set(Evaluation(ShowFnBodies)),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show Case Clauses",
+      UpdateAction.Set(Evaluation(ShowCaseClauses)),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show fixpoints",
+      UpdateAction.Set(Evaluation(ShowFixpoints)),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show Casts",
+      UpdateAction.Set(Evaluation(ShowCasts)),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show Lookup Steps",
+      UpdateAction.Set(Evaluation(ShowLookups)),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show Stepper Filters",
+      UpdateAction.Set(Evaluation(ShowFilters)),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show Hidden Steps",
+      UpdateAction.Set(Evaluation(ShowHiddenSteps)),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show Docs Sidebar",
+      UpdateAction.Set(ExplainThis(ToggleShow)),
+    ),
+    mk_shortcut(
+      ~section="Settings",
+      ~mdIcon="tune",
+      "Toggle Show Docs Feedback",
+      UpdateAction.Set(ExplainThis(ToggleShowFeedback)),
+    ),
+    mk_shortcut(
+      ~hotkey=meta(sys) ++ "+/",
+      ~mdIcon="assistant",
+      "TyDi Assistant",
+      PerformAction(Buffer(Set(TyDi))) // I haven't figured out how to trigger this in the editor
+    ),
+    mk_shortcut(
+      ~mdIcon="download",
+      ~section="Export",
+      "Export Scratch Slide",
+      Export(ExportScratchSlide),
+    ),
+    mk_shortcut(
+      ~mdIcon="download",
+      ~section="Export",
+      "Export Submission",
+      Export(Submission) // TODO Would we rather skip contextual stuff for now or include it and have it fail
+    ),
+    mk_shortcut(
+      // ctrl+k conflicts with the command palette
+      ~section="Diagnostics",
+      ~mdIcon="refresh",
+      "Reparse Current Editor",
+      PerformAction(Reparse),
+    ),
+    mk_shortcut(
+      ~mdIcon="timer",
+      ~section="Diagnostics",
+      ~hotkey="F7",
+      "Run Benchmark",
+      Benchmark(Start),
+    ),
+  ]
+  @ (if (ExerciseSettings.show_instructor) {instructor_shortcuts} else {[]});
+
 let handle_key_event = (k: Key.t): option(Update.t) => {
   let now = (a: Action.t): option(UpdateAction.t) =>
     Some(PerformAction(a));
@@ -20,7 +243,6 @@ let handle_key_event = (k: Key.t): option(Update.t) => {
   | {key: D(key), sys: _, shift: Down, meta: Up, ctrl: Up, alt: Up}
       when is_f_key(key) =>
     switch (key) {
-    | "F7" => Some(Benchmark(Start))
     | _ => Some(DebugConsole(key))
     }
   | {key: D(key), sys: _, shift, meta: Up, ctrl: Up, alt: Up} =>
@@ -52,8 +274,6 @@ let handle_key_event = (k: Key.t): option(Update.t) => {
     }
   | {key: D(key), sys: Mac, shift: Down, meta: Down, ctrl: Up, alt: Up} =>
     switch (key) {
-    | "Z"
-    | "z" => Some(Redo)
     | "ArrowLeft" => now(Select(Resize(Extreme(Left(ByToken)))))
     | "ArrowRight" => now(Select(Resize(Extreme(Right(ByToken)))))
     | "ArrowUp" => now(Select(Resize(Extreme(Up))))
@@ -62,8 +282,6 @@ let handle_key_event = (k: Key.t): option(Update.t) => {
     }
   | {key: D(key), sys: PC, shift: Down, meta: Up, ctrl: Down, alt: Up} =>
     switch (key) {
-    | "Z"
-    | "z" => Some(Redo)
     | "ArrowLeft" => now(Select(Resize(Local(Left(ByToken)))))
     | "ArrowRight" => now(Select(Resize(Local(Right(ByToken)))))
     | "ArrowUp" => now(Select(Resize(Local(Up))))
@@ -78,7 +296,6 @@ let handle_key_event = (k: Key.t): option(Update.t) => {
     | "d" => now(Select(Term(Current)))
     | "p" => Some(PerformAction(Pick_up))
     | "a" => now(Select(All))
-    | "k" => Some(PerformAction(Reparse))
     | "/" => Some(PerformAction(Buffer(Set(TyDi))))
     | "ArrowLeft" => now(Move(Extreme(Left(ByToken))))
     | "ArrowRight" => now(Move(Extreme(Right(ByToken))))
@@ -92,7 +309,6 @@ let handle_key_event = (k: Key.t): option(Update.t) => {
     | "d" => now(Select(Term(Current)))
     | "p" => Some(PerformAction(Pick_up))
     | "a" => now(Select(All))
-    | "k" => Some(PerformAction(Reparse))
     | "/" => Some(PerformAction(Buffer(Set(TyDi))))
     | "ArrowLeft" => now(Move(Local(Left(ByToken))))
     | "ArrowRight" => now(Move(Local(Right(ByToken))))

src/haz3lweb/Log.re

@@ -8,7 +8,7 @@ let is_action_logged: UpdateAction.t => bool =
   | Save
   | InitImportAll(_)
   | InitImportScratchpad(_)
-  | ExportPersistentData
+  | Export(_)
   | FinishImportAll(_)
   | FinishImportScratchpad(_)
   | Benchmark(_)

src/haz3lweb/Main.re

@@ -83,6 +83,7 @@ module App = {
         schedule_action(Haz3lweb.Update.SetMeta(FontMetrics(fm)))
       );
 
+    NinjaKeys.initialize(NinjaKeys.options(schedule_action));
     JsUtil.focus_clipboard_shim();
 
     /* initialize state. */

src/haz3lweb/NinjaKeys.re

@@ -0,0 +1,57 @@
+open Js_of_ocaml;
+open Util;
+
+/*
+ Configuration of the command palette using the https://github.com/ssleptsov/ninja-keys web component.
+ */
+
+let from_shortcut =
+    (schedule_action: UpdateAction.t => unit, shortcut: Keyboard.shortcut)
+    : {
+        .
+        "handler": Js.readonly_prop(unit => unit),
+        "id": Js.readonly_prop(string),
+        "mdIcon": Js.readonly_prop(Js.optdef(string)),
+        "hotkey": Js.readonly_prop(Js.optdef(string)),
+        "title": Js.readonly_prop(string),
+        "section": Js.readonly_prop(Js.optdef(string)),
+      } => {
+  [%js
+   {
+     val id = shortcut.label;
+     val title = shortcut.label;
+     val mdIcon = Js.Optdef.option(shortcut.mdIcon);
+     val hotkey = Js.Optdef.option(shortcut.hotkey);
+     val section = Js.Optdef.option(shortcut.section);
+     val handler =
+       () => {
+         let foo = shortcut.update_action;
+         switch (foo) {
+         | Some(update) => schedule_action(update)
+         | None =>
+           print_endline("Could not find action for " ++ shortcut.label)
+         };
+       }
+   }];
+};
+
+let options = (schedule_action: UpdateAction.t => unit) => {
+  Array.of_list(
+    List.map(
+      from_shortcut(schedule_action),
+      Keyboard.shortcuts(Os.is_mac^ ? Mac : PC),
+    ),
+  );
+};
+
+let elem = () => JsUtil.get_elem_by_id("ninja-keys");
+
+let initialize = opts => Js.Unsafe.set(elem(), "data", Js.array(opts));
+
+let open_command_palette = (): unit => {
+  Js.Unsafe.meth_call(
+    elem(),
+    "open",
+    [||] // Can't use ##.open because open is a reserved keyword
+  );
+};