From 9017b9fbc15178a1e6c4c50886c532df9a63328e Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Tue, 21 May 2019 11:40:28 +0200
Subject: database: Support advanced query strings.

* src/cuirass/database.scm (query->bind-arguments): New procedure.
(db-get-builds-by-search): Support filtering by spec and system.
(db-get-builds-query-min, db-get-builds-query-max): Adjust.
---
 src/cuirass/database.scm | 76 ++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 61 insertions(+), 15 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 89e3e83..be7ae8d 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -556,6 +556,24 @@ WHERE derivation =" derivation ";"))
     (('order . 'status+submission-time) "status DESC, timestamp DESC")
     (_ "rowid DESC")))
 
+(define (query->bind-arguments query-string)
+  "Return a list of keys to query strings by parsing QUERY-STRING."
+  (let ((args (append-map (lambda (token)
+                            (match (string-split token #\:)
+                              (("system" system)
+                               `(#:system ,system))
+                              (("spec" spec)
+                               `(#:spec ,spec))
+                              ((query)
+                               `(#:query ,(string-append query "-%")))))
+                          (string-tokenize query-string))))
+    ;; Normalize arguments
+    (fold (lambda (key acc)
+            (if (member key acc)
+                acc
+                (append (list key #f) acc)))
+          args '(#:spec #:system))))
+
 (define (db-get-builds-by-search filters)
   "Retrieve all builds in the database which are matched by given FILTERS.
 FILTERS is an assoc list whose possible keys are the symbols query,
@@ -569,6 +587,10 @@ FROM Builds
 INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
 INNER JOIN Specifications ON Evaluations.specification = Specifications.name
 WHERE (Builds.nix_name LIKE :query)
+AND (:spec IS NULL
+ OR (Specifications.name = :spec))
+AND (:system IS NULL
+ OR (Builds.system = :system))
 AND (:borderlowid IS NULL
  OR (:borderlowid < Builds.rowid))
 AND (:borderhighid IS NULL
@@ -580,15 +602,15 @@ END DESC
 LIMIT :nr)
 ORDER BY rowid DESC;"))
            (stmt (sqlite-prepare db stmt-text #:cache? #t)))
-      (sqlite-bind-arguments
-       stmt
-       #:query (and=> (assq-ref filters 'query)
-                      (lambda (query) (string-append query "-%")))
-       #:borderlowid (assq-ref filters 'border-low-id)
-       #:borderhighid (assq-ref filters 'border-high-id)
-       #:nr (match (assq-ref filters 'nr)
-              (#f -1)
-              (x x)))
+      (apply sqlite-bind-arguments
+             stmt
+             (append (list
+                      #:borderlowid (assq-ref filters 'border-low-id)
+                      #:borderhighid (assq-ref filters 'border-high-id)
+                      #:nr (match (assq-ref filters 'nr)
+                             (#f -1)
+                             (x x)))
+                     (query->bind-arguments (assq-ref filters 'query))))
       (sqlite-reset stmt)
       (let loop ((rows (sqlite-fold-right cons '() stmt))
                  (builds '()))
@@ -783,16 +805,40 @@ WHERE specification=" spec)))
 (define (db-get-builds-query-min query)
   "Return the smallest build row identifier matching QUERY."
   (with-db-critical-section db
-    (let ((rows (sqlite-exec db "
-SELECT MIN(rowid) FROM Builds WHERE nix_name LIKE " (string-append query "-%"))))
-      (and=> (expect-one-row rows) vector->list))))
+    (let* ((stmt-text "SELECT MIN(Builds.rowid) FROM Builds
+INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
+INNER JOIN Specifications ON Evaluations.specification = Specifications.name
+WHERE (Builds.nix_name LIKE :query)
+AND (:spec IS NULL
+ OR (Specifications.name = :spec))
+AND (:system IS NULL
+ OR (Builds.system = :system));")
+           (stmt (sqlite-prepare db stmt-text #:cache? #t)))
+      (apply sqlite-bind-arguments stmt
+             (query->bind-arguments query))
+      (sqlite-reset stmt)
+      (let ((rows (sqlite-fold-right cons '() stmt)))
+        (sqlite-finalize stmt)
+        (and=> (expect-one-row rows) vector->list)))))
 
 (define (db-get-builds-query-max query)
   "Return the largest build row identifier matching QUERY."
   (with-db-critical-section db
-    (let ((rows (sqlite-exec db "
-SELECT MAX(rowid) FROM Builds WHERE nix_name LIKE " (string-append query "-%"))))
-      (and=> (expect-one-row rows) vector->list))))
+    (let* ((stmt-text "SELECT MAX(Builds.rowid) FROM Builds
+INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
+INNER JOIN Specifications ON Evaluations.specification = Specifications.name
+WHERE (Builds.nix_name LIKE :query)
+AND (:spec IS NULL
+ OR (Specifications.name = :spec))
+AND (:system IS NULL
+ OR (Builds.system = :system));")
+           (stmt (sqlite-prepare db stmt-text #:cache? #t)))
+      (apply sqlite-bind-arguments stmt
+             (query->bind-arguments query))
+      (sqlite-reset stmt)
+      (let ((rows (sqlite-fold-right cons '() stmt)))
+        (sqlite-finalize stmt)
+        (and=> (expect-one-row rows) vector->list)))))
 
 (define (db-get-builds-min eval status)
   "Return the min build (stoptime, rowid) pair for the given evaluation EVAL
-- 
cgit v1.2.3