1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
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
|