gazagnaire.org / ocaml-sqlite
Minimal SQLite key-value store for OCaml
0
fork

Configure Feed

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

feat(ocaml-sqlite): add create_table and insert for arbitrary tables

Add generic write API: create_table parses CREATE TABLE SQL to register
new tables, insert writes rows with auto or explicit rowids (including
INTEGER PRIMARY KEY handling). 11 new tests cover all value types,
persistence, coexistence with KV API, and error cases.

Thomas Gazagnaire 8441d636 74048bcc

+334 -3
+124 -3
lib/sqlite.ml
··· 48 48 mutable data : kv_table option; 49 49 mutable named_tables : (string * kv_table) list; 50 50 mutable all_tables : generic_table list; 51 + insert_rowids : (string, int64 ref) Hashtbl.t; 51 52 } 52 53 53 54 let pp ppf t = ··· 388 389 (* Create kv data table on page 2 *) 389 390 let kv = new_kv_table pager in 390 391 let gt = { g_btree = kv.btree; g_schema = kv_schema "kv" } in 391 - let t = { pager; data = Some kv; named_tables = []; all_tables = [ gt ] } in 392 + let t = 393 + { 394 + pager; 395 + data = Some kv; 396 + named_tables = []; 397 + all_tables = [ gt ]; 398 + insert_rowids = Hashtbl.create 8; 399 + } 400 + in 392 401 rebuild_page1 t; 393 402 t 394 403 ··· 414 423 let _page1 = Btree.Pager.allocate pager in 415 424 let kv = new_kv_table pager in 416 425 let gt = { g_btree = kv.btree; g_schema = kv_schema "kv" } in 417 - let t = { pager; data = Some kv; named_tables = []; all_tables = [ gt ] } in 426 + let t = 427 + { 428 + pager; 429 + data = Some kv; 430 + named_tables = []; 431 + all_tables = [ gt ]; 432 + insert_rowids = Hashtbl.create 8; 433 + } 434 + in 418 435 rebuild_page1 t; 419 436 t 420 437 ··· 469 486 Some { btree = gt.g_btree; keys; next_rowid } 470 487 in 471 488 let named = extract_named_kv_tables all_tables in 472 - { pager; data; named_tables = named; all_tables } 489 + { 490 + pager; 491 + data; 492 + named_tables = named; 493 + all_tables; 494 + insert_rowids = Hashtbl.create 8; 495 + } 473 496 474 497 (* Get the kv_table, raising if no kv table exists *) 475 498 let kv t = ··· 585 608 let read_table t name = 586 609 fold_table t name ~init:[] ~f:(fun rowid values acc -> (rowid, values) :: acc) 587 610 |> List.rev 611 + 612 + (* Generic write API *) 613 + 614 + let create_table t ~sql = 615 + let columns = parse_create_table sql in 616 + (* Extract table name from SQL *) 617 + let name = 618 + let s = String.trim sql in 619 + (* Skip "CREATE TABLE [IF NOT EXISTS] name (...)" *) 620 + let upper = String.uppercase_ascii s in 621 + let after_table = 622 + match String.index_opt upper 'E' with 623 + | _ -> ( 624 + (* Find "TABLE" keyword *) 625 + let re = "TABLE" in 626 + let rec find_table i = 627 + if i + 5 > String.length upper then None 628 + else if String.sub upper i 5 = re then Some (i + 5) 629 + else find_table (i + 1) 630 + in 631 + match find_table 0 with None -> None | Some pos -> Some pos) 632 + in 633 + match after_table with 634 + | None -> failwith "Invalid CREATE TABLE statement" 635 + | Some pos -> 636 + let s = String.trim (String.sub s pos (String.length s - pos)) in 637 + (* Skip optional IF NOT EXISTS *) 638 + let s = 639 + let upper = String.uppercase_ascii s in 640 + if 641 + String.length upper >= 13 && String.sub upper 0 13 = "IF NOT EXISTS" 642 + then String.trim (String.sub s 13 (String.length s - 13)) 643 + else s 644 + in 645 + (* Extract name (up to space or paren) *) 646 + let len = 647 + let rec find i = 648 + if i >= String.length s then i 649 + else 650 + match s.[i] with 651 + | ' ' | '\t' | '\n' | '\r' | '(' -> i 652 + | _ -> find (i + 1) 653 + in 654 + find 0 655 + in 656 + String.sub s 0 len 657 + in 658 + let btree = Btree.Table.v t.pager in 659 + let schema = { tbl_name = name; columns; sql } in 660 + let gt = { g_btree = btree; g_schema = schema } in 661 + t.all_tables <- t.all_tables @ [ gt ] 662 + 663 + let next_rowid_for t name = 664 + match Hashtbl.find_opt t.insert_rowids name with 665 + | Some r -> r 666 + | None -> 667 + let gt = table t name in 668 + let max_rowid = ref 0L in 669 + Btree.Table.iter gt.g_btree (fun rowid _payload -> 670 + if rowid > !max_rowid then max_rowid := rowid); 671 + let r = ref (Int64.add !max_rowid 1L) in 672 + Hashtbl.replace t.insert_rowids name r; 673 + r 674 + 675 + let insert t ~table:name values = 676 + let gt = table t name in 677 + let next = next_rowid_for t name in 678 + (* Determine rowid: for INTEGER PRIMARY KEY, use explicit value or auto *) 679 + let rowid, record_values = 680 + match rowid_alias_index gt.g_schema.columns with 681 + | None -> 682 + let rowid = !next in 683 + next := Int64.add rowid 1L; 684 + (rowid, values) 685 + | Some idx -> 686 + let pk_value = 687 + if idx < List.length values then List.nth values idx else Vnull 688 + in 689 + let rowid = 690 + match pk_value with 691 + | Vint n -> 692 + if Int64.add n 1L > !next then next := Int64.add n 1L; 693 + n 694 + | _ -> 695 + let rowid = !next in 696 + next := Int64.add rowid 1L; 697 + rowid 698 + in 699 + (* Store Vnull for the INTEGER PRIMARY KEY column in the record, 700 + since SQLite stores the rowid separately *) 701 + let record_values = 702 + List.mapi (fun i v -> if i = idx then Vnull else v) values 703 + in 704 + (rowid, record_values) 705 + in 706 + let record = Btree.Record.encode record_values in 707 + Btree.Table.insert gt.g_btree ~rowid record; 708 + rowid 588 709 589 710 (* Namespaced Tables *) 590 711
+19
lib/sqlite.mli
··· 112 112 val read_table : t -> string -> (int64 * value list) list 113 113 (** [read_table t name] returns all rows from table [name] as a list. *) 114 114 115 + (** {1 Generic Write API} 116 + 117 + Create arbitrary tables and insert rows. *) 118 + 119 + val create_table : t -> sql:string -> unit 120 + (** [create_table t ~sql] creates a new table from a CREATE TABLE statement. The 121 + SQL is stored in sqlite_master and the column definitions are parsed for 122 + schema metadata. *) 123 + 124 + val insert : t -> table:string -> value list -> int64 125 + (** [insert t ~table values] inserts a row into [table] with the given column 126 + values. Returns the rowid of the inserted row. 127 + 128 + For tables with an [INTEGER PRIMARY KEY] column, if the corresponding value 129 + is [Vint n], the row is inserted with rowid [n]. If the value is [Vnull], 130 + the rowid is auto-assigned. 131 + 132 + @raise Failure if the table doesn't exist. *) 133 + 115 134 (** {1 Schema Parsing} *) 116 135 117 136 val parse_create_table : string -> column list
+191
test/test_sqlite.ml
··· 842 842 Alcotest.(check (option string)) "overflow persists" (Some large) result; 843 843 Sqlite.close db) 844 844 845 + (* ---- INSERT tests ---- *) 846 + 847 + let test_create_and_insert () = 848 + with_temp_db @@ fun _fs db -> 849 + Sqlite.create_table db ~sql:"CREATE TABLE users (name TEXT, age INTEGER)"; 850 + let rowid = 851 + Sqlite.insert db ~table:"users" [ Sqlite.Vtext "Alice"; Sqlite.Vint 30L ] 852 + in 853 + Alcotest.(check int64) "first rowid" 1L rowid; 854 + let rows = Sqlite.read_table db "users" in 855 + Alcotest.(check int) "1 row" 1 (List.length rows); 856 + let rid, values = List.hd rows in 857 + Alcotest.(check int64) "rowid matches" 1L rid; 858 + match values with 859 + | [ Sqlite.Vtext "Alice"; Sqlite.Vint 30L ] -> () 860 + | _ -> Alcotest.failf "unexpected: %a" Fmt.(list Sqlite.pp_value) values 861 + 862 + let test_insert_multiple_rows () = 863 + with_temp_db @@ fun _fs db -> 864 + Sqlite.create_table db ~sql:"CREATE TABLE t (x TEXT, y INTEGER)"; 865 + let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "a"; Sqlite.Vint 1L ] in 866 + let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "b"; Sqlite.Vint 2L ] in 867 + let r3 = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "c"; Sqlite.Vint 3L ] in 868 + Alcotest.(check int64) "third rowid" 3L r3; 869 + let rows = Sqlite.read_table db "t" in 870 + Alcotest.(check int) "3 rows" 3 (List.length rows) 871 + 872 + let test_insert_all_types () = 873 + with_temp_db @@ fun _fs db -> 874 + Sqlite.create_table db 875 + ~sql:"CREATE TABLE t (a INTEGER, b REAL, c TEXT, d BLOB)"; 876 + let _ = 877 + Sqlite.insert db ~table:"t" 878 + [ 879 + Sqlite.Vint 42L; 880 + Sqlite.Vfloat 3.14; 881 + Sqlite.Vtext "hello"; 882 + Sqlite.Vblob "\x00\x01\x02"; 883 + ] 884 + in 885 + let rows = Sqlite.read_table db "t" in 886 + let _, values = List.hd rows in 887 + match values with 888 + | [ Sqlite.Vint 42L; Sqlite.Vfloat f; Sqlite.Vtext "hello"; Sqlite.Vblob b ] 889 + -> 890 + Alcotest.(check (float 1e-10)) "float" 3.14 f; 891 + Alcotest.(check string) "blob" "\x00\x01\x02" b 892 + | _ -> Alcotest.failf "unexpected: %a" Fmt.(list Sqlite.pp_value) values 893 + 894 + let test_insert_with_null () = 895 + with_temp_db @@ fun _fs db -> 896 + Sqlite.create_table db ~sql:"CREATE TABLE t (a TEXT, b INTEGER, c TEXT)"; 897 + let _ = 898 + Sqlite.insert db ~table:"t" 899 + [ Sqlite.Vtext "x"; Sqlite.Vnull; Sqlite.Vtext "z" ] 900 + in 901 + let rows = Sqlite.read_table db "t" in 902 + let _, values = List.hd rows in 903 + match values with 904 + | [ Sqlite.Vtext "x"; Sqlite.Vnull; Sqlite.Vtext "z" ] -> () 905 + | _ -> Alcotest.failf "unexpected: %a" Fmt.(list Sqlite.pp_value) values 906 + 907 + let test_insert_fewer_values () = 908 + with_temp_db @@ fun _fs db -> 909 + Sqlite.create_table db ~sql:"CREATE TABLE t (a TEXT, b INTEGER, c TEXT)"; 910 + let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "only_a" ] in 911 + let rows = Sqlite.read_table db "t" in 912 + let _, values = List.hd rows in 913 + (* Trailing columns should be Vnull *) 914 + match values with 915 + | [ Sqlite.Vtext "only_a"; Sqlite.Vnull; Sqlite.Vnull ] -> () 916 + | _ -> Alcotest.failf "unexpected: %a" Fmt.(list Sqlite.pp_value) values 917 + 918 + let test_insert_integer_primary_key () = 919 + with_temp_db @@ fun _fs db -> 920 + Sqlite.create_table db 921 + ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, name TEXT)"; 922 + (* When inserting Vnull for INTEGER PRIMARY KEY, rowid is auto-assigned *) 923 + let r1 = Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "Alice" ] in 924 + let r2 = Sqlite.insert db ~table:"t" [ Sqlite.Vnull; Sqlite.Vtext "Bob" ] in 925 + Alcotest.(check int64) "first rowid" 1L r1; 926 + Alcotest.(check int64) "second rowid" 2L r2; 927 + let rows = Sqlite.read_table db "t" in 928 + (* read_table substitutes rowid for INTEGER PRIMARY KEY *) 929 + let _, v1 = List.nth rows 0 in 930 + (match v1 with 931 + | [ Sqlite.Vint 1L; Sqlite.Vtext "Alice" ] -> () 932 + | _ -> Alcotest.failf "row1: %a" Fmt.(list Sqlite.pp_value) v1); 933 + let _, v2 = List.nth rows 1 in 934 + match v2 with 935 + | [ Sqlite.Vint 2L; Sqlite.Vtext "Bob" ] -> () 936 + | _ -> Alcotest.failf "row2: %a" Fmt.(list Sqlite.pp_value) v2 937 + 938 + let test_insert_explicit_rowid () = 939 + with_temp_db @@ fun _fs db -> 940 + Sqlite.create_table db 941 + ~sql:"CREATE TABLE t (id INTEGER PRIMARY KEY, val TEXT)"; 942 + (* Explicit integer value for INTEGER PRIMARY KEY sets the rowid *) 943 + let r = 944 + Sqlite.insert db ~table:"t" [ Sqlite.Vint 42L; Sqlite.Vtext "hello" ] 945 + in 946 + Alcotest.(check int64) "explicit rowid" 42L r; 947 + let rows = Sqlite.read_table db "t" in 948 + let rowid, values = List.hd rows in 949 + Alcotest.(check int64) "stored rowid" 42L rowid; 950 + match values with 951 + | [ Sqlite.Vint 42L; Sqlite.Vtext "hello" ] -> () 952 + | _ -> Alcotest.failf "unexpected: %a" Fmt.(list Sqlite.pp_value) values 953 + 954 + let test_insert_persistence () = 955 + Eio_main.run @@ fun env -> 956 + let cwd = Eio.Stdenv.cwd env in 957 + let tmp_dir = Eio.Path.(cwd / "_build" / "test_sqlite") in 958 + (try Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 tmp_dir with Eio.Io _ -> ()); 959 + let path = 960 + Eio.Path.(tmp_dir / Fmt.str "insert_%d.db" (Random.int 1_000_000)) 961 + in 962 + (* Write *) 963 + Eio.Switch.run (fun sw -> 964 + let db = Sqlite.v ~sw path in 965 + Sqlite.create_table db ~sql:"CREATE TABLE items (name TEXT, qty INTEGER)"; 966 + let _ = 967 + Sqlite.insert db ~table:"items" 968 + [ Sqlite.Vtext "widget"; Sqlite.Vint 100L ] 969 + in 970 + let _ = 971 + Sqlite.insert db ~table:"items" 972 + [ Sqlite.Vtext "gadget"; Sqlite.Vint 50L ] 973 + in 974 + Sqlite.close db); 975 + (* Read back *) 976 + Eio.Switch.run (fun sw -> 977 + let db = Sqlite.open_ ~sw path in 978 + let rows = Sqlite.read_table db "items" in 979 + Alcotest.(check int) "2 rows persisted" 2 (List.length rows); 980 + let _, v1 = List.nth rows 0 in 981 + (match v1 with 982 + | [ Sqlite.Vtext "widget"; Sqlite.Vint 100L ] -> () 983 + | _ -> Alcotest.failf "row1: %a" Fmt.(list Sqlite.pp_value) v1); 984 + Sqlite.close db) 985 + 986 + let test_insert_tables_lists_created () = 987 + with_temp_db @@ fun _fs db -> 988 + Sqlite.create_table db ~sql:"CREATE TABLE foo (a TEXT)"; 989 + Sqlite.create_table db ~sql:"CREATE TABLE bar (b INTEGER, c REAL)"; 990 + let schemas = Sqlite.tables db in 991 + let names = 992 + List.map (fun (s : Sqlite.schema) -> s.tbl_name) schemas 993 + |> List.sort String.compare 994 + in 995 + (* "kv" is the default table, plus our two *) 996 + Alcotest.(check (list string)) "all tables" [ "bar"; "foo"; "kv" ] names 997 + 998 + let test_insert_coexists_with_kv () = 999 + with_temp_db @@ fun _fs db -> 1000 + (* KV operations still work alongside create_table/insert *) 1001 + Sqlite.put db "k1" "v1"; 1002 + Sqlite.create_table db ~sql:"CREATE TABLE t (x TEXT)"; 1003 + let _ = Sqlite.insert db ~table:"t" [ Sqlite.Vtext "hello" ] in 1004 + Alcotest.(check (option string)) 1005 + "kv still works" (Some "v1") (Sqlite.find db "k1"); 1006 + let rows = Sqlite.read_table db "t" in 1007 + Alcotest.(check int) "insert works" 1 (List.length rows) 1008 + 1009 + let test_insert_nonexistent_table () = 1010 + with_temp_db @@ fun _fs db -> 1011 + try 1012 + let _ = Sqlite.insert db ~table:"nope" [ Sqlite.Vtext "x" ] in 1013 + Alcotest.fail "should have raised" 1014 + with Failure _ -> () 1015 + 845 1016 let suite = 846 1017 ( "sqlite", 847 1018 List.concat ··· 939 1110 test_sqlite_overflow_values; 940 1111 Alcotest.test_case "spec overflow persist" `Quick 941 1112 test_sqlite_overflow_persistence; 1113 + ]; 1114 + [ 1115 + Alcotest.test_case "create and insert" `Quick test_create_and_insert; 1116 + Alcotest.test_case "insert multiple rows" `Quick 1117 + test_insert_multiple_rows; 1118 + Alcotest.test_case "insert all types" `Quick test_insert_all_types; 1119 + Alcotest.test_case "insert with null" `Quick test_insert_with_null; 1120 + Alcotest.test_case "insert fewer values" `Quick 1121 + test_insert_fewer_values; 1122 + Alcotest.test_case "insert integer pk" `Quick 1123 + test_insert_integer_primary_key; 1124 + Alcotest.test_case "insert explicit rowid" `Quick 1125 + test_insert_explicit_rowid; 1126 + Alcotest.test_case "insert persistence" `Quick test_insert_persistence; 1127 + Alcotest.test_case "insert tables listed" `Quick 1128 + test_insert_tables_lists_created; 1129 + Alcotest.test_case "insert with kv" `Quick 1130 + test_insert_coexists_with_kv; 1131 + Alcotest.test_case "insert nonexistent" `Quick 1132 + test_insert_nonexistent_table; 942 1133 ]; 943 1134 ] )