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

Add a list of the queued revisions to the index page

Browse source
This commit is contained in:
Christopher Baines 2019-03-03 18:15:29 +00:00
parent ffdd2416f4
commit 623347d835
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577
3 changed files with 88 additions and 45 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

@ -16,7 +16,8 @@
#: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)) select-job-for-commit
most-recent-n-load-new-guix-revision-jobs))
(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))
@ -173,6 +174,14 @@
(list commit)))) (list commit))))
result)) result))
(define (most-recent-n-load-new-guix-revision-jobs conn n)
(let ((result
(exec-query
conn
"SELECT * FROM load_new_guix_revision_jobs LIMIT $1"
(list (number->string n)))))
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

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

@ -201,7 +201,9 @@
(define (controller request body conn) (define (controller request body conn)
(match-lambda (match-lambda
((GET) ((GET)
(apply render-html (index (most-recent-n-guix-revisions conn 10)))) (apply render-html (index
(most-recent-n-guix-revisions conn 10)
(most-recent-n-load-new-guix-revision-jobs conn 1000))))
((GET "compare") ((GET "compare")
(with-base-and-target-commits (with-base-and-target-commits
request conn request conn

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

@ -81,7 +81,7 @@
"source code here") "."))))) "source code here") ".")))))
#:extra-headers ,extra-headers)) #:extra-headers ,extra-headers))
(define (index guix-revisions) (define (index guix-revisions queued-guix-revisions)
(layout (layout
#:extra-headers #:extra-headers
'((cache-control . ((max-age . 60)))) '((cache-control . ((max-age . 60))))
@ -89,48 +89,80 @@
`(,(header) `(,(header)
(div (div
(@ (class "container")) (@ (class "container"))
(h1 "Guix Data Service") (div
(form (@ (id "compare") (@ (class "row"))
(action "/compare")) (h1 "Guix Data Service"))
(div (div
(@ (class "form-group")) (@ (class "row"))
(label (@ (for "base_commit")) (form
"Base commit") (@ (id "compare")
(input (@ (type "text") (action "/compare"))
(class "form-control") (div
(id "base_commit") (@ (class "col-md-6"))
(name "base_commit") (div
(placeholder "base commit")))) (@ (class "form-group"))
(div (label (@ (for "base_commit"))
(@ (class "form-group")) "Base commit")
(label (@ (for "target_commit")) (input (@ (type "text")
"Target commit") (class "form-control")
(input (@ (type "text") (id "base_commit")
(class "form-control") (name "base_commit")
(id "target_commit") (placeholder "base commit"))))
(name "target_commit") (div
(placeholder "target commit")))) (@ (class "form-group"))
(button (label (@ (for "target_commit"))
(@ (type "submit") "Target commit")
(class "btn btn-lg btn-primary")) (input (@ (type "text")
"Compare")) (class "form-control")
(h3 "Recent fetched revisions") (id "target_commit")
,(if (null? guix-revisions) (name "target_commit")
'(p "No revisions") (placeholder "target commit")))))
`(table (div
(@ (class "table")) (@ (class "col-md-6"))
(thead (button
(tr (@ (type "submit")
(th (@ (class "col-md-6")) "Source Repository URL") (class "btn btn-lg btn-primary"))
(th (@ (class "col-md-6")) "Commit"))) "Compare"))))
(tbody (div
,@(map (@ (class "row"))
(match-lambda (h3 "Recent fetched revisions")
((id url commit store_path) ,(if (null? guix-revisions)
`(tr '(p "No revisions")
(td ,url) `(table
(td (samp ,commit))))) (@ (class "table"))
guix-revisions)))))))) (thead
(tr
(th (@ (class "col-md-6")) "Source Repository URL")
(th (@ (class "col-md-6")) "Commit")))
(tbody
,@(map
(match-lambda
((id url commit store_path)
`(tr
(td ,url)
(td (samp ,commit)))))
guix-revisions)))))
(div
(@ (class "row"))
(h3 "Queued revisions")
,(if (null? queued-guix-revisions)
'(p "No queued revisions")
`(table
(@ (class "table"))
(thead
(tr
(th (@ (class "col-md-4")) "Source Repository URL")
(th (@ (class "col-md-4")) "Commit")
(th (@ (class "col-md-4")) "Source")))
(tbody
,@(map
(match-lambda
((id url commit source)
`(tr
(td ,url)
(td (samp ,commit))
(td ,source))))
queued-guix-revisions)))))))))
(define (compare base-commit (define (compare base-commit
target-commit target-commit