mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Add first version of a page with the history of package derivations
Some filtering options need adding for the system and target, as it's currently hardcoded, but the general page does work.
This commit is contained in:
Christopher Baines
parent
1442d17a3d
commit
04bb2d52bc
|
|
@ -12,7 +12,8 @@
|
|||
inferior-packages->package-ids
|
||||
|
||||
select-package-versions-for-revision
|
||||
package-versions-for-branch))
|
||||
package-versions-for-branch
|
||||
package-derivations-for-branch))
|
||||
|
||||
(define (select-existing-package-entries package-entries)
|
||||
(string-append "SELECT id, packages.name, packages.version, "
|
||||
|
|
@ -236,3 +237,44 @@ ORDER BY first_datetime DESC, package_version DESC"
|
|||
(number->string git-repository-id)
|
||||
branch-name)))
|
||||
|
||||
(define (package-derivations-for-branch conn
|
||||
git-repository-id
|
||||
branch-name
|
||||
system
|
||||
target
|
||||
package-name)
|
||||
(exec-query
|
||||
conn
|
||||
"
|
||||
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
|
||||
FROM package_derivations_by_guix_revision_range
|
||||
INNER JOIN derivations
|
||||
ON package_derivations_by_guix_revision_range.derivation_id = derivations.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
|
||||
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_derivations_by_guix_revision_range.git_repository_id = $2
|
||||
AND package_derivations_by_guix_revision_range.branch_name = $3
|
||||
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)))
|
||||
|
|
|
|||
|
|
@ -111,6 +111,42 @@
|
|||
branch-name
|
||||
package-name
|
||||
package-versions))))))
|
||||
(('GET "repository" repository-id "branch" branch-name "package" package-name "derivation-history")
|
||||
(let ((package-derivations
|
||||
(package-derivations-for-branch conn
|
||||
(string->number repository-id)
|
||||
branch-name
|
||||
"x86_64-linux"
|
||||
"x86_64-linux"
|
||||
package-name)))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(render-json
|
||||
`((versions . ,(list->vector
|
||||
(map (match-lambda
|
||||
((package-version derivation-file-name
|
||||
first-guix-revision-commit
|
||||
first-datetime
|
||||
last-guix-revision-commit
|
||||
last-datetime)
|
||||
`((version . ,package-version)
|
||||
(derivation . ,derivation-file-name)
|
||||
(first_revision
|
||||
. ((commit . ,first-guix-revision-commit)
|
||||
(datetime . ,first-datetime)))
|
||||
(last_revision
|
||||
. ((commit . ,last-guix-revision-commit)
|
||||
(datetime . ,last-datetime))))))
|
||||
package-versions))))))
|
||||
(else
|
||||
(render-html
|
||||
#:sxml (view-branch-package-derivations
|
||||
repository-id
|
||||
branch-name
|
||||
package-name
|
||||
package-derivations))))))
|
||||
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision")
|
||||
(let ((commit-hash
|
||||
(latest-processed-commit-for-branch conn repository-id branch-name)))
|
||||
|
|
|
|||
|
|
@ -23,7 +23,8 @@
|
|||
#:export (view-git-repository
|
||||
view-branches
|
||||
view-branch
|
||||
view-branch-package))
|
||||
view-branch-package
|
||||
view-branch-package-derivations))
|
||||
|
||||
(define* (view-git-repository git-repository-id
|
||||
label url cgit-url-base
|
||||
|
|
@ -277,3 +278,154 @@
|
|||
(rationalize margin-left 1)
|
||||
(rationalize width 1)))))))))))
|
||||
versions-by-revision-range))))))))))
|
||||
|
||||
(define (view-branch-package-derivations git-repository-id
|
||||
branch-name
|
||||
package-name
|
||||
derivations-by-revision-range)
|
||||
(define versions-list
|
||||
(pair-fold (match-lambda*
|
||||
(((last) (count result ...))
|
||||
(cons (cons last count)
|
||||
result))
|
||||
(((a b rst ...) (count result ...))
|
||||
(peek a b)
|
||||
(if (string=? a b)
|
||||
(cons (+ 1 count)
|
||||
(cons #f result))
|
||||
(cons 1
|
||||
(cons (cons a count)
|
||||
result)))))
|
||||
'(1)
|
||||
(reverse
|
||||
(map first derivations-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")))
|
||||
(a (@ (class "btn btn-default btn-lg pull-right")
|
||||
(href ,(string-append
|
||||
"/repository/" git-repository-id
|
||||
"/branch/" branch-name
|
||||
"/package/" package-name
|
||||
".json")))
|
||||
"View JSON")
|
||||
(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-3")) "Version")
|
||||
(th (@ (class "col-sm-5")) "Derivation")
|
||||
(th (@ (class "col-sm-4")) "From")
|
||||
(th (@ (class "col-sm-4")) "To")))
|
||||
(tbody
|
||||
,@(let* ((times-in-seconds
|
||||
(map (lambda (d)
|
||||
(time-second
|
||||
(date->time-monotonic
|
||||
(string->date d "~Y-~m-~d ~H:~M:~S"))))
|
||||
(append (map fourth derivations-by-revision-range)
|
||||
(map sixth derivations-by-revision-range))))
|
||||
(earliest-date-seconds
|
||||
(apply min
|
||||
times-in-seconds))
|
||||
(latest-date-seconds
|
||||
(apply max
|
||||
times-in-seconds))
|
||||
(min-to-max-seconds
|
||||
(- latest-date-seconds
|
||||
earliest-date-seconds)))
|
||||
(map
|
||||
(match-lambda*
|
||||
((version-column-entry
|
||||
(package-version derivation-file-name
|
||||
first-guix-revision-commit
|
||||
first-datetime
|
||||
last-guix-revision-commit
|
||||
last-datetime))
|
||||
`((tr
|
||||
(@ (style "border-bottom: 0;"))
|
||||
,@(match version-column-entry
|
||||
(#f '())
|
||||
((package-version . rowspan)
|
||||
`((td (@ (rowspan ,(* 2 ; To account for the extra rows
|
||||
rowspan)))
|
||||
,package-version))))
|
||||
(td
|
||||
(a (@ (href ,derivation-file-name))
|
||||
,(display-store-item-short derivation-file-name)))
|
||||
(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)")))
|
||||
(tr
|
||||
(td
|
||||
(@ (colspan 3)
|
||||
(style "border-top: 0; padding-top: 0;"))
|
||||
(div
|
||||
(@
|
||||
(style
|
||||
,(let* ((start-seconds
|
||||
(time-second
|
||||
(date->time-monotonic
|
||||
(string->date first-datetime
|
||||
"~Y-~m-~d ~H:~M:~S"))))
|
||||
(end-seconds
|
||||
(time-second
|
||||
(date->time-monotonic
|
||||
(string->date last-datetime
|
||||
"~Y-~m-~d ~H:~M:~S"))))
|
||||
(margin-left
|
||||
(min
|
||||
(* (/ (- start-seconds earliest-date-seconds)
|
||||
min-to-max-seconds)
|
||||
100)
|
||||
98))
|
||||
(width
|
||||
(max
|
||||
(- (* (/ (- end-seconds earliest-date-seconds)
|
||||
min-to-max-seconds)
|
||||
100)
|
||||
margin-left)
|
||||
2)))
|
||||
(simple-format
|
||||
#f
|
||||
"margin-left: ~A%; width: ~A%; height: 10px; background: #DCDCDC;"
|
||||
(rationalize margin-left 1)
|
||||
(rationalize width 1)))))))))))
|
||||
versions-list
|
||||
derivations-by-revision-range))))))))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue