Minimal SQLite key-value store for OCaml
fix(ocaml-sqlite): apply merlint fixes (E005, E325, E331, E340, E415)
- Rename find_matching_paren -> matching_paren, find_table -> table
- Extract add_paren_content and extract_named_kv_tables helpers
- Add pp for type t; add err_kv_pair helper in sql.ml
+44
-31
+3
-1
bin/sql.ml
+3
-1
bin/sql.ml
···
23
23
Sqlite.close t;
24
24
Log.info (fun m -> m "wrote %d entries to %s" (List.length pairs) db)
25
25
26
+
let err_kv_pair s = Error (`Msg (Fmt.str "expected KEY=VALUE, got %S" s))
27
+
26
28
let kv_pair =
27
29
let parse s =
28
30
match String.split_on_char '=' s with
29
31
| [ k; v ] -> Ok (k, v)
30
-
| _ -> Error (`Msg (Fmt.str "expected KEY=VALUE, got %S" s))
32
+
| _ -> err_kv_pair s
31
33
in
32
34
let pp ppf (k, v) = Fmt.pf ppf "%s=%s" k v in
33
35
Arg.conv (parse, pp)
+38
-30
lib/sqlite.ml
+38
-30
lib/sqlite.ml
···
50
50
mutable all_tables : generic_table list;
51
51
}
52
52
53
+
let pp ppf t =
54
+
let names = List.map (fun gt -> gt.g_schema.tbl_name) t.all_tables in
55
+
Fmt.pf ppf "sqlite(%a)" Fmt.(list ~sep:(any ",") string) names
56
+
53
57
(* CREATE TABLE parser *)
54
58
55
59
let is_space = function ' ' | '\t' | '\n' | '\r' -> true | _ -> false
···
78
82
List.rev !parts
79
83
80
84
(* Find the position of the matching closing paren *)
81
-
let find_matching_paren s start =
85
+
let matching_paren s start =
82
86
let len = String.length s in
83
87
let rec loop i depth =
84
88
if i >= len then None
···
106
110
| _ -> loop (i + 1) depth
107
111
in
108
112
loop (start + 1) 0
113
+
114
+
(* Consume parenthesized content into buf, advancing i past the closing paren *)
115
+
let add_paren_content buf s i len =
116
+
Buffer.add_char buf '(';
117
+
let depth = ref 1 in
118
+
incr i;
119
+
while !i < len && !depth > 0 do
120
+
(match s.[!i] with '(' -> incr depth | ')' -> decr depth | _ -> ());
121
+
Buffer.add_char buf s.[!i];
122
+
incr i
123
+
done
109
124
110
125
(* Tokenize a column definition into words, handling quoted identifiers
111
126
and parenthesized type parameters like DECIMAL(10,2) *)
···
127
142
incr i
128
143
| '(' ->
129
144
(* Include parenthesized content as part of current token *)
130
-
Buffer.add_char buf '(';
131
-
let depth = ref 1 in
132
-
incr i;
133
-
while !i < len && !depth > 0 do
134
-
(match s.[!i] with '(' -> incr depth | ')' -> decr depth | _ -> ());
135
-
Buffer.add_char buf s.[!i];
136
-
incr i
137
-
done
145
+
add_paren_content buf s i len
138
146
| '"' ->
139
147
(* Double-quoted identifier: strip quotes *)
140
148
incr i;
···
234
242
match String.index_opt sql '(' with
235
243
| None -> []
236
244
| Some start -> (
237
-
match find_matching_paren sql start with
245
+
match matching_paren sql start with
238
246
| None -> []
239
247
| Some body_end ->
240
248
let body = String.sub sql (start + 1) (body_end - start - 1) in
···
382
390
rebuild_page1 t;
383
391
t
384
392
393
+
(* Extract named kv tables (non-kv tables with kv schema) from all_tables *)
394
+
let extract_named_kv_tables all_tables =
395
+
List.filter_map
396
+
(fun gt ->
397
+
let name = gt.g_schema.tbl_name in
398
+
if name = "kv" then None
399
+
else
400
+
match gt.g_schema.columns with
401
+
| [
402
+
{ col_name = "key"; col_affinity = "TEXT"; _ };
403
+
{ col_name = "value"; col_affinity = "BLOB"; _ };
404
+
] ->
405
+
let keys, next_rowid = scan_table gt.g_btree in
406
+
Some (name, { btree = gt.g_btree; keys; next_rowid })
407
+
| _ -> None)
408
+
all_tables
409
+
385
410
let in_memory () =
386
411
let pager = Btree.Pager.mem ~page_size () in
387
412
let _page1 = Btree.Pager.allocate pager in
···
441
466
let keys, next_rowid = scan_table gt.g_btree in
442
467
Some { btree = gt.g_btree; keys; next_rowid }
443
468
in
444
-
(* Open named kv tables (non-kv tables with kv schema) *)
445
-
let named =
446
-
List.filter_map
447
-
(fun gt ->
448
-
let name = gt.g_schema.tbl_name in
449
-
if name = "kv" then None
450
-
else
451
-
(* Only treat as kv_table if it has the kv schema *)
452
-
match gt.g_schema.columns with
453
-
| [
454
-
{ col_name = "key"; col_affinity = "TEXT"; _ };
455
-
{ col_name = "value"; col_affinity = "BLOB"; _ };
456
-
] ->
457
-
let keys, next_rowid = scan_table gt.g_btree in
458
-
Some (name, { btree = gt.g_btree; keys; next_rowid })
459
-
| _ -> None)
460
-
all_tables
461
-
in
469
+
let named = extract_named_kv_tables all_tables in
462
470
{ pager; data; named_tables = named; all_tables }
463
471
464
472
(* Get the kv_table, raising if no kv table exists *)
···
524
532
525
533
let tables t = List.map (fun gt -> gt.g_schema) t.all_tables
526
534
527
-
let find_table t name =
535
+
let table t name =
528
536
match List.find_opt (fun gt -> gt.g_schema.tbl_name = name) t.all_tables with
529
537
| Some gt -> gt
530
538
| None -> Fmt.failwith "No table %S found in database" name
···
560
568
values
561
569
562
570
let iter_table t name ~f =
563
-
let gt = find_table t name in
571
+
let gt = table t name in
564
572
let schema = gt.g_schema in
565
573
Btree.Table.iter gt.g_btree (fun rowid payload ->
566
574
let values = Btree.Record.decode payload in