history.fnl (2097B)
1 (local sqlite (require :lsqlite3)) 2 (local lume (require :lume)) 3 (local { : view} (require :fennel)) 4 5 (fn table-exists? [db] 6 (accumulate [ret false 7 r (db:nrows "select name from sqlite_master where type = 'table' and name= 'db_version'")] 8 (or ret true))) 9 10 (fn migrate [db serial statement] 11 (if (= (db:exec statement) 0) 12 (db:exec (.. "update db_version set serial = " serial)) 13 (assert false (.. "db failed: " statement)))) 14 15 (fn migrate-all [db] 16 (when (not (table-exists? db "db_version")) 17 (db:exec "create table db_version (serial integer)") 18 (db:exec "insert into db_version values (1)")) 19 (let [version (accumulate [v 0 20 r (db:nrows "select serial from db_version")] 21 r.serial)] 22 (when (< version 2) 23 (migrate db 2 "create table visits (url text, timestamp integer)")) 24 (when (< version 3) 25 (migrate db 3 "create table page_titles (url text primary key, title text)")))) 26 27 (fn visit [self url timestamp] 28 (let [s (self.db:prepare "insert into visits (url, timestamp) values (?,?)")] 29 (assert (= 0 (s:bind_values url timestamp)) (view [url timestamp])) 30 (s:step) 31 (s:reset))) 32 33 (fn title [self url title] 34 (let [s (self.db:prepare "insert into page_titles (url, title) values (?,?) on conflict(url) do update set title = excluded.title")] 35 (assert (= 0 (s:bind_values url title)) url) 36 (s:step) 37 (s:reset))) 38 39 (fn find [self term] 40 (let [s (self.db:prepare "select v.url,pt.title,v.timestamp from visits v left join page_titles pt on v.url = pt.url where instr(v.url, ?) >0")] 41 (assert (= 0 (s:bind_values term))) 42 (s:nrows))) 43 44 (fn find-distinct [self term] 45 (let [s (self.db:prepare "select distinct v.url,pt.title from visits v left join page_titles pt on v.url = pt.url where instr(v.url, ?) >0")] 46 (assert (= 0 (s:bind_values term))) 47 (s:nrows))) 48 49 (fn open [pathname] 50 (let [db (if pathname (sqlite.open pathname) (sqlite.open_memory))] 51 (migrate-all db) 52 { 53 : db 54 : visit 55 : title 56 : find 57 : find-distinct 58 })) 59 60 { 61 : open 62 }