Goodbye, SQLite!

6 files changed, 4 insertions, 273 deletions

diff --git a/Makefile.am b/Makefile.am
index 9426c26..82add7b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -44,7 +44,6 @@ SOURCES =							\
   mumi/web/util.scm					\
   mumi/web/view/html.scm			\
   mumi/web/view/utils.scm			\
-  mumi/bugs.scm						\
   mumi/cache.scm					\
   mumi/messages.scm					\
   mumi/jobs.scm						\
diff --git a/configure.ac b/configure.ac
index bdf2a42..74e937c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -21,11 +21,6 @@ if test "x$have_guile_email" != "xyes"; then
   AC_MSG_ERROR([guile-email is missing; please install it.])
 fi
 
-GUILE_MODULE_AVAILABLE([have_guile_sqlite3], [(sqlite3)])
-if test "x$have_guile_sqlite3" != "xyes"; then
-  AC_MSG_ERROR([Guile-Sqlite3 is missing; please install it.])
-fi
-
 GUILE_MODULE_AVAILABLE([have_mailutils], [(mailutils mailutils)])
 if test "x$have_mailutils" != "xyes"; then
   AC_MSG_ERROR([Mailutils is missing; please install it.])
diff --git a/guix.scm b/guix.scm
index 3d6949f..cbc5e66 100644
--- a/guix.scm
+++ b/guix.scm
@@ -48,7 +48,6 @@
                                               (package-arguments guile-fibers)
                                             ((#:tests? _ #f) #f)))))
      ("guile-redis" ,guile-redis)
-     ("guile-sqlite3" ,guile-sqlite3)
      ("guile-syntax-highlight" ,guile-syntax-highlight)
      ("guile-xapian" ,guile-xapian)
      ("guile-webutils" ,guile-webutils)
diff --git a/mumi/bugs.scm b/mumi/bugs.scm
deleted file mode 100644
index ea85ca2..0000000
--- a/mumi/bugs.scm
+++ /dev/null
@@ -1,249 +0,0 @@
-;;; mumi -- Mediocre, uh, mail interface
-;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
-;;;
-;;; This program is free software: you can redistribute it and/or
-;;; modify it under the terms of the GNU Affero General Public License
-;;; as published by the Free Software Foundation, either version 3 of
-;;; the License, or (at your option) any later version.
-;;;
-;;; This program is distributed in the hope that it will be useful,
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; Affero General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Affero General Public
-;;; License along with this program.  If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-(define-module (mumi bugs)
-  #:use-module (mumi config)
-  #:use-module (mumi debbugs)
-  #:use-module (sqlite3)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
-  #:use-module (srfi srfi-26)
-  #:use-module (ice-9 rdelim)
-  #:use-module (ice-9 format)
-  #:export (db-create!
-            update-bug-database!
-
-            bugs-by-tag
-            bugs-by-severity
-            bugs-by-status
-            bugs-by-submitter
-            bugs-by-owner))
-
-
-;; This procedure and the following two macros have been taken from
-;; Cuirass.
-(define (%sqlite-exec db sql . args)
-  "Evaluate the given SQL query with the given ARGS.  Return the list of
-rows."
-  (define (normalize arg)
-    ;; Turn ARG into a string, unless it's a primitive SQL datatype.
-    (if (or (null? arg) (pair? arg) (vector? arg))
-        (object->string arg)
-        arg))
-
-  (let ((stmt (sqlite-prepare db sql #:cache? #t)))
-    (for-each (lambda (arg index)
-                (sqlite-bind stmt index (normalize arg)))
-              args (iota (length args) 1))
-    (let ((result (sqlite-fold-right cons '() stmt)))
-      (sqlite-finalize stmt)
-      result)))
-
-(define-syntax sqlite-exec/bind
-  (lambda (s)
-    ;; Expand to an '%sqlite-exec' call where the query string has
-    ;; interspersed question marks and the argument list is separate.
-    (define (string-literal? s)
-      (string? (syntax->datum s)))
-
-    (syntax-case s ()
-      ((_ db (bindings ...) tail str arg rest ...)
-       #'(sqlite-exec/bind db
-                           (bindings ... (str arg))
-                           tail
-                           rest ...))
-      ((_ db (bindings ...) tail str)
-       #'(sqlite-exec/bind db (bindings ...) str))
-      ((_ db ((strings args) ...) tail)
-       (and (every string-literal? #'(strings ...))
-            (string-literal? #'tail))
-       ;; Optimized case: only string literals.
-       (with-syntax ((query (string-join
-                             (append (syntax->datum #'(strings ...))
-                                     (list (syntax->datum #'tail)))
-                             "? ")))
-         #'(%sqlite-exec db query args ...)))
-      ((_ db ((strings args) ...) tail)
-       ;; Fallback case: some of the strings aren't literals.
-       #'(%sqlite-exec db (string-join (list strings ... tail) "? ")
-                       args ...)))))
-
-(define-syntax-rule (sqlite-exec db query args ...)
-  "Execute the specific QUERY with the given ARGS.  Uses of 'sqlite-exec'
-typically look like this:
-
-  (sqlite-exec db \"SELECT * FROM Foo WHERE x = \"
-                  x \"AND Y=\" y \";\")
-
-References to variables 'x' and 'y' here are replaced by question marks in the
-SQL query, and then 'sqlite-bind' is used to bind them.
-
-This ensures that (1) SQL injection is impossible, and (2) the number of
-question marks matches the number of arguments to bind."
-  (sqlite-exec/bind db () "" query args ...))
-
-(define (last-insert-rowid db)
-  (vector-ref (car (sqlite-exec db "SELECT last_insert_rowid();"))
-              0))
-
-(define %db-name
-  (string-append (%config 'db-dir) "/bugs.db"))
-
-(define* (with-db proc #:key write?)
-  (let ((db (sqlite-open %db-name (logior (if write?
-                                              SQLITE_OPEN_READWRITE
-                                              SQLITE_OPEN_READONLY)
-                                          SQLITE_OPEN_NOMUTEX))))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (proc db))
-      (lambda () (sqlite-close db)))))
-
-(define (read-sql-file file-name)
-  "Return a list of string containing SQL instructions from FILE-NAME."
-  (call-with-input-file file-name
-    (lambda (port)
-      (let loop ((insts '()))
-        (let ((inst (read-delimited ";" port 'concat)))
-          (if (or (eof-object? inst)
-                  ;; Don't cons the spaces after the last instructions.
-                  (string-every char-whitespace? inst))
-              (reverse! insts)
-              (loop (cons inst insts))))))))
-
-(define (db-load db schema)
-  "Evaluate the file SCHEMA, which may contain SQL queries, into DB."
-  (for-each (cut sqlite-exec db <>)
-            (read-sql-file schema)))
-
-(define (db-create!)
-  (unless (file-exists? %db-name)
-    (let ((db (sqlite-open %db-name (logior SQLITE_OPEN_CREATE
-                                            SQLITE_OPEN_READWRITE
-                                            SQLITE_OPEN_NOMUTEX))))
-      (db-load db (string-append (%config 'pkg-dir) "/schema.sql"))
-      db)))
-
-
-(define (add-bug! id submitter owner status severity tags)
-  "Record a new bug with the given fields, or update an existing
-record."
-  (let ((tag-string
-         (if tags (string-append "|"
-                                 (string-join (string-split tags #\space) "|" 'suffix))
-             "")))
-    (with-db (lambda (db)
-               (sqlite-exec db
-                            "INSERT INTO bugs (id, submitter, owner, status, severity, tags) VALUES ("
-                            id "," submitter "," owner "," status "," severity "," tag-string
-                            ") ON CONFLICT(id) DO UPDATE SET \
-status=excluded.status,\
-submitter=excluded.submitter,\
-owner=excluded.owner,\
-severity=excluded.severity,\
-tags=excluded.tags;")
-               (last-insert-rowid db))
-             #:write? #t)))
-
-(define (bugs-by-status status)
-  "Return all bug ids with the given STATUS."
-  (map (cut vector-ref <> 0)
-       (with-db
-        (lambda (db)
-          (sqlite-exec db
-                       "SELECT id FROM bugs WHERE status = " status ";")))))
-
-(define (bugs-by-severity severity)
-  "Return all bug ids with the given SEVERITY."
-  (map (cut vector-ref <> 0)
-       (with-db
-        (lambda (db)
-          (sqlite-exec db
-                       "SELECT id FROM bugs WHERE severity = " severity ";")))))
-
-(define (bugs-by-submitter submitter)
-  "Return all bug ids with the given SUBMITTER."
-  (map (cut vector-ref <> 0)
-       (with-db
-        (lambda (db)
-          (sqlite-exec db
-                       "SELECT id FROM bugs WHERE submitter LIKE "
-                       (string-append "%" submitter "%") ";")))))
-
-(define (bugs-by-owner owner)
-  "Return all bug ids with the given OWNER."
-  (map (cut vector-ref <> 0)
-       (with-db
-        (lambda (db)
-          (sqlite-exec db
-                       "SELECT id FROM bugs WHERE owner LIKE "
-                       (string-append "%" owner "%") ";")))))
-
-(define (bugs-by-tag tag)
-  "Return all bug ids that match the given TAG."
-  (map (cut vector-ref <> 0)
-       (with-db
-        (lambda (db)
-          (sqlite-exec db
-                       "SELECT id FROM bugs WHERE tags LIKE "
-                       (string-append "%|" tag "|%") ";")))))
-
-(define (bug-ids)
-  "Return all bug ids."
-  (map (cut vector-ref <> 0)
-       (with-db
-        (lambda (db)
-          (sqlite-exec db "SELECT id FROM bugs;")))))
-
-(define* (update-bug-database! #:optional bug-nums)
-  (define chunk-size 400)
-  (define (safe-split lst n)
-    (catch #t
-      (lambda ()
-        (split-at lst n))
-      (lambda _
-        (values lst '()))))
-  (let* ((packages (%config 'packages))
-         (bug-nums (or bug-nums
-                       (apply lset-adjoin =
-                              (append (extract-bug-numbers packages)
-                                      (extract-bug-numbers packages #:archived? #t))
-                              (bug-ids))))
-         (total (length bug-nums)))
-    (display "updating bug database...")
-    ;; Process bugs in chunks
-    (let loop ((lst bug-nums))
-      (let-values (((chunk tail) (safe-split lst chunk-size)))
-        (let ((bugs (map bug-status chunk)))
-          (for-each (lambda (bug)
-                      (add-bug! (bug-num bug)
-                                (bug-originator bug)
-                                (bug-owner bug)
-                                (cond
-                                 ((bug-done bug) "done")
-                                 (else "open"))
-                                (bug-severity bug)
-                                (bug-tags bug)))
-                    bugs)
-          (let* ((done (- total (length tail)))
-                 (ratio (/ done total)))
-            (if (eq? done total)
-                (display "100%!" (current-error-port))
-                (format (current-error-port)
-                        "~,1f%..." (exact->inexact (* 100 ratio))))))
-        (if (null? tail) (newline (current-error-port)) (loop tail))))))
diff --git a/mumi/messages.scm b/mumi/messages.scm
index 7efd74e..538c0de 100644
--- a/mumi/messages.scm
+++ b/mumi/messages.scm
@@ -31,7 +31,6 @@
   #:use-module (mumi config)
   #:use-module (mumi debbugs)
   #:use-module (mumi xapian)
-  #:use-module ((mumi bugs) #:prefix db:)
   #:use-module (web client)
   #:export (search-bugs
             fetch-bug
@@ -224,17 +223,13 @@ about."
 
 (define (easy-bugs)
   "Return all bugs that have been tagged \"easy\"."
-  (let ((ids (db:bugs-by-tag "easy")))
-    (status-with-cache ids)))
+  (search-bugs "tag:easy"))
 
 (define* (bugs-by-severity severity #:optional status)
   "Return severe bugs."
-  (let* ((severity-ids (db:bugs-by-severity severity))
-         (ids (if status
-                  (let ((status-ids (db:bugs-by-status status)))
-                    (lset-intersection eq? severity-ids status-ids))
-                  severity-ids)))
-    (status-with-cache ids)))
+  (search-bugs (if status
+                   (format #f "severity:~a status:~a" severity status)
+                   (format #f "severity:~a" severity))))
 
 (define punctuation?
   (cut char-set-contains? char-set:punctuation <>))
diff --git a/scripts/mumi.in b/scripts/mumi.in
index 67dad78..2d4b28f 100644
--- a/scripts/mumi.in
+++ b/scripts/mumi.in
@@ -29,8 +29,6 @@
              (mumi config)
              ((mumi debbugs)
               #:select (extract-bug-numbers))
-             ((mumi bugs)
-              #:select (db-create! update-bug-database!))
              ((mumi jobs)
               #:select (worker-loop))
              ((mumi web server)
@@ -38,8 +36,6 @@
              ((mumi xapian)
               #:select (index!)))
 
-(db-create!)
-
 (define %default-repl-server-port
   ;; Default port to run REPL server on, if --listen-repl is provided
   ;; but no port is mentioned
@@ -58,10 +54,6 @@
             (display "Starting full indexing." (current-error-port))
             (newline (current-error-port)))
           (index! #:full? (zero? count))
-          (let* ((packages (%config 'packages))
-                 (nums (append (extract-bug-numbers packages)
-                               (extract-bug-numbers packages #:archived? #t))))
-            (update-bug-database! nums))
           (and loop?
                (begin
                  (format (current-error-port)