Minimal SQLite key-value store for OCaml
Refactor open_: extract read_master and open_unique_indexes helpers
Splits the 117-line open_ function into smaller pieces to satisfy
merlint E005 (long function threshold).
+71
-74
+71
-74
lib/sqlite.ml
+71
-74
lib/sqlite.ml
···
623
623
rebuild_page1 t;
624
624
t
625
625
626
+
(* Parse sqlite_master into raw table and index entries *)
627
+
let read_master page1 =
628
+
let header = Btree.Page.parse_header page1 100 in
629
+
let ptrs = Btree.Page.cell_pointers page1 100 header in
630
+
let raw_tables = ref [] in
631
+
let raw_indexes = ref [] in
632
+
for i = 0 to header.Btree.Page.cell_count - 1 do
633
+
let cell, _ =
634
+
Btree.Cell.parse_table_leaf page1 ptrs.(i) ~usable_size:page_size
635
+
in
636
+
match Btree.Record.decode cell.Btree.Cell.payload with
637
+
| [
638
+
Btree.Record.Vtext "table";
639
+
Btree.Record.Vtext name;
640
+
_;
641
+
Btree.Record.Vint root;
642
+
Btree.Record.Vtext sql;
643
+
] ->
644
+
raw_tables := (name, Int64.to_int root, sql) :: !raw_tables
645
+
| [
646
+
Btree.Record.Vtext "index";
647
+
Btree.Record.Vtext idx_name;
648
+
Btree.Record.Vtext tbl_name;
649
+
Btree.Record.Vint root;
650
+
_;
651
+
] ->
652
+
raw_indexes := (idx_name, tbl_name, Int64.to_int root) :: !raw_indexes
653
+
| _ -> ()
654
+
done;
655
+
(List.rev !raw_tables, List.rev !raw_indexes)
656
+
657
+
(* Reconnect or create unique indexes for a table *)
658
+
let open_unique_indexes pager ~btree ~schema ~constraints ~raw_indexes =
659
+
let name = schema.tbl_name in
660
+
let tbl_indexes = List.filter (fun (_, tbl, _) -> tbl = name) raw_indexes in
661
+
List.mapi
662
+
(fun i (indices, col_name) ->
663
+
let expected_name = Fmt.str "sqlite_autoindex_%s_%d" name (i + 1) in
664
+
match
665
+
List.find_opt
666
+
(fun (idx_name, _, _) -> idx_name = expected_name)
667
+
tbl_indexes
668
+
with
669
+
| Some (idx_name, _, idx_root) ->
670
+
{
671
+
ui_columns = indices;
672
+
ui_name = col_name;
673
+
ui_index_name = idx_name;
674
+
ui_tbl_name = name;
675
+
ui_btree = Btree.Index.open_ pager ~root_page:idx_root;
676
+
}
677
+
| None ->
678
+
let ui =
679
+
{
680
+
ui_columns = indices;
681
+
ui_name = col_name;
682
+
ui_index_name = expected_name;
683
+
ui_tbl_name = name;
684
+
ui_btree = Btree.Index.v pager;
685
+
}
686
+
in
687
+
Btree.Table.iter btree (fun rowid payload ->
688
+
let values = Btree.Record.decode payload in
689
+
let values = fixup_values ~schema ~rowid values in
690
+
let key = encode_index_key ui values in
691
+
Btree.Index.insert ui.ui_btree key);
692
+
ui)
693
+
constraints
694
+
626
695
let open_ ~sw ?(create = true) path =
627
696
try
628
697
let file =
···
632
701
let pager = Btree.Pager.v ~page_size file in
633
702
if Btree.Pager.page_count pager = 0 then
634
703
failwith "Database file exists but is empty (delete it to recreate)";
635
-
(* Read page 1 and validate *)
636
704
let page1 = Btree.Pager.read pager 1 in
637
705
if String.sub page1 0 16 <> magic then failwith "Not a SQLite database";
638
706
let ps = Btree.Page.u16_be page1 16 in
639
707
if ps <> page_size then Fmt.failwith "Unsupported page size: %d" ps;
640
-
(* Parse sqlite_master at offset 100 *)
641
-
let header = Btree.Page.parse_header page1 100 in
642
-
let ptrs = Btree.Page.cell_pointers page1 100 header in
643
-
let raw_tables = ref [] in
644
-
let raw_indexes = ref [] in
645
-
for i = 0 to header.Btree.Page.cell_count - 1 do
646
-
let cell, _ =
647
-
Btree.Cell.parse_table_leaf page1 ptrs.(i) ~usable_size:page_size
648
-
in
649
-
match Btree.Record.decode cell.Btree.Cell.payload with
650
-
| [
651
-
Btree.Record.Vtext "table";
652
-
Btree.Record.Vtext name;
653
-
_;
654
-
Btree.Record.Vint root;
655
-
Btree.Record.Vtext sql;
656
-
] ->
657
-
raw_tables := (name, Int64.to_int root, sql) :: !raw_tables
658
-
| [
659
-
Btree.Record.Vtext "index";
660
-
Btree.Record.Vtext idx_name;
661
-
Btree.Record.Vtext tbl_name;
662
-
Btree.Record.Vint root;
663
-
_;
664
-
] ->
665
-
raw_indexes := (idx_name, tbl_name, Int64.to_int root) :: !raw_indexes
666
-
| _ -> ()
667
-
done;
668
-
let raw_tables = List.rev !raw_tables in
669
-
let raw_indexes = List.rev !raw_indexes in
670
-
(* Build generic_table for every table *)
708
+
let raw_tables, raw_indexes = read_master page1 in
671
709
let all_tables =
672
710
List.map
673
711
(fun (name, root, sql) ->
···
675
713
let columns = parse_create_table sql in
676
714
let schema = { tbl_name = name; columns; sql } in
677
715
let constraints = parse_unique_constraints sql columns in
678
-
(* Reconnect persistent indexes from sqlite_master *)
679
-
let tbl_indexes =
680
-
List.filter (fun (_, tbl, _) -> tbl = name) raw_indexes
681
-
in
682
716
let indexes =
683
-
List.mapi
684
-
(fun i (indices, col_name) ->
685
-
let expected_name =
686
-
Fmt.str "sqlite_autoindex_%s_%d" name (i + 1)
687
-
in
688
-
match
689
-
List.find_opt
690
-
(fun (idx_name, _, _) -> idx_name = expected_name)
691
-
tbl_indexes
692
-
with
693
-
| Some (idx_name, _, idx_root) ->
694
-
(* Reopen existing persistent index *)
695
-
{
696
-
ui_columns = indices;
697
-
ui_name = col_name;
698
-
ui_index_name = idx_name;
699
-
ui_tbl_name = name;
700
-
ui_btree = Btree.Index.open_ pager ~root_page:idx_root;
701
-
}
702
-
| None ->
703
-
(* No persisted index yet — create and populate *)
704
-
let ui =
705
-
{
706
-
ui_columns = indices;
707
-
ui_name = col_name;
708
-
ui_index_name = expected_name;
709
-
ui_tbl_name = name;
710
-
ui_btree = Btree.Index.v pager;
711
-
}
712
-
in
713
-
Btree.Table.iter btree (fun rowid payload ->
714
-
let values = Btree.Record.decode payload in
715
-
let values = fixup_values ~schema ~rowid values in
716
-
let key = encode_index_key ui values in
717
-
Btree.Index.insert ui.ui_btree key);
718
-
ui)
719
-
constraints
717
+
open_unique_indexes pager ~btree ~schema ~constraints ~raw_indexes
720
718
in
721
719
{ g_btree = btree; g_schema = schema; g_unique_indexes = indexes })
722
720
raw_tables
723
721
in
724
-
(* Try to find "kv" table for backward compat *)
725
722
let data =
726
723
match
727
724
List.find_opt (fun gt -> gt.g_schema.tbl_name = "kv") all_tables