cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Show when revisions are missing, but queued for processing

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

11
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -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

29
guix-data-service/web/controller.scm
View file

@ -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)
((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)

19
guix-data-service/web/view/html.scm
View file

@ -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