From 8f34f5a0631d90eac58d6a1cd44adf6bfa1048b1 Mon Sep 17 00:00:00 2001 From: gandarfh Date: Tue, 16 Jun 2026 15:18:03 -0300 Subject: [PATCH] feat(sql): schema-aware completion for db blocks via the LSP --- bin/httui-lsp/httui_lsp.ml | 29 ++++++++- bin/httui-lsp/sql_schema_store.ml | 49 +++++++++++++++ lib/sql.ml | 100 ++++++++++++++++++++++++++++++ test/test_httui_lang.ml | 48 ++++++++++++++ 4 files changed, 225 insertions(+), 1 deletion(-) create mode 100644 bin/httui-lsp/sql_schema_store.ml diff --git a/bin/httui-lsp/httui_lsp.ml b/bin/httui-lsp/httui_lsp.ml index 561c997..c3c2172 100644 --- a/bin/httui-lsp/httui_lsp.ml +++ b/bin/httui-lsp/httui_lsp.ml @@ -269,12 +269,34 @@ let on_hover (r : Jsonrpc.Request.t) = in respond r.id (T.Hover.yojson_of_t hover)) +(* Schema-aware completion inside a ```db-* block (when the cursor is not in a + `{{ref}}`). The connection id is the fence suffix; the column schema comes + from the app's introspection cache. *) +let sql_completion_items blocks ~offset = + let starts_with pre s = + String.length s >= String.length pre + && String.sub s 0 (String.length pre) = pre + in + match Httui_lang.Analyze.block_index_at blocks ~offset with + | Some (_, b) when starts_with "db-" b.Httui_lang.Block.lang -> + let connection_id = String.sub b.lang 3 (String.length b.lang - 3) in + let tables = Sql_schema_store.tables_for ~connection_id in + Httui_lang.Sql.complete ~tables ~text:b.content + ~offset:(offset - b.content_offset) + |> List.map (fun (c : Httui_lang.Sql.completion) -> + T.CompletionItem.create ~label:c.label + ~kind: + (if c.is_table then T.CompletionItemKind.Class + else T.CompletionItemKind.Field) + ?detail:c.detail ()) + | _ -> [] + let on_completion (r : Jsonrpc.Request.t) = let p = T.CompletionParams.t_of_yojson (params_json r.params) in with_doc r.id p.textDocument.uri (fun text -> let blocks = Httui_lang.Fence_scanner.scan text in let offset = offset_of_position text p.position in - let items = + let ref_items = Httui_lang.Analyze.completion_at ~env_keys: (Env_store.keys_for @@ -298,6 +320,11 @@ let on_completion (r : Jsonrpc.Request.t) = T.CompletionItem.create ~label:it.label ~kind:T.CompletionItemKind.Variable ~detail:"block alias" ()) in + (* Outside a `{{ref}}`, a db-* block offers schema-aware SQL completion. *) + let items = + if ref_items <> [] then ref_items + else sql_completion_items blocks ~offset + in respond r.id (`List (List.map T.CompletionItem.yojson_of_t items))) (* Encode tokens to the LSP delta-position int stream. Tokens arrive diff --git a/bin/httui-lsp/sql_schema_store.ml b/bin/httui-lsp/sql_schema_store.ml new file mode 100644 index 0000000..b35a328 --- /dev/null +++ b/bin/httui-lsp/sql_schema_store.ml @@ -0,0 +1,49 @@ +(* Read-only access to the cached DB column schema (tables → columns → type) + the app introspects per connection. Powers schema-aware SQL completion in + ```db-* blocks. Keyed by connection_id — the suffix of the `db-` + fence info string. Reads degrade gracefully: no database / read error / + cold cache all yield [[]] and completion simply offers no tables. *) + +(* Returns [Httui_lang.Sql.table]s directly so the completion function can + consume them without an adapter. *) +module S = Httui_lang.Sql + +let schema_query = + let open Caqti_request.Infix in + (Caqti_type.string + ->* Caqti_type.(t4 (option string) string string (option string))) + "SELECT schema_name, table_name, column_name, data_type FROM schema_cache \ + WHERE connection_id = ? ORDER BY schema_name IS NULL, schema_name, \ + table_name, column_name" + +(* Group the column rows (ordered by schema then table) into table records. + A new table starts whenever (schema_name, table_name) changes. *) +let group_rows rows = + let finish schema name cols = S.{ schema; name; columns = List.rev cols } in + let rec go acc current = function + | [] -> ( + match current with + | None -> List.rev acc + | Some (schema, name, cols) -> List.rev (finish schema name cols :: acc) + ) + | (schema, table_name, column_name, data_type) :: rest -> ( + let col = S.{ name = column_name; data_type } in + match current with + | Some (cs, cn, cols) when cs = schema && cn = table_name -> + go acc (Some (cs, cn, col :: cols)) rest + | Some (cs, cn, cols) -> + go (finish cs cn cols :: acc) + (Some (schema, table_name, [ col ])) + rest + | None -> go acc (Some (schema, table_name, [ col ])) rest) + in + go [] None rows + +let tables_for ~connection_id = + match Db_conn.connect () with + | None -> [] + | Some conn -> ( + let module C = (val conn : Caqti_blocking.CONNECTION) in + match C.collect_list schema_query connection_id with + | Error _ -> [] + | Ok rows -> group_rows rows) diff --git a/lib/sql.ml b/lib/sql.ml index adf68d6..c076e82 100644 --- a/lib/sql.ml +++ b/lib/sql.ml @@ -43,3 +43,103 @@ let walk ?(base = 0) source = confirm the grammar resolves the expected structure. *) let kinds source = walk source |> List.map (fun n -> n.kind) |> List.sort_uniq compare + +(* --- schema-aware completion --------------------------------------------- *) + +(* Column/table schema supplied by the caller (the LSP reads it from the + app's introspection cache). Kept here so completion stays a pure, + testable function over a known schema. *) +type column = { name : string; data_type : string option } +type table = { schema : string option; name : string; columns : column list } +type completion = { label : string; detail : string option; is_table : bool } + +let is_word_char c = + (c >= 'a' && c <= 'z') + || (c >= 'A' && c <= 'Z') + || (c >= '0' && c <= '9') + || c = '_' + +(* Identifier ending exactly at [stop] (exclusive), scanning back over word + chars. Returns its start, or [stop] when there is none. *) +let word_start text stop = + let i = ref stop in + while !i > 0 && is_word_char text.[!i - 1] do + decr i + done; + !i + +(* The last keyword_* token that ends at or before [limit]. Lexical via the + CST so a half-typed tail (`SELECT … FROM `) still classifies. *) +let last_keyword_before text limit = + walk text + |> List.filter (fun n -> + n.stop_ <= limit + && String.length n.kind >= 8 + && String.sub n.kind 0 8 = "keyword_") + |> List.fold_left + (fun best n -> + match best with Some b when b.stop_ >= n.stop_ -> best | _ -> Some n) + None + |> Option.map (fun n -> String.sub n.kind 8 (String.length n.kind - 8)) + +let table_completion (t : table) = + { + label = t.name; + detail = + (match t.schema with Some s -> Some (s ^ " schema") | None -> None); + is_table = true; + } + +let column_completions (t : table) = + List.map + (fun (c : column) -> + { + label = c.name; + detail = + (match c.data_type with + | Some d -> Some (t.name ^ "." ^ c.name ^ " : " ^ d) + | None -> Some t.name); + is_table = false; + }) + t.columns + +(* Context-aware completions at byte [offset] in SQL [text]: + - after a `table.` qualifier -> that table's columns + - after FROM/JOIN/INTO/UPDATE/TABLE -> table names + - otherwise -> columns of every table + table names + The partial word under the cursor is matched as a case-insensitive prefix. *) +let complete ~(tables : table list) ~text ~offset = + let offset = max 0 (min offset (String.length text)) in + let ws = word_start text offset in + let prefix = String.lowercase_ascii (String.sub text ws (offset - ws)) in + (* `table.` qualifier: a dot immediately before the partial word, preceded + by an identifier naming a table. *) + let qualifier = + if ws > 0 && text.[ws - 1] = '.' then + let qs = word_start text (ws - 1) in + if qs < ws - 1 then + let q = String.lowercase_ascii (String.sub text qs (ws - 1 - qs)) in + List.find_opt + (fun (t : table) -> String.lowercase_ascii t.name = q) + tables + else None + else None + in + let raw = + match qualifier with + | Some t -> column_completions t + | None -> ( + match last_keyword_before text ws with + | Some ("from" | "join" | "into" | "update" | "table") -> + List.map table_completion tables + | _ -> + List.concat_map column_completions tables + @ List.map table_completion tables) + in + List.filter + (fun c -> + String.length prefix = 0 + || String.length c.label >= String.length prefix + && String.lowercase_ascii (String.sub c.label 0 (String.length prefix)) + = prefix) + raw diff --git a/test/test_httui_lang.ml b/test/test_httui_lang.ml index f52283d..bb50343 100644 --- a/test/test_httui_lang.ml +++ b/test/test_httui_lang.ml @@ -721,4 +721,52 @@ let () = check "http block emits no sql tokens" (not (has_sql_kind toks Httui_lang.Semantic_tokens.Sql_keyword)); + (* --- schema-aware SQL completion --- *) + let sql_tables = + Httui_lang.Sql. + [ + { + schema = None; + name = "users"; + columns = + [ + { name = "id"; data_type = Some "integer" }; + { name = "email"; data_type = Some "text" }; + ]; + }; + { + schema = None; + name = "orders"; + columns = [ { name = "total"; data_type = Some "numeric" } ]; + }; + ] + in + let complete text = + Httui_lang.Sql.complete ~tables:sql_tables ~text + ~offset:(String.length text) + in + let labels cs = + List.map (fun (c : Httui_lang.Sql.completion) -> c.label) cs + |> List.sort compare + in + check "completion after FROM offers table names" + (labels (complete "SELECT * FROM ") = [ "orders"; "users" ]); + check "completion after FROM filters by prefix" + (labels (complete "SELECT * FROM us") = [ "users" ]); + check "completion after WHERE offers columns" + (let cs = labels (complete "SELECT * FROM users WHERE ") in + List.mem "email" cs && List.mem "id" cs && List.mem "total" cs); + check "completion after table-dot offers that table's columns" + (labels (complete "SELECT users.") = [ "email"; "id" ]); + check "column completion detail carries the type" + (List.exists + (fun (c : Httui_lang.Sql.completion) -> + c.label = "email" + && match c.detail with Some d -> has_sub d "text" | None -> false) + (complete "SELECT * FROM users WHERE ")); + check "table completion is flagged is_table" + (List.for_all + (fun (c : Httui_lang.Sql.completion) -> c.is_table) + (complete "SELECT * FROM ")); + if !failures > 0 then exit 1