maurice/snix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat(web/panettone): Support full-text search of issues

Browse source 
Support basic full text search of issues using postgresql's built-in
text search. There's a new column on the issues table called `tsv`,
which contains a tsvector of the title concatenated with the
description, and a new search form on both the index and closed issues
page which allows searching that tsvector with a user-supplied query.
Results are ranked according to that text query in the case of a search.

This works fine for now, but next up I'd also like to highlight the
results according to the bits that matched the user's query.

Change-Id: I25170bedbbbcdc3ed29a047962e9fcfe280d763a
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11258
Autosubmit: aspen <root@gws.fyi>
Tested-by: BuildkiteCI
Reviewed-by: sterni <sternenseemann@systemli.org>
This commit is contained in:
Aspen Smith 2024-03-24 14:31:47 -04:00 • committed by aspen
parent 7f3d93942a
commit a80c0ce95f
7 changed files with 126 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

44
web/panettone/src/model.lisp
View file

@ -1,6 +1,8 @@
(in-package :panettone.model)
(declaim (optimize (safety 3)))
(setq pomo:*ignore-unknown-columns* t)
(defvar *pg-spec* nil
"Connection spec for use with the with-connection macro. Needs to be
initialised at launch time.")
@ -226,14 +228,8 @@ its new value will be formatted using ~A into NEW-VALUE"))
(unless (table-exists-p (dao-table-name 'migration))
(create-table 'migration)))
(defvar *migrations-dir*
;; Let the nix build override the migrations dir for us
(or (when-let ((package (find-package :build)))
(let ((sym (find-symbol "*MIGRATIONS-DIR*" package)))
(when (boundp sym)
(symbol-value sym))))
"migrations/")
"The directory where migrations are stored")
(define-build-time-var *migrations-dir* "migrations/"
"The directory where migrations are stored")
(defun load-migration-docstring (migration-path)
"If the first form in the file pointed to by `migration-pathname` is
@ -281,12 +277,9 @@ its new value will be formatted using ~A into NEW-VALUE"))
(insert-dao migration)))
(defun list-migration-files ()
(let ((dir (if (char-equal (uiop:last-char *migrations-dir*) #\/)
*migrations-dir*
(concatenate 'string *migrations-dir* "/"))))
(remove-if-not
(lambda (pn) (string= "lisp" (pathname-type pn)))
(uiop:directory-files dir))))
(remove-if-not
(lambda (pn) (string= "lisp" (pathname-type pn)))
(uiop:directory-files (util:->dir *migrations-dir*))))
(defun load-migrations ()
(mapcar #'load-migration (list-migration-files)))
@ -392,24 +385,31 @@ type `ISSUE-NOT-FOUND'."
:where (:= 'id id))))
:single))
(defun list-issues (&key status (with '(:num-comments)))
(defun list-issues (&key status search (with '(:num-comments)))
"Return a list of all issues with the given STATUS (or all if nil), ordered by
ID descending. If WITH contains `:NUM-COMMENTS' (the default) each issue will
have the `num-comments' slot filled with the number of comments on that issue
(to avoid N+1 queries)."
(let* ((condition (unless (null status)
`(:where (:= status $1))))
(let* ((conditions
(and-where*
(unless (null status)
`(:= status $1))
(when (str:non-blank-string-p search)
`(:@@ tsv (:websearch-to-tsquery ,search)))))
(select (if (find :num-comments with)
`(:select issues.* (:as (:count issue-comments.id)
num-comments)
:from issues
:left-join issue-comments
:on (:= issues.id issue-comments.issue-id)
,@condition
:where ,conditions
:group-by issues.id)
`(:select * :from issues ,@condition)))
`(:select * :from issues :where ,conditions)))
(order (if (str:non-blank-string-p search)
`(:desc (:ts-rank-cd tsv (:websearch-to-tsquery ,search)))
`(:desc id)))
(query (sql-compile
`(:order-by ,select (:desc id)))))
`(:order-by ,select ,order))))
(with-column-writers ('num_comments 'num-comments)
(query-dao 'issue query status))))
@ -570,8 +570,8 @@ explicitly subscribing to / unsubscribing from individual issues."
;; Creating new migrations
(setq *migrations-dir* (merge-pathnames "migrations/"))
(generate-migration "init-schema"
:documentation "Initialize the database schema")
(generate-migration "add-issue-tsv"
:documentation "Add tsvector for full-text search of issues")
;; Running migrations
(with-connection *pg-spec*