Show when revisions are missing, but queued for processing

This commit is contained in:
Christopher Baines 2019-02-24 16:47:29 +00:00
parent e68142cf91
commit b8543859c9
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577
3 changed files with 46 additions and 13 deletions

View file

@ -15,7 +15,8 @@
#:use-module (guix-data-service model guix-revision-package) #:use-module (guix-data-service model guix-revision-package)
#:use-module (guix-data-service model package-metadata) #:use-module (guix-data-service model package-metadata)
#:use-module (guix-data-service model derivation) #: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) (define (inferior-guix->package-ids store conn inf)
(let* ((packages (inferior-packages inf)) (let* ((packages (inferior-packages inf))
@ -145,6 +146,14 @@
(commit commit))))) (commit commit)))))
(extract-information-from store conn url commit store-item))))) (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) (define (process-next-load-new-guix-revision-job conn)
(let ((next (let ((next
(exec-query (exec-query

View file

@ -27,6 +27,7 @@
#:use-module (squee) #:use-module (squee)
#:use-module (guix-data-service comparison) #:use-module (guix-data-service comparison)
#:use-module (guix-data-service model guix-revision) #: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 render)
#:use-module (guix-data-service web util) #:use-module (guix-data-service web util)
#:use-module (guix-data-service web view html) #:use-module (guix-data-service web view html)
@ -68,12 +69,16 @@
(let ((base-revision-id (commit->revision-id conn base-commit)) (let ((base-revision-id (commit->revision-id conn base-commit))
(target-revision-id (commit->revision-id conn target-commit))) (target-revision-id (commit->revision-id conn target-commit)))
(cond (cond
((eq? base-revision-id #f) ((not (and base-revision-id target-revision-id))
(apply render-html (apply render-html
(compare-unknown-commit base-commit))) (compare-unknown-commit base-commit
((eq? target-revision-id #f) target-commit
(apply render-html (if base-revision-id #t #f)
(compare-unknown-commit target-commit))) (if target-revision-id #t #f)
(select-job-for-commit conn
base-commit)
(select-job-for-commit conn
target-commit))))
(else (else
(let-values (let-values
(((base-packages-vhash target-packages-vhash) (((base-packages-vhash target-packages-vhash)
@ -114,12 +119,16 @@
(let ((base-revision-id (commit->revision-id conn base-commit)) (let ((base-revision-id (commit->revision-id conn base-commit))
(target-revision-id (commit->revision-id conn target-commit))) (target-revision-id (commit->revision-id conn target-commit)))
(cond (cond
((eq? base-revision-id #f) ((not (and base-revision-id target-revision-id))
(apply render-html (apply render-html
(compare-unknown-commit base-commit))) (compare-unknown-commit base-commit
((eq? target-revision-id #f) target-commit
(apply render-html (if base-revision-id #t #f)
(compare-unknown-commit target-commit))) (if target-revision-id #t #f)
(select-job-for-commit conn
base-commit)
(select-job-for-commit conn
target-commit))))
(else (else
(let-values (let-values
(((base-packages-vhash target-packages-vhash) (((base-packages-vhash target-packages-vhash)

View file

@ -275,13 +275,28 @@
(td ,file-name)))) (td ,file-name))))
target-derivations))))))) target-derivations)))))))
(define (compare-unknown-commit commit) (define (compare-unknown-commit base-commit target-commit
base-exists? target-exists?
base-job target-job)
(layout (layout
#:body #:body
`(,(header) `(,(header)
(div (@ (class "container")) (div (@ (class "container"))
(h1 "Unknown commit") (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) (define (error-page message)
(layout (layout