From 34fb1b2ff44f2a016a58f74cfbf72538340ee321 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Sun, 15 Jan 2023 13:04:35 +0000
Subject: [PATCH] revisit completer/completion api

A completion is now a table with attributes :text, :widget, :value
A completer returns an array of completions

This means we can now render URL completions with the page title
as well as the URL
---
 buffer.fnl       |  4 ++--
 command.fnl      | 45 +++++++++++++++++++++++++++++++++------------
 history.fnl      |  7 +++++++
 test/command.fnl | 11 +++++++++--
 4 files changed, 51 insertions(+), 16 deletions(-)

diff --git a/buffer.fnl b/buffer.fnl
index f54c369..fb4440f 100644
--- a/buffer.fnl
+++ b/buffer.fnl
@@ -44,9 +44,9 @@
    :find (fn [term] (. buffers term))
    ;; will rename this to "find" once we've got rid of the
    ;; only remaining call to the existing Buffer.find
-   :match (fn [s] (collect [name buffer (pairs buffers)]
+   :match (fn [s] (icollect [name buffer (pairs buffers)]
                     (if (string.find name s)
-                        (values name buffer))))
+                        (values buffer))))
    :next (fn [buffer]
            (let [n (or (next buffers buffer.name) (next buffers))]
              (. buffers n)))
diff --git a/command.fnl b/command.fnl
index 77a1ca6..620b88a 100644
--- a/command.fnl
+++ b/command.fnl
@@ -17,15 +17,24 @@
            : params}]
     (tset commands name v)))
 
+(fn completion [{: widget : text : value }]
+  (let [value (or value (assert text "must have text"))]
+    {
+     :widget (or widget (Gtk.Button { :label text }))
+     : text
+     : value
+     }))
+
 (define-command
  "quit-browser"
  []
  #(Gtk.main_quit))
 
+
 (define-command
  "switch-to-buffer"
  [[:buffer
-   Buffer.match
+   #(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 }))
    #(. (Buffer.next $1.buffer) :name)]
   ]
  (fn [{:frame frame :buffer buffer}]
@@ -34,10 +43,18 @@
 (define-command
  "visit-location"
  [[:buffer
-   Buffer.match
+   #(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 }))
    #$1.buffer.name]
   [:url
-   (fn [term] (collect [v (_G.history:find term)] (values v.url v.url)))
+   (fn [term]
+     (if (> (# term) 2)
+         (icollect [v (_G.history:find-distinct term)]
+           (let [label (.. v.url " " (or v.title ""))]
+             (completion { :text v.url
+                           :widget (Gtk.Button { : label })
+                           :value v.url
+                           })))
+         []))
    #($1.buffer:location)]
   ]
  (fn [{:url url :buffer buffer}]
@@ -45,7 +62,9 @@
 
 (define-command
  "back"
- [[:buffer Buffer.match #$1.buffer.name]]
+ [[:buffer
+   #(lume.map (Buffer.match $1) #(completion { :text $1.name :value $1 }))
+   #$1.buffer.name]]
  (fn [{: buffer}] (buffer:back)))
 
 (fn find-command [name]
@@ -96,8 +115,9 @@
       {:command c :this-param k :collected-params p}
       (let [{ : completer}  (. c.params k)
             vals (completer input-string)
-            value (. vals input-string)]
-        (tset p k value)
+            chosen (lume.match vals #(= $1.text input-string))]
+        (assert chosen (view { : vals : input-string }))
+        (tset p k chosen.value)
         (state-for-next-param c p))
 
       {:command c :this-param nil :collected-params p}
@@ -133,13 +153,13 @@
         set-completions
         (fn [completions]
           (parent:foreach #(parent:remove $1))
-          (each [text _w (pairs completions)]
+          (each [_ c (pairs completions)]
             (parent:add
-             (Gtk.Button {
-                          :label text
-                          :on_clicked
-                          #(update-widget-state self (self:on-input-finished text))
-                          })))
+             (doto c.widget
+               (tset :on_clicked
+                     #(update-widget-state
+                       self
+                       (self:on-input-finished c.text))))))
           (parent:show_all))]
     (match self.state
       {:command c :this-param param-name}
@@ -223,4 +243,5 @@
 {
  :commander new-commander
  : define-command
+ : completion
  }
diff --git a/history.fnl b/history.fnl
index e152732..a508371 100644
--- a/history.fnl
+++ b/history.fnl
@@ -41,6 +41,12 @@
     (assert (= 0 (s:bind_values term)))
     (s:nrows)))
 
+(fn find-distinct [self term]
+  (print :self self :term term)
+  (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")]
+    (assert (= 0 (s:bind_values term)))
+    (s:nrows)))
+
 (fn open [pathname]
   (let [db (if pathname (sqlite.open pathname) (sqlite.open_memory))]
     (migrate-all db)
@@ -49,6 +55,7 @@
      : visit
      : title
      : find
+     : find-distinct
      }))
 
 {
diff --git a/test/command.fnl b/test/command.fnl
index 8982661..5ae41e7 100644
--- a/test/command.fnl
+++ b/test/command.fnl
@@ -5,6 +5,13 @@
 (var happened false)
 (fn before [] (set happened false))
 
+(assert
+ (match (Command.completion { :text "foo" })
+   (where { : widget : text : value }
+     (= text "foo")
+     (= value "foo"))
+   true))
+
 (Command.define-command
  "no-args-command"
  []
@@ -12,8 +19,8 @@
 
 (Command.define-command
  "multiply"
- [[:a #{$1 $1} #"3"]
-  [:b #{$1 $1} #"2"]]
+ [[:a #[(Command.completion {:text $1})] #"3"]
+  [:b #[(Command.completion {:text $1})] #"2"]]
  (fn [{: a : b }] (set happened (* (tonumber a) (tonumber b)))))
 
 (before)