diff --git a/default.nix b/default.nix index 814c41c..a42aa84 100644 --- a/default.nix +++ b/default.nix @@ -33,12 +33,16 @@ let pname = "dunlin"; cp lume.lua "$out/share/lua/${lua.luaversion}" ''; }; + + lsqlite3 = callPackage ./lsqlite3.nix { lua = lua5_3; }; + lua = lua5_3.withPackages (ps: with ps; [ lgi luafilesystem luaposix readline lume + lsqlite3 ]); fennel_ = lua.pkgs.fennel; glib_networking_gio = "${glib-networking}/lib/gio/modules"; diff --git a/history.fnl b/history.fnl new file mode 100644 index 0000000..60aa2cf --- /dev/null +++ b/history.fnl @@ -0,0 +1,56 @@ +(local sqlite (require :lsqlite3)) +(local lume (require :lume)) +(local { : view} (require :fennel)) + +(fn table-exists? [db] + (accumulate [ret false + r (db:nrows "select name from sqlite_master where type = 'table' and name= 'db_version'")] + (or ret true))) + +(fn migrate [db serial statement] + (if (= (db:exec statement) 0) + (db:exec (.. "update db_version set serial = " serial)) + (assert false (.. "db failed: " statement)))) + +(fn migrate-all [db] + (when (not (table-exists? db "db_version")) + (db:exec "create table db_version (serial integer)") + (db:exec "insert into db_version values (1)")) + (let [version (accumulate [v 0 + r (db:nrows "select serial from db_version")] + r.serial)] + (when (< version 2) + (migrate db 2 "create table visits (url text, timestamp integer)")) + (when (< version 3) + (migrate db 3 "create table page_titles (url text primary key, title text)")))) + +(fn visit [self url timestamp] + (let [s (self.db:prepare "insert into visits (url, timestamp) values (?,?)")] + (assert (= 0 (s:bind_values url timestamp)) (view [url timestamp])) + (s:step) + (s:reset))) + +(fn title [self url title] + (let [s (self.db:prepare "insert into page_titles (url, title) values (?,?) on conflict(url) do update set title = excluded.title")] + (assert (= 0 (s:bind_values url title)) url) + (s:step) + (s:reset))) + +(fn find [self term] + (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, ?) is not null")] + (assert (= 0 (s:bind_values term))) + (icollect [r (s:nrows)] r))) + +(fn open [pathname] + (let [db (if pathname (sqlite:open pathname) (sqlite:open_memory))] + (migrate-all db) + { + : db + : visit + : title + : find + })) + +{ + : open + } diff --git a/lsqlite3.nix b/lsqlite3.nix new file mode 100644 index 0000000..9874509 --- /dev/null +++ b/lsqlite3.nix @@ -0,0 +1,21 @@ +{ + fetchurl +, lua +, lib +, sqlite +}: +let +in lua.pkgs.buildLuarocksPackage { + pname = "lsqlite3"; + version = "0.9.5-1"; + buildInputs = [ sqlite ] ; + src = fetchurl { + url = "https://luarocks.org/manifests/dougcurrie/lsqlite3-0.9.5-1.src.rock"; + sha256 = "sha256-/a48AzkKtOS32zoT0Jt5/+GTGHObdS0XkUrc2z0u+f8="; + }; + disabled = (lua.pkgs.luaOlder "5.1"); + propagatedBuildInputs = [ lua ]; + preBuild = '' + cd lsqlite3_fsl09y + ''; +} diff --git a/test/history.fnl b/test/history.fnl new file mode 100644 index 0000000..627b14b --- /dev/null +++ b/test/history.fnl @@ -0,0 +1,25 @@ +(local { : view } (require :fennel)) + +(local history (require :history)) + +(local fake-time + (let [] + (var previous 1672682104) + (fn [] + (doto previous + (+ 1))))) + +(let [h (history.open)] + (h:visit "http://example.com" (fake-time)) + (let [actual (h:find "example.com")] + (match actual + (where [{:url "http://example.com" :timestamp t}] (> t 0)) true + ?fail (assert false (view ?fail))))) + +(let [h (history.open)] + (h:visit "http://example.com" (fake-time)) + (h:title "http://example.com" "Page title") + (let [actual (h:find "example.com")] + (match actual + (where [{:url "http://example.com" :title "Page title" :timestamp t}] (> t 0)) true + ?fail (assert false (view ?fail)))))