| 1 | (* The SQLite store: one file, WAL mode, every todo scoped to a list. *) |
| 2 | |
| 3 | type todo = { id : int; title : string; completed : bool } |
| 4 | type t = { db : Sqlite3.db; stmts : (string, Sqlite3.stmt) Hashtbl.t } |
| 5 | |
| 6 | (* Each entry runs once, in order, and is recorded in user_version. |
| 7 | Migrations only ever add: never edit or remove an entry. *) |
| 8 | let migrations = |
| 9 | [ |
| 10 | {|CREATE TABLE lists ( |
| 11 | id TEXT PRIMARY KEY, |
| 12 | created_at INTEGER NOT NULL DEFAULT (unixepoch()) |
| 13 | ) STRICT; |
| 14 | CREATE TABLE todos ( |
| 15 | id INTEGER PRIMARY KEY AUTOINCREMENT, |
| 16 | list_id TEXT NOT NULL REFERENCES lists (id), |
| 17 | title TEXT NOT NULL, |
| 18 | completed INTEGER NOT NULL DEFAULT 0, |
| 19 | created_at INTEGER NOT NULL DEFAULT (unixepoch()) |
| 20 | ) STRICT; |
| 21 | CREATE INDEX todos_by_list ON todos (list_id, id);|}; |
| 22 | ] |
| 23 | |
| 24 | let exec db sql = |
| 25 | match Sqlite3.exec db sql with |
| 26 | | Sqlite3.Rc.OK -> () |
| 27 | | rc -> failwith (Printf.sprintf "sqlite: %s: %s" (Sqlite3.Rc.to_string rc) (Sqlite3.errmsg db)) |
| 28 | |
| 29 | let user_version db = |
| 30 | let v = ref 0 in |
| 31 | ignore (Sqlite3.exec_no_headers db "PRAGMA user_version" ~cb:(fun row -> |
| 32 | v := Option.fold ~none:0 ~some:int_of_string row.(0))); |
| 33 | !v |
| 34 | |
| 35 | let migrate db = |
| 36 | List.iteri |
| 37 | (fun i sql -> |
| 38 | if i >= user_version db then begin |
| 39 | exec db "BEGIN IMMEDIATE"; |
| 40 | exec db sql; |
| 41 | exec db (Printf.sprintf "PRAGMA user_version = %d" (i + 1)); |
| 42 | exec db "COMMIT" |
| 43 | end) |
| 44 | migrations |
| 45 | |
| 46 | let open_ path = |
| 47 | let db = Sqlite3.db_open path in |
| 48 | exec db "PRAGMA journal_mode = WAL"; |
| 49 | exec db "PRAGMA synchronous = NORMAL"; |
| 50 | exec db "PRAGMA busy_timeout = 5000"; |
| 51 | exec db "PRAGMA foreign_keys = ON"; |
| 52 | migrate db; |
| 53 | { db; stmts = Hashtbl.create 16 } |
| 54 | |
| 55 | let close t = |
| 56 | Hashtbl.iter (fun _ s -> ignore (Sqlite3.finalize s)) t.stmts; |
| 57 | Hashtbl.reset t.stmts; |
| 58 | ignore (Sqlite3.db_close t.db) |
| 59 | |
| 60 | (* Prepares [sql] once, binds [params], and calls [row] for each result. *) |
| 61 | let query t sql params ~row = |
| 62 | let stmt = |
| 63 | match Hashtbl.find_opt t.stmts sql with |
| 64 | | Some s -> s |
| 65 | | None -> |
| 66 | let s = Sqlite3.prepare t.db sql in |
| 67 | Hashtbl.add t.stmts sql s; |
| 68 | s |
| 69 | in |
| 70 | Fun.protect ~finally:(fun () -> ignore (Sqlite3.reset stmt)) @@ fun () -> |
| 71 | Sqlite3.Rc.check (Sqlite3.bind_values stmt params); |
| 72 | let rec loop acc = |
| 73 | match Sqlite3.step stmt with |
| 74 | | Sqlite3.Rc.ROW -> loop (row stmt :: acc) |
| 75 | | Sqlite3.Rc.DONE -> List.rev acc |
| 76 | | rc -> failwith (Printf.sprintf "sqlite: %s: %s" (Sqlite3.Rc.to_string rc) (Sqlite3.errmsg t.db)) |
| 77 | in |
| 78 | loop [] |
| 79 | |
| 80 | (* Runs a statement and answers whether it changed any row. *) |
| 81 | let change t sql params = |
| 82 | ignore (query t sql params ~row:ignore); |
| 83 | Sqlite3.changes t.db > 0 |
| 84 | |
| 85 | let text s = Sqlite3.Data.TEXT s |
| 86 | let int i = Sqlite3.Data.INT (Int64.of_int i) |
| 87 | |
| 88 | let list_exists t id = query t "SELECT 1 FROM lists WHERE id = ?" [ text id ] ~row:ignore <> [] |
| 89 | let create_list t id = ignore (change t "INSERT INTO lists (id) VALUES (?)" [ text id ]) |
| 90 | |
| 91 | let todos t ~list = |
| 92 | query t "SELECT id, title, completed FROM todos WHERE list_id = ? ORDER BY id" [ text list ] |
| 93 | ~row:(fun s -> |
| 94 | { id = Sqlite3.column_int s 0; title = Sqlite3.column_text s 1; completed = Sqlite3.column_bool s 2 }) |
| 95 | |
| 96 | let add t ~list title = |
| 97 | ignore (change t "INSERT INTO todos (list_id, title) VALUES (?, ?)" [ text list; text title ]) |
| 98 | |
| 99 | let toggle t ~list id = |
| 100 | change t "UPDATE todos SET completed = NOT completed WHERE id = ? AND list_id = ?" [ int id; text list ] |
| 101 | |
| 102 | let rename t ~list id title = |
| 103 | change t "UPDATE todos SET title = ? WHERE id = ? AND list_id = ?" [ text title; int id; text list ] |
| 104 | |
| 105 | let delete t ~list id = change t "DELETE FROM todos WHERE id = ? AND list_id = ?" [ int id; text list ] |
| 106 | |
| 107 | (* Completes every item, or reopens them all if every one already was. *) |
| 108 | let toggle_all t ~list = |
| 109 | ignore |
| 110 | (change t |
| 111 | {|UPDATE todos SET completed = |
| 112 | EXISTS (SELECT 1 FROM todos WHERE list_id = ?1 AND NOT completed) |
| 113 | WHERE list_id = ?1|} |
| 114 | [ text list ]) |
| 115 | |
| 116 | let clear_completed t ~list = |
| 117 | ignore (change t "DELETE FROM todos WHERE list_id = ? AND completed" [ text list ]) |
| 118 | |
amadan