gazagnaire.org
SQL frontend over the catalog engine
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(* SQLite's json1 value dialect (json.html). Parsing and validation reuse the
7 {!Json} library (nox-json); this module adds what is sqlite-specific: the
8 minified text serialisation sqlite3 emits (number and string formatting
9 byte-compatible) and [$.a.b[2]] path navigation. The SQL functions in
10 {!Query} build on it. *)
11
12type t =
13 | Null
14 | Bool of bool
15 | Int of int64
16 | Real of string (** the number's text, formatted by {!real} *)
17 | Str of string
18 | Arr of t list
19 | Obj of (string * t) list
20
21exception Error of string
22
23let type_name = function
24 | Null -> "null"
25 | Bool true -> "true"
26 | Bool false -> "false"
27 | Int _ -> "integer"
28 | Real _ -> "real"
29 | Str _ -> "text"
30 | Arr _ -> "array"
31 | Obj _ -> "object"
32
33(* ── Serialisation ───────────────────────────────────────────── *)
34
35(* A real as sqlite3 renders it in JSON: C [%.15g] (shortest within 15
36 significant digits, trailing zeros stripped), then a forced decimal point --
37 "10000000000.0", "1.0e+15", "0.1" -- so it always reads back as a real. *)
38let real_text f =
39 let s = Fmt.str "%.15g" f in
40 match String.index_opt s 'e' with
41 | Some i ->
42 let mant = String.sub s 0 i
43 and ex = String.sub s i (String.length s - i) in
44 let mant = if String.contains mant '.' then mant else mant ^ ".0" in
45 mant ^ ex
46 | None -> if String.contains s '.' then s else s ^ ".0"
47
48(* Build a real node from a SQL double, formatted as sqlite3 would. *)
49let real f = Real (real_text f)
50
51let escape_into buf s =
52 Buffer.add_char buf '"';
53 String.iter
54 (fun c ->
55 match c with
56 | '"' -> Buffer.add_string buf "\\\""
57 | '\\' -> Buffer.add_string buf "\\\\"
58 | '\n' -> Buffer.add_string buf "\\n"
59 | '\r' -> Buffer.add_string buf "\\r"
60 | '\t' -> Buffer.add_string buf "\\t"
61 | '\b' -> Buffer.add_string buf "\\b"
62 | '\012' -> Buffer.add_string buf "\\f"
63 | c when Char.code c < 0x20 ->
64 (* control characters as \u00XX; built directly to avoid a formatter
65 allocation per character *)
66 let hex = "0123456789abcdef" in
67 Buffer.add_string buf "\\u00";
68 Buffer.add_char buf hex.[(Char.code c lsr 4) land 0xf];
69 Buffer.add_char buf hex.[Char.code c land 0xf]
70 | c -> Buffer.add_char buf c)
71 s;
72 Buffer.add_char buf '"'
73
74let to_text j =
75 let buf = Buffer.create 64 in
76 let rec go = function
77 | Null -> Buffer.add_string buf "null"
78 | Bool b -> Buffer.add_string buf (if b then "true" else "false")
79 | Int i -> Buffer.add_string buf (Int64.to_string i)
80 | Real s -> Buffer.add_string buf s
81 | Str s -> escape_into buf s
82 | Arr xs ->
83 Buffer.add_char buf '[';
84 List.iteri
85 (fun i x ->
86 if i > 0 then Buffer.add_char buf ',';
87 go x)
88 xs;
89 Buffer.add_char buf ']'
90 | Obj kvs ->
91 Buffer.add_char buf '{';
92 List.iteri
93 (fun i (k, v) ->
94 if i > 0 then Buffer.add_char buf ',';
95 escape_into buf k;
96 Buffer.add_char buf ':';
97 go v)
98 kvs;
99 Buffer.add_char buf '}'
100 in
101 go j;
102 Buffer.contents buf
103
104let pp ppf j = Fmt.string ppf (to_text j)
105
106(* ── Parsing (delegated to nox-json) ─────────────────────────── *)
107
108(* Map a parsed nox-json value into the sqlite dialect tree. A number with a
109 fraction/exponent (nox-json [Float]) is re-formatted via {!real}; sqlite3
110 preserves the original lexeme of such a number, which this does not (the one
111 intentional divergence -- integers, strings, and structure are exact). *)
112let rec of_json (j : Json.t) : t =
113 match j with
114 | Json.Null _ -> Null
115 | Json.Bool (b, _) -> Bool b
116 | Json.Number (n, _) -> (
117 match n with
118 | Json.Number.Int i | Json.Number.Uint i -> Int i
119 | Json.Number.Float f -> real f)
120 | Json.String (s, _) -> Str s
121 | Json.Array (xs, _) -> Arr (List.map of_json xs)
122 | Json.Object (members, _) ->
123 Obj (List.map (fun ((k, _), v) -> (k, of_json v)) members)
124
125let parse s =
126 match Json.Value.of_string s with Ok v -> Some (of_json v) | Error _ -> None
127
128let parse_exn s =
129 match parse s with Some j -> j | None -> raise (Error "malformed JSON")
130
131(* ── Path navigation ($.a.b[2]) ──────────────────────────────── *)
132
133type step = Key of string | Index of int
134
135(* Parse a path expression like [$.a.b[2]] or [$[0]] into steps. *)
136let parse_path p =
137 let n = String.length p in
138 if n = 0 || p.[0] <> '$' then None
139 else begin
140 let i = ref 1 and steps = ref [] and ok = ref true in
141 while !ok && !i < n do
142 match p.[!i] with
143 | '.' ->
144 incr i;
145 let start = !i in
146 while !i < n && match p.[!i] with '.' | '[' -> false | _ -> true do
147 incr i
148 done;
149 steps := Key (String.sub p start (!i - start)) :: !steps
150 | '[' ->
151 incr i;
152 let start = !i in
153 while !i < n && p.[!i] <> ']' do
154 incr i
155 done;
156 (match int_of_string_opt (String.sub p start (!i - start)) with
157 | Some k -> steps := Index k :: !steps
158 | None -> ok := false);
159 if !i < n then incr i (* past ']' *)
160 | _ -> ok := false
161 done;
162 if !ok then Some (List.rev !steps) else None
163 end
164
165let rec navigate j = function
166 | [] -> Some j
167 | Key k :: rest -> (
168 match j with
169 | Obj kvs -> (
170 match List.assoc_opt k kvs with
171 | Some v -> navigate v rest
172 | None -> None)
173 | _ -> None)
174 | Index k :: rest -> (
175 match j with
176 | Arr xs -> (
177 match List.nth_opt xs k with
178 | Some v -> navigate v rest
179 | None -> None)
180 | _ -> None)
181
182let lookup j path =
183 match parse_path path with None -> None | Some steps -> navigate j steps