diff options
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 11 | ||||
| -rw-r--r-- | guix-data-service/web/controller.scm | 29 | ||||
| -rw-r--r-- | guix-data-service/web/view/html.scm | 19 |
3 files changed, 46 insertions, 13 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 8c2e3a9..311bdcd 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -15,7 +15,8 @@ #:use-module (guix-data-service model guix-revision-package) #:use-module (guix-data-service model package-metadata) #:use-module (guix-data-service model derivation) - #:export (process-next-load-new-guix-revision-job)) + #:export (process-next-load-new-guix-revision-job + select-job-for-commit)) (define (inferior-guix->package-ids store conn inf) (let* ((packages (inferior-packages inf)) @@ -145,6 +146,14 @@ (commit commit))))) (extract-information-from store conn url commit store-item))))) +(define (select-job-for-commit conn commit) + (let ((result + (exec-query + conn + "SELECT * FROM load_new_guix_revision_jobs WHERE commit = $1" + (list commit)))) + result)) + (define (process-next-load-new-guix-revision-job conn) (let ((next (exec-query diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 5591488..e671082 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -27,6 +27,7 @@ #:use-module (squee) #:use-module (guix-data-service comparison) #:use-module (guix-data-service model guix-revision) + #:use-module (guix-data-service jobs load-new-guix-revision) #:use-module (guix-data-service web render) #:use-module (guix-data-service web util) #:use-module (guix-data-service web view html) @@ -68,12 +69,16 @@ (let ((base-revision-id (commit->revision-id conn base-commit)) (target-revision-id (commit->revision-id conn target-commit))) (cond - ((eq? base-revision-id #f) + ((not (and base-revision-id target-revision-id)) (apply render-html - (compare-unknown-commit base-commit))) - ((eq? target-revision-id #f) - (apply render-html - (compare-unknown-commit target-commit))) + (compare-unknown-commit base-commit + target-commit + (if base-revision-id #t #f) + (if target-revision-id #t #f) + (select-job-for-commit conn + base-commit) + (select-job-for-commit conn + target-commit)))) (else (let-values (((base-packages-vhash target-packages-vhash) @@ -114,12 +119,16 @@ (let ((base-revision-id (commit->revision-id conn base-commit)) (target-revision-id (commit->revision-id conn target-commit))) (cond - ((eq? base-revision-id #f) - (apply render-html - (compare-unknown-commit base-commit))) - ((eq? target-revision-id #f) + ((not (and base-revision-id target-revision-id)) (apply render-html - (compare-unknown-commit target-commit))) + (compare-unknown-commit base-commit + target-commit + (if base-revision-id #t #f) + (if target-revision-id #t #f) + (select-job-for-commit conn + base-commit) + (select-job-for-commit conn + target-commit)))) (else (let-values (((base-packages-vhash target-packages-vhash) diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 6af3142..9882877 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -275,13 +275,28 @@ (td ,file-name)))) target-derivations))))))) -(define (compare-unknown-commit commit) +(define (compare-unknown-commit base-commit target-commit + base-exists? target-exists? + base-job target-job) (layout #:body `(,(header) (div (@ (class "container")) (h1 "Unknown commit") - (p "No known revision with commit " (strong (samp ,commit))))))) + ,(if base-exists? + '() + `(p "No known revision with commit " + (strong (samp ,base-commit)) + ,(if (null? base-job) + " and it is not currently queued for processing" + " but it is queued for processing"))) + ,(if target-exists? + '() + `(p "No known revision with commit " + (strong (samp ,target-commit)) + ,(if (null? target-job) + " and it is not currently queued for processing" + " but it is queued for processing"))))))) (define (error-page message) (layout |