Minimal SQLite key-value store for OCaml
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

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
··· 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