mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Include builds on the derivation history page
This commit is contained in:
Christopher Baines
parent
161c10bdc5
commit
e45db1cd30
|
|
@ -2,6 +2,7 @@
|
|||
#:use-module (srfi srfi-1)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (json)
|
||||
#:use-module (squee)
|
||||
#:use-module (guix inferior)
|
||||
#:use-module (guix-data-service model utils)
|
||||
|
|
@ -243,18 +244,38 @@ ORDER BY first_datetime DESC, package_version DESC"
|
|||
system
|
||||
target
|
||||
package-name)
|
||||
(exec-query
|
||||
conn
|
||||
"
|
||||
(define query
|
||||
"
|
||||
SELECT package_version,
|
||||
derivations.file_name,
|
||||
first_guix_revisions.commit AS first_guix_revision_commit,
|
||||
first_git_branches.datetime AS first_datetime,
|
||||
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
|
||||
INNER JOIN derivations
|
||||
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
|
||||
ON first_guix_revision_id = first_guix_revisions.id
|
||||
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 package_derivations_by_guix_revision_range.system = $4
|
||||
AND package_derivations_by_guix_revision_range.target = $5
|
||||
ORDER BY first_datetime DESC, package_version DESC"
|
||||
(list package-name
|
||||
(number->string git-repository-id)
|
||||
branch-name
|
||||
system
|
||||
target)))
|
||||
GROUP BY 1, 2, 3, 4, 5, 6
|
||||
ORDER BY first_datetime DESC, package_version DESC")
|
||||
|
||||
(map (match-lambda
|
||||
((version derivation-file-name
|
||||
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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -22,6 +22,8 @@
|
|||
#:use-module (guix-data-service web render)
|
||||
#:use-module (guix-data-service web query-parameters)
|
||||
#: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 git-branch)
|
||||
#:use-module (guix-data-service model git-repository)
|
||||
|
|
@ -118,7 +120,13 @@
|
|||
branch-name
|
||||
"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
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
|
|
@ -146,6 +154,7 @@
|
|||
repository-id
|
||||
branch-name
|
||||
package-name
|
||||
build-server-urls
|
||||
package-derivations))))))
|
||||
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision")
|
||||
(let ((commit-hash
|
||||
|
|
|
|||
|
|
@ -19,6 +19,7 @@
|
|||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (guix-data-service web html-utils)
|
||||
#:use-module (guix-data-service web view html)
|
||||
#:export (view-git-repository
|
||||
view-branches
|
||||
|
|
@ -282,6 +283,7 @@
|
|||
(define (view-branch-package-derivations git-repository-id
|
||||
branch-name
|
||||
package-name
|
||||
build-server-urls
|
||||
derivations-by-revision-range)
|
||||
(define versions-list
|
||||
(pair-fold (match-lambda*
|
||||
|
|
@ -332,9 +334,10 @@
|
|||
(thead
|
||||
(tr
|
||||
(th (@ (class "col-sm-1")) "Version")
|
||||
(th (@ (class "col-sm-5")) "Derivation")
|
||||
(th (@ (class "col-sm-1")) "From")
|
||||
(th (@ (class "col-sm-1")) "To")
|
||||
(th (@ (class "col-sm-4")) "Derivation")
|
||||
(th (@ (class "col-sm-2")) "Builds")
|
||||
(th (@ (class "col-sm-2")) "From")
|
||||
(th (@ (class "col-sm-2")) "To")
|
||||
(th (@ (class "col-sm-1")) "")))
|
||||
(tbody
|
||||
,@(let* ((times-in-seconds
|
||||
|
|
@ -360,7 +363,8 @@
|
|||
first-guix-revision-commit
|
||||
first-datetime
|
||||
last-guix-revision-commit
|
||||
last-datetime)
|
||||
last-datetime
|
||||
builds)
|
||||
next-derivation-file-name)
|
||||
`((tr
|
||||
(@ (style "border-bottom: 0;"))
|
||||
|
|
@ -373,6 +377,27 @@
|
|||
(td
|
||||
(a (@ (href ,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
|
||||
"/revision/" first-guix-revision-commit)))
|
||||
,first-datetime))
|
||||
|
|
|
|||
Loading…
Reference in a new issue