[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Ricardo Wurmus |
|
Date: |
Sat, 18 May 2019 01:12:07 -0400 (EDT) |
branch: master
commit ce114d8446b3d95c08129d10d5aeb2038d545228
Author: Ricardo Wurmus <address@hidden>
Date: Fri May 17 22:33:27 2019 +0200
cuirass: Add search for builds.
* src/cuirass/database.scm (db-get-builds-by-search,
db-get-builds-query-min,
db-get-builds-query-max): New procedures.
* src/cuirass/http.scm (handle-builds-search-request): New procedure.
(url-handler): Handle "search" route.
* src/cuirass/templates.scm (search-form): New variable.
(html-page): Use it.
(build-search-results-table): New procedure.
---
src/cuirass/database.scm | 71 ++++++++++++++++++++++++
src/cuirass/http.scm | 32 +++++++++++
src/cuirass/templates.scm | 137 +++++++++++++++++++++++++++++++++++++++++++---
3 files changed, 231 insertions(+), 9 deletions(-)
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 33705b5..89e3e83 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2018 Ludovic Courtès <address@hidden>
;;; Copyright © 2018 Clément Lassieur <address@hidden>
;;; Copyright © 2018 Tatiana Sholokhova <address@hidden>
+;;; Copyright © 2019 Ricardo Wurmus <address@hidden>
;;;
;;; This file is part of Cuirass.
;;;
@@ -47,8 +48,11 @@
db-update-build-status!
db-get-build
db-get-builds
+ db-get-builds-by-search
db-get-builds-min
db-get-builds-max
+ db-get-builds-query-min
+ db-get-builds-query-max
db-get-evaluations
db-get-evaluations-build-summary
db-get-evaluations-id-min
@@ -552,6 +556,59 @@ WHERE derivation =" derivation ";"))
(('order . 'status+submission-time) "status DESC, timestamp DESC")
(_ "rowid DESC")))
+(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,
+border-low-id, border-high-id, and nr."
+ (with-db-critical-section db
+ (let* ((stmt-text (format #f "SELECT * FROM (
+SELECT Builds.rowid, Builds.timestamp, Builds.starttime,
+Builds.stoptime, Builds.log, Builds.status, Builds.job_name, Builds.system,
+Builds.nix_name, Specifications.name
+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 (:borderlowid IS NULL
+ OR (:borderlowid < Builds.rowid))
+AND (:borderhighid IS NULL
+ OR (:borderhighid > Builds.rowid))
+ORDER BY
+CASE WHEN :borderlowid IS NULL THEN Builds.rowid
+ ELSE -Builds.rowid
+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)))
+ (sqlite-reset stmt)
+ (let loop ((rows (sqlite-fold-right cons '() stmt))
+ (builds '()))
+ (match rows
+ (() (reverse builds))
+ ((#(id timestamp starttime stoptime log status job-name
+ system nix-name specification) . rest)
+ (loop rest
+ (cons `((#:id . ,id)
+ (#:timestamp . ,timestamp)
+ (#:starttime . ,starttime)
+ (#:stoptime . ,stoptime)
+ (#:log . ,log)
+ (#:status . ,status)
+ (#:job-name . ,job-name)
+ (#:system . ,system)
+ (#:nix-name . ,nix-name)
+ (#:specification . ,specification))
+ builds))))))))
+
(define (db-get-builds filters)
"Retrieve all builds in the database which are matched by given FILTERS.
FILTERS is an assoc list whose possible keys are 'derivation | 'id | 'jobset |
@@ -723,6 +780,20 @@ SELECT MAX(id) FROM Evaluations
WHERE specification=" spec)))
(and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+(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))))
+
+(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))))
+
(define (db-get-builds-min eval status)
"Return the min build (stoptime, rowid) pair for the given evaluation EVAL
and STATUS."
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 92f1ca6..48a2b39 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2018 Ludovic Courtès <address@hidden>
;;; Copyright © 2018 Clément Lassieur <address@hidden>
;;; Copyright © 2018 Tatiana Sholokhova <address@hidden>
+;;; Copyright © 2019 Ricardo Wurmus <address@hidden>
;;;
;;; This file is part of Cuirass.
;;;
@@ -116,6 +117,13 @@ Hydra format."
(db-get-builds filters))))
(map build->hydra-build builds)))
+(define (handle-builds-search-request filters)
+ "Retrieve all builds matched by FILTERS in the database and convert them to
+Hydra format."
+ (let ((builds (with-time-logging "builds search request"
+ (db-get-builds-by-search filters))))
+ (map build->hydra-build builds)))
+
(define (request-parameters request)
"Parse the REQUEST query parameters and return them under the form
'((parameter . value) ...)."
@@ -341,6 +349,30 @@ Hydra format."
(#:link . ,(string-append "/eval/" id))))))
(respond-html-eval-not-found id))))
+ (("search")
+ (let* ((params (request-parameters request))
+ (query (assq-ref params 'query))
+ (builds-id-min (db-get-builds-query-min query))
+ (builds-id-max (db-get-builds-query-max query))
+ (border-low-id (assq-ref params 'border-low-id))
+ (border-high-id (assq-ref params 'border-high-id)))
+ (if query
+ (respond-html
+ (html-page
+ "Search results"
+ (build-search-results-table
+ query
+ (handle-builds-search-request
+ `((query . ,query)
+ (nr . ,%page-size)
+ (order . finish-time+build-id)
+ (border-low-id . ,border-low-id)
+ (border-high-id . ,border-high-id)))
+ builds-id-min
+ builds-id-max)
+ '()))
+ (respond-json-with-error 500 "Query parameter not provided!"))))
+
(("static" path ...)
(respond-static-file path))
('method-not-allowed
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 8ef3275..011d2ec 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -1,6 +1,7 @@
;;; templates.scm -- HTTP API
;;; Copyright © 2018 Tatiana Sholokhova <address@hidden>
;;; Copyright © 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2019 Ricardo Wurmus <address@hidden>
;;;
;;; This file is part of Cuirass.
;;;
@@ -27,7 +28,8 @@
#:export (html-page
specifications-table
evaluation-info-table
- build-eval-table))
+ build-eval-table
+ build-search-results-table))
(define (navigation-items navigation)
(match navigation
@@ -39,6 +41,23 @@
,(assq-ref item #:name)))
(navigation-items rest)))))
+(define search-form
+ `(form (@ (id "search")
+ (class "form-inline")
+ (action "/search"))
+ (div
+ (@ (class "input-group"))
+ (input (@ (type "text")
+ (class "form-control")
+ (id "query")
+ (name "query")
+ (placeholder "search for builds")))
+ (span (@ (class "input-group-append"))
+ (button
+ (@ (type "submit")
+ (class "btn btn-primary"))
+ "Search")))))
+
(define (html-page title body navigation)
"Return HTML page with given TITLE and BODY."
`(html (@ (xmlns "http://www.w3.org/1999/xhtml";)
@@ -64,14 +83,15 @@
(alt "logo")
(height "25")
(style "margin-top: -12px"))))
- (div (@ (class "navbar-nav-scroll"))
- (ul (@ (class "navbar-nav"))
- (li (@ (class "nav-item"))
- (a (@ (class "nav-link" ,(if (null? navigation)
- " active" ""))
- (href "/"))
- Home))
- ,@(navigation-items navigation))))
+ (div (@ (class "navbar-collapse"))
+ (ul (@ (class "navbar-nav"))
+ (li (@ (class "nav-item"))
+ (a (@ (class "nav-link" ,(if (null?
navigation)
+ " active" ""))
+ (href "/"))
+ Home))
+ ,@(navigation-items navigation)))
+ ,search-form)
(main (@ (role "main") (class "container pt-4 px-1"))
,body
(hr)))))
@@ -341,3 +361,102 @@ and BUILD-MAX are global minimal and maximal (stoptime,
rowid) pairs."
(build-stoptime build-min)
(1- (build-id build-min))
status))))))
+
+(define (build-search-results-table query builds build-min build-max)
+ "Return HTML for the BUILDS table evaluation matching QUERY. BUILD-MIN
+and BUILD-MAX are global minimal and maximal row identifiers."
+ (define (table-header)
+ `(thead
+ (tr
+ (th (@ (scope "col")) '())
+ (th (@ (scope "col")) "ID")
+ (th (@ (scope "col")) "Specification")
+ (th (@ (scope "col")) "Completion time")
+ (th (@ (scope "col")) "Job")
+ (th (@ (scope "col")) "Name")
+ (th (@ (scope "col")) "System")
+ (th (@ (scope "col")) "Log"))))
+
+ (define (table-row build)
+ (define status
+ (assq-ref build #:buildstatus))
+
+ (define completed?
+ (or (= (build-status succeeded) status)
+ (= (build-status failed) status)))
+
+ `(tr
+ (td ,(cond
+ ((= (build-status succeeded) status)
+ `(span (@ (class "oi oi-check text-success")
+ (title "Succeeded")
+ (aria-hidden "true"))
+ ""))
+ ((= (build-status scheduled) status)
+ `(span (@ (class "oi oi-clock text-warning")
+ (title "Scheduled")
+ (aria-hidden "true"))
+ ""))
+ ((= (build-status canceled) status)
+ `(span (@ (class "oi oi-question-mark text-warning")
+ (title "Canceled")
+ (aria-hidden "true"))
+ ""))
+ ((= (build-status failed-dependency) status)
+ `(span (@ (class "oi oi-warning text-danger")
+ (title "Dependency failed")
+ (aria-hidden "true"))
+ ""))
+ (else
+ `(span (@ (class "oi oi-x text-danger")
+ (title "Failed")
+ (aria-hidden "true"))
+ ""))))
+ (th (@ (scope "row")),(assq-ref build #:id))
+ (td ,(assq-ref build #:jobset))
+ (td ,(if completed?
+ (time->string (assq-ref build #:stoptime))
+ "—"))
+ (td ,(assq-ref build #:job))
+ (td ,(assq-ref build #:nixname))
+ (td ,(assq-ref build #:system))
+ (td ,(if completed?
+ `(a (@ (href "/build/" ,(assq-ref build #:id) "/log/raw"))
+ "raw")
+ "—"))))
+
+ `((p (@ (class "lead"))
+ ,(format #f "Builds matching ~a" query))
+ (table
+ (@ (class "table table-sm table-hover table-striped"))
+ ,@(if (null? builds)
+ `((th (@ (scope "col")) "No elements here."))
+ `(,(table-header)
+ (tbody ,@(map table-row builds)))))
+
+ ,(if (null? builds)
+ (pagination "" "" "" "")
+ (let* ((build-ids (map (lambda (row) (assq-ref row #:id)) builds))
+ (page-build-min (last build-ids))
+ (page-build-max (first build-ids)))
+ (pagination
+ (format
+ #f "?query=~a&border-high-id=~d"
+ query
+ (1+ (first build-max)))
+ (if (equal? page-build-max (first build-max))
+ ""
+ (format
+ #f "?query=~a&border-low-id=~d"
+ query
+ page-build-max))
+ (if (equal? page-build-min (first build-min))
+ ""
+ (format
+ #f "?query=~a&border-high-id=~d"
+ query
+ page-build-min))
+ (format
+ #f "?query=~a&border-low-id=~d"
+ query
+ (1- (first build-min))))))))