hook up the history logger thing

not hooked up to actual browsing actions yet

command.fnl

@@ -24,15 +24,21 @@
 
 (define-command
  "switch-to-buffer"
- [[:buffer Buffer.match #(. (Buffer.next $1.buffer) :name)]]
- (fn [{: frame : buffer}]
+ [[:buffer
+   Buffer.match
+   #(. (Buffer.next $1.buffer) :name)]
+  ]
+ (fn [{:frame frame :buffer buffer}]
    (frame:show-buffer buffer)))
 
 (define-command
  "visit-location"
- [[:buffer Buffer.match #$1.buffer.name]
-  [:url  #{$1 $1} #($1.buffer:location)]]
- (fn [{: url : buffer}]
+ [[:buffer
+   Buffer.match
+   #$1.buffer.name]
+  [:url  #{$1 $1} #($1.buffer:location)]
+  ]
+ (fn [{:url url :buffer buffer}]
    (buffer:visit url)))
 
 (define-command
@@ -87,7 +93,8 @@
 
       {:command c :this-param k :collected-params p}
       (let [{ : completer}  (. c.params k)
-            value (. (completer input-string) input-string)]
+            vals (completer input-string)
+            value (. vals input-string)]
         (tset p k value)
         (state-for-next-param c p))
 
@@ -98,25 +105,26 @@
             state)
       )))
 
-(fn on-activate [self str]
+(fn on-input-finished [self str]
   (let [s (next-action self str)
         param (if s.active (. (. s.command :params) s.this-param))]
     (set self.state s)
     {
+     :active s.active
      :error s.error
      :prompt (if s.active (or s.this-param  "Command?" "") "")
      :default (and param (param.default self.frame))
      }))
 
-(fn update-widget-state [{ : state : widget : entry : completions-widget : prompt} result]
+(fn update-widget-state [{ : widget : entry : completions-widget : prompt} result]
   (set prompt.label (or result.prompt ""))
-  (set entry.sensitive state.active)
-  (if (not state.active)
+  (set entry.sensitive result.active)
+  (if (not result.active)
       (completions-widget:hide))
   (set entry.text (or result.default result.error ""))
-  (match widget.parent
-    p (p:set_visible_child_name
-       (if state.active "commander" "echo-area"))))
+  (when widget.parent
+    (widget.parent:set_visible_child_name
+     (if result.active "commander" "echo-area"))))
 
 (fn on-input [self str]
   (match self.state
@@ -126,11 +134,12 @@
           completions (completer str)]
       (parent:foreach #(parent:remove $1))
       (each [text _w (pairs completions)]
-        (parent:add (Gtk.Button {
-                                 :label text
-                                 :on_clicked
-                                 #(update-widget-state self (self:on-activate text))
-                                 })))
+        (parent:add
+         (Gtk.Button {
+                      :label text
+                      :on_clicked
+                      #(update-widget-state self (self:on-input-finished text))
+                      })))
       (parent:show_all)
       )))
 
@@ -139,16 +148,17 @@
   (tset state :active true)
   (update-widget-state
    self
-   {
+   {:active true
     :prompt (or state.this-param  "Command" "")
     })
-  (entry:grab_focus))
+  (entry:grab_focus)
+  state)
 
 (fn deactivate [{: state : entry : prompt &as self}]
   (doto state
     (lume.clear)
     (tset :active false))
-  (update-widget-state self {}))
+  (update-widget-state self {:active false}))
 
 (fn invoke-interactively [self name params]
   (let [c (find-command name)
@@ -160,7 +170,7 @@
            :collected-params supplied-params
            }]
     (set self.state s)
-    (let [r (self:on-activate nil)]
+    (let [r (self:on-input-finished nil)]
       (update-widget-state self r)
       (self.entry:grab_focus)
       r)))
@@ -181,7 +191,7 @@
               : deactivate
               :active? (fn [self] self.state.active)
               : on-input
-              : on-activate
+              : on-input-finished
               : invoke-interactively
               : entry
               :widget box
@@ -198,7 +208,7 @@
             (self:on-input event.text)))
     (tset entry :on_activate
           (fn [event]
-            (let [result  (self:on-activate event.text)]
+            (let [result (self:on-input-finished event.text)]
               (update-widget-state self result))))
     self))
 

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";

dunlin.fnl

@@ -18,6 +18,10 @@
                          }
                   })
 
+(local history (require :history))
+(tset _G :history (history.open
+                   (.. (os.getenv "HOME") "/.dunlin-history.db")))
+
 (let [f (Frame.new my-keymap)
       b (Buffer.new "main")]
   (f:show-buffer b)

frame.fnl

@@ -38,12 +38,15 @@
         contentwidget (Gtk.Box {
                                 :orientation Gtk.Orientation.VERTICAL
                                 })
-        update-prop (fn [name value]
+        update-prop (fn [props name value]
                       (match name
                         :estimated-load-progress
                         (tset progress-bar :fraction value)
                         :uri
-                        (tset echo-area :label value)
+                        (do (tset echo-area :label value)
+                            (_G.history:visit value (os.time)))
+                        :title
+                        (_G.history:title self.buffer.properties.uri value)
                         n
                         (comment (print "prop change" n value))))]
 
@@ -91,7 +94,7 @@
                           (b:subscribe-property-changes
                            (fn [name val]
                              (if (= b self.buffer)
-                                 (update-prop name val)
+                                 (update-prop self name val)
                                  (print "ignore props from background" b))))
                           (b.webview:show))
            }]

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
+ }

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
+  '';
+}

test/command.fnl

@@ -20,7 +20,7 @@
 (let [commander (Command.commander)
       (ok err)
       (match-try (commander:activate)
-        {:active true} (commander:on-activate "not-a-command")
+        {:active true} (commander:on-input-finished "not-a-command")
         (where {:error e :active false} (e:match "can't find command")) true
         (catch
          x (values nil (view x))))]
@@ -30,9 +30,9 @@
 (let [commander (Command.commander)
       (ok err)
       (match-try  (commander:activate)
-        {:active true} (commander:on-activate "multiply")
-        {:active true :prompt p1} (commander:on-activate "2")
-        {:active true :prompt p2} (commander:on-activate "3")
+        {:active true} (commander:on-input-finished "multiply")
+        {:active true :prompt p1} (commander:on-input-finished "2")
+        {:active true :prompt p2} (commander:on-input-finished "3")
         (where {:active false} (= happened 6)) true
         (catch
          x (values nil (view x))))]

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