Add a package page, showing versions for a revision
This commit is contained in:
parent
a40a8f0f92
commit
fb301a8495
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue