gazagnaire.org
SQL frontend over the catalog engine
1type output =
2 | Rows of string list option * string list list
3 | Status of string
4 | Note of string
5 | Raw of string
6
7module type BACKEND = sig
8 type t
9
10 val exec : t -> string -> (output list, string) result
11 val tables : t -> (string * int) list
12 val dot : t -> string -> string option
13 val help : string
14 val banner : t -> string
15end
16
17(* The shell closes over its backend's operations at construction, so the flat
18 accessors below work on any [t] without naming the backend module. *)
19type t = {
20 exec : string -> (output list, string) result;
21 tables : unit -> (string * int) list;
22 dot : string -> string option;
23 help : string;
24 banner : string;
25 styled : bool;
26 ctx : Console.Display.ctx;
27 emit : string -> unit;
28 emit_err : string -> unit; (* statement errors; defaults to [emit] *)
29 buf : Buffer.t; (* accumulates one (possibly multi-line) statement *)
30}
31
32let paint t style s =
33 if t.styled then Fmt.str "%a" (Console.Style.styled style Fmt.string) s else s
34
35let ok t = paint t Console.Style.(fg Console.Color.green)
36let error t = paint t Console.Style.(fg Console.Color.red)
37let dim t = paint t Console.Style.faint
38
39let prompt t ~cont =
40 if t.styled then
41 t.emit
42 (paint t
43 Console.Style.(fg Console.Color.cyan)
44 (if cont then " ...> " else "sql> "))
45
46let plural n = if n = 1 then "" else "s"
47
48let render_rows t headers rows =
49 match rows with
50 | [] -> t.emit (dim t "(no rows)\n")
51 | first :: _ ->
52 let width = List.length first in
53 let headers =
54 match headers with
55 | Some h when List.length h = width -> h
56 | _ -> List.init width (fun i -> Fmt.str "c%d" (i + 1))
57 in
58 let table =
59 List.fold_left
60 (fun tbl row -> Console.Table.add_row_strings row tbl)
61 (Console.Table.v (List.map Console.Table.column headers))
62 rows
63 in
64 t.emit (Console.Table.to_string ~ctx:t.ctx table);
65 let n = List.length rows in
66 t.emit (dim t (Fmt.str "%d row%s\n" n (plural n)))
67
68let render_output t = function
69 | Rows (headers, rows) -> render_rows t headers rows
70 | Status status -> t.emit (ok t (Fmt.str "ok %s\n" status))
71 | Note note -> t.emit (dim t (note ^ "\n"))
72 | Raw line -> t.emit (line ^ "\n")
73
74let run_statement t sql =
75 match t.exec sql with
76 | Ok outputs -> List.iter (render_output t) outputs
77 | Error msg -> t.emit_err (error t (Fmt.str "error: %s\n" msg))
78
79let run_tables t =
80 match t.tables () with
81 | [] -> t.emit (dim t "(no tables)\n")
82 | tables ->
83 List.iter
84 (fun (name, n) ->
85 t.emit
86 (Fmt.str "%s %s\n" name (dim t (Fmt.str "(%d row%s)" n (plural n)))))
87 tables
88
89let run_help t =
90 t.emit
91 (Fmt.str
92 "SQL statements end with ';'.\n\
93 .tables list tables\n\
94 .help show this help\n\
95 .quit leave (or Ctrl-D)\n\
96 %s"
97 t.help)
98
99let run_dot t cmd =
100 match cmd with
101 | "tables" -> run_tables t
102 | "help" -> run_help t
103 | other -> (
104 match t.dot other with
105 | Some out -> t.emit out
106 | None ->
107 t.emit (error t (Fmt.str "unknown command .%s (try .help)\n" other)))
108
109let feed_line t line =
110 let trimmed = String.trim line in
111 let nonempty = String.length trimmed > 0 in
112 let pending = Buffer.length t.buf > 0 in
113 if (not pending) && nonempty && Char.equal trimmed.[0] '.' then (
114 match String.sub trimmed 1 (String.length trimmed - 1) with
115 | "quit" | "exit" -> `Quit
116 | cmd ->
117 run_dot t cmd;
118 prompt t ~cont:false;
119 `Continue)
120 else if (not pending) && not nonempty then (
121 prompt t ~cont:false;
122 `Continue)
123 else (
124 Buffer.add_string t.buf line;
125 Buffer.add_char t.buf '\n';
126 let complete =
127 nonempty && Char.equal trimmed.[String.length trimmed - 1] ';'
128 in
129 if complete then (
130 let sql = Buffer.contents t.buf in
131 Buffer.clear t.buf;
132 run_statement t sql;
133 prompt t ~cont:false)
134 else prompt t ~cont:true;
135 `Continue)
136
137let feed_statement t sql =
138 let trimmed = String.trim sql in
139 let sql =
140 if
141 String.length trimmed > 0
142 && Char.equal trimmed.[String.length trimmed - 1] ';'
143 then sql
144 else sql ^ ";"
145 in
146 List.iter
147 (fun line -> ignore (feed_line t line : [ `Continue | `Quit ]))
148 (String.split_on_char '\n' sql)
149
150let start t =
151 t.emit t.banner;
152 t.emit "\n";
153 prompt t ~cont:false
154
155module Make (B : BACKEND) = struct
156 let v backend ?emit_err ~styled ~ctx ~emit () =
157 {
158 exec = B.exec backend;
159 tables = (fun () -> B.tables backend);
160 dot = B.dot backend;
161 help = B.help;
162 banner = B.banner backend;
163 styled;
164 ctx;
165 emit;
166 emit_err = (match emit_err with Some f -> f | None -> emit);
167 buf = Buffer.create 64;
168 }
169end