1 files changed, 178 insertions, 0 deletions

diff --git a/bin/repl_cmd.ml b/bin/repl_cmd.ml
new file mode 100644
index 0000000..9ebeae7
--- /dev/null
+++ b/bin/repl_cmd.ml
@@ -0,0 +1,178 @@
+open Core
+open Option.Let_syntax
+
+let join_str_list ~sep = function
+  | [] -> ""
+  | s :: ss -> List.fold ss ~init:s ~f:(fun acc s -> acc ^ sep ^ s)
+
+type cmd = {
+  args : string;
+  opts : unit -> string list;
+  next : (string -> (string, cmd) Either.t) option;
+  call : string list -> bool;
+}
+
+let set_opt_cmd opt setting =
+  {
+    args = "<option value>";
+    opts = (fun () -> Settings.allowed_values setting);
+    next = None;
+    call =
+      (fun args ->
+        match Settings.set_to setting args with
+        | None -> true
+        | Some msg ->
+            printf "Failed to set option %s: %s\n%!" opt msg;
+            false);
+  }
+
+let set_cmd =
+  {
+    args = "<option name> <option value>";
+    opts = (fun () -> Map.keys Settings.settings);
+    next =
+      Some
+        (fun opt ->
+          match Map.find Settings.settings opt with
+          | Some setting -> Second (set_opt_cmd opt setting)
+          | None -> First (sprintf "Unknown option '%s'" opt));
+    call =
+      (fun _ ->
+        printf "Missing option argument value\n%!";
+        false);
+  }
+
+let settings_cmd =
+  {
+    args = "";
+    opts = (fun () -> []);
+    next = None;
+    call =
+      (function
+      | [] ->
+          Settings.print ();
+          true
+      | _ ->
+          printf "Expected no arguments\n%!";
+          false);
+  }
+
+let run_cmd =
+  {
+    args = "<filename>";
+    opts = (fun () -> []);
+    next = None;
+    call =
+      (function
+      | [ filename ] -> Run.eval_file filename
+      | _ ->
+          printf "Expected one argument (the filename)\n%!";
+          false);
+  }
+
+let quit_cmd =
+  { args = ""; opts = (fun () -> []); next = None; call = (fun _ -> exit 0) }
+
+let commands =
+  Map.of_alist_exn
+    (module String)
+    [
+      ("quit", quit_cmd);
+      ("set", set_cmd);
+      ("settings", settings_cmd);
+      ("run", run_cmd);
+    ]
+
+let root_cmd =
+  {
+    args = "<command>";
+    opts = (fun () -> Map.keys commands);
+    next =
+      Some
+        (fun cmd_name ->
+          match Map.find commands cmd_name with
+          | Some cmd -> Second cmd
+          | None ->
+              First
+                (sprintf "Unknown command '%s' (expected one of {%s})" cmd_name
+                   (Map.keys commands |> join_str_list ~sep:", ")));
+    call =
+      (fun _ ->
+        printf "Missing command!\n%!";
+        false);
+  }
+
+let is_space = Char.( = ) ' '
+let strip_space = String.strip ~drop:is_space
+let lstrip_space = String.lstrip ~drop:is_space
+
+let clean_str_list ss =
+  ss |> List.map ~f:strip_space
+  |> List.filter ~f:(fun s -> not (String.is_empty s))
+
+let words s = s |> String.split ~on:' ' |> clean_str_list
+let unwords ss = clean_str_list ss |> join_str_list ~sep:" "
+
+let rec call cmd args =
+  match args with
+  | [] -> cmd.call []
+  | arg0 :: argn -> (
+      match cmd.next with
+      | None -> cmd.call args
+      | Some next -> (
+          match next arg0 with
+          | First msg ->
+              printf "%s\n%!" msg;
+              false
+          | Second cmd' -> call cmd' argn))
+
+let try_lsplit2_space s =
+  match String.lsplit2 s ~on:' ' with Some (l, r) -> (l, r) | None -> (s, "")
+
+let lsplit2_space' s =
+  let%bind l, r = String.lsplit2 s ~on:' ' in
+  (* s = l ^ " " ^ r *)
+  let r' = lstrip_space r in
+  let space = " " ^ String.chop_suffix_exn r ~suffix:r' in
+  (* s = l ^ space ^ r' *)
+  return (l, space, r')
+
+let rec completions cmd args =
+  (* cmd|<TAB> -> options
+     cmd|abc<TAB> -> options with prefix 'abc'
+     cmd|abc .*<TAB> -> subcommand 'abc' options, pass .* *)
+  if String.(args = "") then cmd.opts ()
+  else
+    match lsplit2_space' args with
+    | None -> cmd.opts () |> List.filter ~f:(String.is_prefix ~prefix:args)
+    | Some (arg0, space, argn) -> (
+        match cmd.next with
+        | None -> []
+        | Some next -> (
+            match next arg0 with
+            | First _ -> []
+            | Second cmd' ->
+                completions cmd' argn
+                |> List.map ~f:(String.append (arg0 ^ space))))
+
+let rec hints cmd args =
+  (* cmd: "" -> " <args>"
+     cmd: "<space>+" -> "<args>"
+     cmd: "<space>+<subcmd>" -> "<hints for subcmd>"
+     cmd: "<space>+<subcmd> .*" -> "<hints for subcmd with .*>" *)
+  if String.(args = "") then Some (" " ^ cmd.args)
+  else if String.(strip_space args = "") then Some cmd.args
+  else
+    let args = lstrip_space args in
+    let%bind next = cmd.next in
+    match lsplit2_space' args with
+    | None ->
+        let%bind cmd' = next args |> Either.Second.to_option in
+        hints cmd' ""
+    | Some (arg0, space, argn) ->
+        let%bind cmd' = next arg0 |> Either.Second.to_option in
+        hints cmd' (space ^ argn)
+
+let invoke cmd = call root_cmd (words cmd)
+let complete cmd = completions root_cmd cmd
+let hint cmd = hints root_cmd cmd