Add a package page, showing versions for a revision

This commit is contained in:
Christopher Baines 2019-10-03 21:35:29 +01:00
parent a40a8f0f92
commit fb301a8495
3 changed files with 108 additions and 0 deletions

View File

@ -11,6 +11,7 @@
count-packages-in-revision
inferior-packages->package-ids
select-package-versions-for-revision
package-versions-for-branch))
(define (select-existing-package-entries package-entries)
@ -184,6 +185,24 @@ WHERE packages.id IN (
'(name version package_metadata_id)
package-entries))
(define (select-package-versions-for-revision conn
commit
package-name)
(define query "
SELECT DISTINCT version FROM packages
INNER JOIN package_derivations
ON packages.id = package_derivations.package_id
INNER JOIN guix_revision_package_derivations
ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
INNER JOIN guix_revisions
ON guix_revision_package_derivations.revision_id = guix_revisions.id
WHERE guix_revisions.commit = $1 AND packages.name = $2
ORDER BY version")
(map
car
(exec-query conn query (list commit package-name))))
(define (package-versions-for-branch conn
git-repository-id
branch-name

View File

@ -278,6 +278,39 @@
#:header-link header-link)
#:extra-headers http-headers-for-unchanging-content))))))
(define* (render-revision-package mime-types
conn
commit-hash
name
#:key
(path-base "/revision/")
(header-text
`("Revision "
(samp ,commit-hash)))
(header-link
(string-append
"/revision/" commit-hash)))
(let ((package-versions
(select-package-versions-for-revision conn
commit-hash
name)))
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
((application/json)
(render-json
`((versions . ,(list->vector package-versions)))
#:extra-headers http-headers-for-unchanging-content))
(else
(render-html
#:sxml (view-revision-package commit-hash
name
package-versions
#:path-base path-base
#:header-text header-text
#:header-link header-link)
#:extra-headers http-headers-for-unchanging-content)))))
(define* (render-revision-package-version mime-types
conn
commit-hash
@ -811,6 +844,15 @@
(render-unknown-revision mime-types
conn
commit-hash)))
(('GET "revision" commit-hash "package" name)
(if (guix-commit-exists? conn commit-hash)
(render-revision-package mime-types
conn
commit-hash
name)
(render-unknown-revision mime-types
conn
commit-hash)))
(('GET "revision" commit-hash "package" name version)
(if (guix-commit-exists? conn commit-hash)
(render-revision-package-version mime-types

View File

@ -33,6 +33,7 @@
general-not-found
unknown-revision
view-statistics
view-revision-package
view-revision-package-and-version
view-revision
view-revision-packages
@ -308,6 +309,52 @@
(style "font-size: 2em; display: block;"))
,derivations-count)))))))
(define* (view-revision-package revision-commit-hash
name
versions
#:key path-base
header-text
header-link)
(layout
#:body
`(,(header)
(div
(@ (class "container"))
(div
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h3 (a (@ (href ,header-link))
,@header-text))))
(div
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h1 "Package " ,name)))
(div
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h3 "Versions")
(table
(@ (class "table"))
(thead
(tr
(th (@ (class "col-sm-10")) "Version")
(th (@ (class "col-sm-2")) "")))
(tbody
,@(map
(lambda (version)
`(tr
(td (samp ,version))
(td
(a (@ (href ,(string-append
path-base
revision-commit-hash
"/package/" name "/" version)))
"More information"))))
versions)))))))))
(define* (view-revision-package-and-version revision-commit-hash name version
package-metadata
derivations git-repositories