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

Include builds on the derivation history page

Browse source
This commit is contained in:
Christopher Baines 2019-12-22 18:25:11 +00:00
parent 161c10bdc5
commit e45db1cd30
3 changed files with 96 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

67
guix-data-service/model/package.scm
View file

@ -2,6 +2,7 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (json)
#:use-module (squee) #:use-module (squee)
#:use-module (guix inferior) #:use-module (guix inferior)
#:use-module (guix-data-service model utils) #:use-module (guix-data-service model utils)
@ -243,18 +244,38 @@ ORDER BY first_datetime DESC, package_version DESC"
system system
target target
package-name) package-name)
(exec-query (define query
conn "
"
SELECT package_version, SELECT package_version,
derivations.file_name, derivations.file_name,
first_guix_revisions.commit AS first_guix_revision_commit, first_guix_revisions.commit AS first_guix_revision_commit,
first_git_branches.datetime AS first_datetime, first_git_branches.datetime AS first_datetime,
last_guix_revisions.commit AS last_guix_revision_commit, last_guix_revisions.commit AS last_guix_revision_commit,
last_git_branches.datetime AS last_datetime last_git_branches.datetime AS last_datetime,
JSON_AGG(
json_build_object(
'build_server_id', builds.build_server_id,
'status', latest_build_status.status,
'timestamp', latest_build_status.timestamp,
'build_for_equivalent_derivation',
builds.derivation_file_name != derivations.file_name
)
ORDER BY latest_build_status.timestamp
) AS builds
FROM package_derivations_by_guix_revision_range FROM package_derivations_by_guix_revision_range
INNER JOIN derivations INNER JOIN derivations
ON package_derivations_by_guix_revision_range.derivation_id = derivations.id ON package_derivations_by_guix_revision_range.derivation_id = derivations.id
INNER JOIN derivations_by_output_details_set
ON derivations_by_output_details_set.derivation_id = derivations.id
LEFT OUTER JOIN builds
ON derivations_by_output_details_set.derivation_output_details_set_id =
builds.derivation_output_details_set_id
LEFT OUTER JOIN (
SELECT DISTINCT ON (build_id) *
FROM build_status
ORDER BY build_id, timestamp DESC
) AS latest_build_status
ON builds.id = latest_build_status.build_id
INNER JOIN guix_revisions AS first_guix_revisions INNER JOIN guix_revisions AS first_guix_revisions
ON first_guix_revision_id = first_guix_revisions.id ON first_guix_revision_id = first_guix_revisions.id
INNER JOIN git_branches AS first_git_branches INNER JOIN git_branches AS first_git_branches
@ -272,9 +293,35 @@ AND first_git_branches.name = $3
AND last_git_branches.name = $3 AND last_git_branches.name = $3
AND package_derivations_by_guix_revision_range.system = $4 AND package_derivations_by_guix_revision_range.system = $4
AND package_derivations_by_guix_revision_range.target = $5 AND package_derivations_by_guix_revision_range.target = $5
ORDER BY first_datetime DESC, package_version DESC" GROUP BY 1, 2, 3, 4, 5, 6
(list package-name ORDER BY first_datetime DESC, package_version DESC")
(number->string git-repository-id)
branch-name (map (match-lambda
system ((version derivation-file-name
target))) first-guix-revision-commit
first-datetime
last-guix-revision-commit
last-datetime
builds-json)
(list version
derivation-file-name
first-guix-revision-commit
first-datetime
last-guix-revision-commit
last-datetime
(if (string-null? builds-json)
'()
(filter (lambda (build)
(not (eq? (assoc-ref build "build_server_id")
#nil)))
(vector->list
(json-string->scm builds-json)))))))
(exec-query
conn
query
(list package-name
(number->string git-repository-id)
branch-name
system
target))))

11
guix-data-service/web/repository/controller.scm
View file

@ -22,6 +22,8 @@
#:use-module (guix-data-service web render) #:use-module (guix-data-service web render)
#:use-module (guix-data-service web query-parameters) #:use-module (guix-data-service web query-parameters)
#:use-module (guix-data-service web util) #:use-module (guix-data-service web util)
#:use-module (guix-data-service model utils)
#:use-module (guix-data-service model build-server)
#:use-module (guix-data-service model package) #:use-module (guix-data-service model package)
#:use-module (guix-data-service model git-branch) #:use-module (guix-data-service model git-branch)
#:use-module (guix-data-service model git-repository) #:use-module (guix-data-service model git-repository)
@ -118,7 +120,13 @@
branch-name branch-name
"x86_64-linux" "x86_64-linux"
"x86_64-linux" "x86_64-linux"
package-name))) package-name))
(build-server-urls
(group-to-alist
(match-lambda
((id url lookup-all-derivations)
(cons id url)))
(select-build-servers conn))))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)
@ -146,6 +154,7 @@
repository-id repository-id
branch-name branch-name
package-name package-name
build-server-urls
package-derivations)))))) package-derivations))))))
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision") (('GET "repository" repository-id "branch" branch-name "latest-processed-revision")
(let ((commit-hash (let ((commit-hash

33
guix-data-service/web/repository/html.scm
View file

@ -19,6 +19,7 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (guix-data-service web html-utils)
#:use-module (guix-data-service web view html) #:use-module (guix-data-service web view html)
#:export (view-git-repository #:export (view-git-repository
view-branches view-branches
@ -282,6 +283,7 @@
(define (view-branch-package-derivations git-repository-id (define (view-branch-package-derivations git-repository-id
branch-name branch-name
package-name package-name
build-server-urls
derivations-by-revision-range) derivations-by-revision-range)
(define versions-list (define versions-list
(pair-fold (match-lambda* (pair-fold (match-lambda*
@ -332,9 +334,10 @@
(thead (thead
(tr (tr
(th (@ (class "col-sm-1")) "Version") (th (@ (class "col-sm-1")) "Version")
(th (@ (class "col-sm-5")) "Derivation") (th (@ (class "col-sm-4")) "Derivation")
(th (@ (class "col-sm-1")) "From") (th (@ (class "col-sm-2")) "Builds")
(th (@ (class "col-sm-1")) "To") (th (@ (class "col-sm-2")) "From")
(th (@ (class "col-sm-2")) "To")
(th (@ (class "col-sm-1")) ""))) (th (@ (class "col-sm-1")) "")))
(tbody (tbody
,@(let* ((times-in-seconds ,@(let* ((times-in-seconds
@ -360,7 +363,8 @@
first-guix-revision-commit first-guix-revision-commit
first-datetime first-datetime
last-guix-revision-commit last-guix-revision-commit
last-datetime) last-datetime
builds)
next-derivation-file-name) next-derivation-file-name)
`((tr `((tr
(@ (style "border-bottom: 0;")) (@ (style "border-bottom: 0;"))
@ -373,6 +377,27 @@
(td (td
(a (@ (href ,derivation-file-name)) (a (@ (href ,derivation-file-name))
,(display-store-item derivation-file-name))) ,(display-store-item derivation-file-name)))
(td
(dl
,@(append-map
(lambda (build)
(let ((build-server-id
(assoc-ref build "build_server_id")))
`((dt
(@ (style "font-weight: unset;"))
(a (@ (href
,(assq-ref build-server-urls
build-server-id)))
,(assq-ref build-server-urls
build-server-id)))
(dd
(a (@ (href
,(simple-format
#f "/build-server/~A/build?derivation_file_name=~A"
build-server-id
derivation-file-name)))
,(build-status-alist->build-icon build))))))
builds)))
(td (a (@ (href ,(string-append (td (a (@ (href ,(string-append
"/revision/" first-guix-revision-commit))) "/revision/" first-guix-revision-commit)))
,first-datetime)) ,first-datetime))