Add a new page to show package versions available on a branch

This is useful when looking back through history at what package versions were
previously available.
This commit is contained in:
Christopher Baines 2019-09-26 23:50:34 +01:00
parent 43bc7cab91
commit 59c342ffde
3 changed files with 107 additions and 1 deletions

View File

@ -9,7 +9,9 @@
select-packages-in-revision
search-packages-in-revision
count-packages-in-revision
inferior-packages->package-ids))
inferior-packages->package-ids
package-versions-for-branch))
(define (select-existing-package-entries package-entries)
(string-append "SELECT id, packages.name, packages.version, "
@ -181,3 +183,33 @@ WHERE packages.id IN (
"packages"
'(name version package_metadata_id)
package-entries))
(define (package-versions-for-branch conn
git-repository-id
branch-name
package-name)
(exec-query
conn
"
SELECT package_version,
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
FROM package_versions_by_guix_revision_range
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
ON first_guix_revisions.git_repository_id = first_git_branches.git_repository_id AND first_guix_revisions.commit = first_git_branches.commit
INNER JOIN guix_revisions AS last_guix_revisions
ON last_guix_revision_id = last_guix_revisions.id
INNER JOIN git_branches AS last_git_branches
ON last_guix_revisions.git_repository_id = last_git_branches.git_repository_id AND last_guix_revisions.commit = last_git_branches.commit
WHERE package_name = $1
AND package_versions_by_guix_revision_range.git_repository_id = $2
AND package_versions_by_guix_revision_range.branch_name = $3
ORDER BY first_datetime DESC"
(list package-name
(number->string git-repository-id)
branch-name)))

View File

@ -882,6 +882,17 @@
'after_date)
#:before-date (assq-ref parsed-query-parameters
'before_date)))))))
(('GET "repository" repository-id "branch" branch-name "package" package-name)
(render-html
#:sxml (view-branch-package
repository-id
branch-name
package-name
(package-versions-for-branch
conn
(string->number repository-id)
branch-name
package-name))))
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision")
(let ((commit-hash
(latest-processed-commit-for-branch conn repository-id branch-name)))

View File

@ -40,6 +40,7 @@
view-git-repository
view-branches
view-branch
view-branch-package
view-builds
view-derivation
view-store-item
@ -1088,6 +1089,68 @@
(cdr branch-commits))
'((#f #f))))))))))))
(define (view-branch-package git-repository-id
branch-name
package-name
versions-by-revision-range)
(layout
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(a (@ (href ,(string-append "/repository/" git-repository-id)))
(h3 "Repository"))
(a (@ (href ,(string-append "/repository/" git-repository-id
"/branch/" branch-name)))
(h3 ,(string-append branch-name " branch")))
(h1 (@ (style "white-space: nowrap;"))
(samp ,package-name))))
(div
(@ (class "row"))
(div
(@ (class "col-md-12"))
(table
(@ (class "table")
(style "table-layout: fixed;"))
(thead
(tr
(th (@ (class "col-sm-4")) "Version")
(th (@ (class "col-sm-4")) "From")
(th (@ (class "col-sm-4")) "To")))
(tbody
,@(map
(match-lambda
((package-version first-guix-revision-commit
first-datetime
last-guix-revision-commit
last-datetime)
`(tr
(td ,package-version)
(td (a (@ (href ,(string-append
"/revision/" first-guix-revision-commit)))
,first-datetime)
(br)
(a (@ (href ,(string-append
"/revision/"
first-guix-revision-commit
"/package/"
package-name "/" package-version)))
"(More information)"))
(td (a (@ (href ,(string-append
"/revision/" last-guix-revision-commit)))
,last-datetime)
(br)
(a (@ (href ,(string-append
"/revision/"
last-guix-revision-commit
"/package/"
package-name "/" package-version)))
"(More information)")))))
versions-by-revision-range)))))))))
(define (view-builds stats builds)
(layout