Add a page for package output history on a branch
This complements the existing pages for the version history, and derivation history. As well as the new page, the buttons and styling of the two existing pages has been made to match better to enable easier navigation between the pages.
This commit is contained in:
parent
f4583e5fe6
commit
7d2309d344
2 changed files with 335 additions and 4 deletions
|
|
@ -126,6 +126,14 @@
|
||||||
repository-id
|
repository-id
|
||||||
branch-name
|
branch-name
|
||||||
package-name))
|
package-name))
|
||||||
|
(('GET "repository" repository-id "branch" branch-name
|
||||||
|
"package" package-name "output-history")
|
||||||
|
(render-branch-package-output-history request
|
||||||
|
mime-types
|
||||||
|
conn
|
||||||
|
repository-id
|
||||||
|
branch-name
|
||||||
|
package-name))
|
||||||
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision")
|
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision")
|
||||||
(let ((commit-hash
|
(let ((commit-hash
|
||||||
(latest-processed-commit-for-branch conn repository-id branch-name)))
|
(latest-processed-commit-for-branch conn repository-id branch-name)))
|
||||||
|
|
@ -308,3 +316,73 @@
|
||||||
(valid-targets conn))
|
(valid-targets conn))
|
||||||
build-server-urls
|
build-server-urls
|
||||||
package-derivations)))))))
|
package-derivations)))))))
|
||||||
|
|
||||||
|
(define (render-branch-package-output-history request
|
||||||
|
mime-types
|
||||||
|
conn
|
||||||
|
repository-id
|
||||||
|
branch-name
|
||||||
|
package-name)
|
||||||
|
(let ((parsed-query-parameters
|
||||||
|
(parse-query-parameters
|
||||||
|
request
|
||||||
|
`((output ,identity
|
||||||
|
#:default "out")
|
||||||
|
(system ,(parse-build-system conn)
|
||||||
|
#:default "x86_64-linux")
|
||||||
|
(target ,parse-target
|
||||||
|
#:default "")))))
|
||||||
|
(let* ((system
|
||||||
|
(assq-ref parsed-query-parameters 'system))
|
||||||
|
(target
|
||||||
|
(assq-ref parsed-query-parameters 'target))
|
||||||
|
(output-name
|
||||||
|
(assq-ref parsed-query-parameters 'output))
|
||||||
|
(package-outputs
|
||||||
|
(package-outputs-for-branch conn
|
||||||
|
(string->number repository-id)
|
||||||
|
branch-name
|
||||||
|
system
|
||||||
|
target
|
||||||
|
package-name
|
||||||
|
output-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)
|
||||||
|
((application/json)
|
||||||
|
(render-json
|
||||||
|
`((derivations . ,(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-outputs))))))
|
||||||
|
(else
|
||||||
|
(render-html
|
||||||
|
#:sxml (view-branch-package-outputs
|
||||||
|
parsed-query-parameters
|
||||||
|
repository-id
|
||||||
|
branch-name
|
||||||
|
package-name
|
||||||
|
output-name
|
||||||
|
(valid-systems conn)
|
||||||
|
(valid-targets->options
|
||||||
|
(valid-targets conn))
|
||||||
|
build-server-urls
|
||||||
|
package-outputs)))))))
|
||||||
|
|
|
||||||
|
|
@ -26,7 +26,8 @@
|
||||||
view-branches
|
view-branches
|
||||||
view-branch
|
view-branch
|
||||||
view-branch-package
|
view-branch-package
|
||||||
view-branch-package-derivations))
|
view-branch-package-derivations
|
||||||
|
view-branch-package-outputs))
|
||||||
|
|
||||||
(define* (view-git-repositories git-repositories)
|
(define* (view-git-repositories git-repositories)
|
||||||
(layout
|
(layout
|
||||||
|
|
@ -198,7 +199,7 @@
|
||||||
#:body
|
#:body
|
||||||
`(,(header)
|
`(,(header)
|
||||||
(div
|
(div
|
||||||
(@ (class "container"))
|
(@ (class "container-fluid"))
|
||||||
(div
|
(div
|
||||||
(@ (class "row"))
|
(@ (class "row"))
|
||||||
(div
|
(div
|
||||||
|
|
@ -208,9 +209,23 @@
|
||||||
(a (@ (href ,(string-append "/repository/" git-repository-id
|
(a (@ (href ,(string-append "/repository/" git-repository-id
|
||||||
"/branch/" branch-name)))
|
"/branch/" branch-name)))
|
||||||
(h3 ,(string-append branch-name " branch")))
|
(h3 ,(string-append branch-name " branch")))
|
||||||
|
(a (@ (class "btn btn-default btn-lg pull-right")
|
||||||
|
(style "margin-left: 0.5em;")
|
||||||
|
(href ,(string-append
|
||||||
|
"/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name
|
||||||
|
"/package/" package-name
|
||||||
|
".json")))
|
||||||
|
"View JSON")
|
||||||
(div
|
(div
|
||||||
(@ (class "btn-group pull-right")
|
(@ (class "btn-group pull-right")
|
||||||
(role "group"))
|
(role "group"))
|
||||||
|
(a (@ (class "btn btn-default btn-lg disabled")
|
||||||
|
(href ,(string-append
|
||||||
|
"/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name
|
||||||
|
"/package/" package-name)))
|
||||||
|
"Versions only")
|
||||||
(a (@ (class "btn btn-default btn-lg")
|
(a (@ (class "btn btn-default btn-lg")
|
||||||
(href ,(string-append
|
(href ,(string-append
|
||||||
"/repository/" git-repository-id
|
"/repository/" git-repository-id
|
||||||
|
|
@ -223,8 +238,8 @@
|
||||||
"/repository/" git-repository-id
|
"/repository/" git-repository-id
|
||||||
"/branch/" branch-name
|
"/branch/" branch-name
|
||||||
"/package/" package-name
|
"/package/" package-name
|
||||||
".json")))
|
"/output-history")))
|
||||||
"View JSON"))
|
"Include outputs"))
|
||||||
(h1 (@ (style "white-space: nowrap;"))
|
(h1 (@ (style "white-space: nowrap;"))
|
||||||
(samp ,package-name))))
|
(samp ,package-name))))
|
||||||
(div
|
(div
|
||||||
|
|
@ -361,12 +376,36 @@
|
||||||
"/branch/" branch-name)))
|
"/branch/" branch-name)))
|
||||||
(h3 ,(string-append branch-name " branch")))
|
(h3 ,(string-append branch-name " branch")))
|
||||||
(a (@ (class "btn btn-default btn-lg pull-right")
|
(a (@ (class "btn btn-default btn-lg pull-right")
|
||||||
|
(style "margin-left: 0.5em;")
|
||||||
(href ,(string-append
|
(href ,(string-append
|
||||||
"/repository/" git-repository-id
|
"/repository/" git-repository-id
|
||||||
"/branch/" branch-name
|
"/branch/" branch-name
|
||||||
"/package/" package-name
|
"/package/" package-name
|
||||||
"/derivation-history.json")))
|
"/derivation-history.json")))
|
||||||
"View JSON")
|
"View JSON")
|
||||||
|
(div
|
||||||
|
(@ (class "btn-group pull-right")
|
||||||
|
(role "group"))
|
||||||
|
(a (@ (class "btn btn-default btn-lg")
|
||||||
|
(href ,(string-append
|
||||||
|
"/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name
|
||||||
|
"/package/" package-name)))
|
||||||
|
"Versions only")
|
||||||
|
(a (@ (class "btn btn-default btn-lg disabled")
|
||||||
|
(href ,(string-append
|
||||||
|
"/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name
|
||||||
|
"/package/" package-name
|
||||||
|
"/derivation-history")))
|
||||||
|
"Include derivations")
|
||||||
|
(a (@ (class "btn btn-default btn-lg")
|
||||||
|
(href ,(string-append
|
||||||
|
"/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name
|
||||||
|
"/package/" package-name
|
||||||
|
"/output-history")))
|
||||||
|
"Include outputs"))
|
||||||
(h1 (@ (style "white-space: nowrap;"))
|
(h1 (@ (style "white-space: nowrap;"))
|
||||||
(samp ,package-name))))
|
(samp ,package-name))))
|
||||||
(div
|
(div
|
||||||
|
|
@ -528,3 +567,217 @@
|
||||||
(map second
|
(map second
|
||||||
(cdr derivations-by-revision-range))
|
(cdr derivations-by-revision-range))
|
||||||
'(#f))))))))))))
|
'(#f))))))))))))
|
||||||
|
|
||||||
|
(define (view-branch-package-outputs query-parameters
|
||||||
|
git-repository-id
|
||||||
|
branch-name
|
||||||
|
package-name
|
||||||
|
output-name
|
||||||
|
valid-systems
|
||||||
|
valid-targets
|
||||||
|
build-server-urls
|
||||||
|
outputs-by-revision-range)
|
||||||
|
(define versions-list
|
||||||
|
(pair-fold (match-lambda*
|
||||||
|
(((last) (count result ...))
|
||||||
|
(cons (cons last count)
|
||||||
|
result))
|
||||||
|
(((a b rst ...) (count result ...))
|
||||||
|
(if (string=? a b)
|
||||||
|
(cons (+ 1 count)
|
||||||
|
(cons #f result))
|
||||||
|
(cons 1
|
||||||
|
(cons (cons a count)
|
||||||
|
result)))))
|
||||||
|
'(1)
|
||||||
|
(reverse
|
||||||
|
(map first outputs-by-revision-range))))
|
||||||
|
|
||||||
|
(layout
|
||||||
|
#:body
|
||||||
|
`(,(header)
|
||||||
|
(div
|
||||||
|
(@ (class "container-fluid"))
|
||||||
|
(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")
|
||||||
|
(style "margin-left: 0.5em;")
|
||||||
|
(href ,(string-append
|
||||||
|
"/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name
|
||||||
|
"/package/" package-name
|
||||||
|
"/output-history.json")))
|
||||||
|
"View JSON")
|
||||||
|
(div
|
||||||
|
(@ (class "btn-group pull-right")
|
||||||
|
(role "group"))
|
||||||
|
(a (@ (class "btn btn-default btn-lg")
|
||||||
|
(href ,(string-append
|
||||||
|
"/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name
|
||||||
|
"/package/" package-name)))
|
||||||
|
"Versions only")
|
||||||
|
(a (@ (class "btn btn-default btn-lg")
|
||||||
|
(href ,(string-append
|
||||||
|
"/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name
|
||||||
|
"/package/" package-name
|
||||||
|
"/derivation-history")))
|
||||||
|
"Include derivations")
|
||||||
|
(a (@ (class "btn btn-default btn-lg disabled")
|
||||||
|
(href ,(string-append
|
||||||
|
"/repository/" git-repository-id
|
||||||
|
"/branch/" branch-name
|
||||||
|
"/package/" package-name
|
||||||
|
"/output-history")))
|
||||||
|
"Include outputs"))
|
||||||
|
(h1 (@ (style "white-space: nowrap;"))
|
||||||
|
(samp ,package-name))))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-12"))
|
||||||
|
(div
|
||||||
|
(@ (class "well"))
|
||||||
|
(form
|
||||||
|
(@ (method "get")
|
||||||
|
(action "")
|
||||||
|
(class "form-horizontal"))
|
||||||
|
,(form-horizontal-control
|
||||||
|
"Output" query-parameters
|
||||||
|
#:help-text "Show this output for the package.")
|
||||||
|
,(form-horizontal-control
|
||||||
|
"System" query-parameters
|
||||||
|
#:options valid-systems
|
||||||
|
#:allow-selecting-multiple-options #f
|
||||||
|
#:help-text "Show derivations with this system.")
|
||||||
|
,(form-horizontal-control
|
||||||
|
"Target" query-parameters
|
||||||
|
#:options valid-targets
|
||||||
|
#:allow-selecting-multiple-options #f
|
||||||
|
#:help-text "Show derivations with this target.")
|
||||||
|
(div (@ (class "form-group form-group-lg"))
|
||||||
|
(div (@ (class "col-sm-offset-2 col-sm-10"))
|
||||||
|
(button (@ (type "submit")
|
||||||
|
(class "btn btn-lg btn-primary"))
|
||||||
|
"Update results"))))))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-12"))
|
||||||
|
(table
|
||||||
|
(@ (class "table")
|
||||||
|
(style "table-layout: fixed;"))
|
||||||
|
(thead
|
||||||
|
(tr
|
||||||
|
(th (@ (class "col-sm-1")) "Version")
|
||||||
|
(th (@ (class "col-sm-6")) "Output")
|
||||||
|
(th (@ (class "col-sm-2")) "Builds")
|
||||||
|
(th (@ (class "col-sm-2")) "From")
|
||||||
|
(th (@ (class "col-sm-2")) "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 outputs-by-revision-range)
|
||||||
|
(map sixth outputs-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 output-path
|
||||||
|
first-guix-revision-commit
|
||||||
|
first-datetime
|
||||||
|
last-guix-revision-commit
|
||||||
|
last-datetime
|
||||||
|
builds))
|
||||||
|
`((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 ,output-path))
|
||||||
|
,(display-store-item output-path)))
|
||||||
|
(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
|
||||||
|
(assoc-ref build "derivation_file_name"))))
|
||||||
|
,(build-status-alist->build-icon build))))))
|
||||||
|
builds)))
|
||||||
|
(td (a (@ (href ,(string-append
|
||||||
|
"/revision/" first-guix-revision-commit)))
|
||||||
|
,first-datetime))
|
||||||
|
(td (a (@ (href ,(string-append
|
||||||
|
"/revision/" last-guix-revision-commit)))
|
||||||
|
,last-datetime)))
|
||||||
|
(tr
|
||||||
|
(td
|
||||||
|
(@ (colspan 4)
|
||||||
|
(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
|
||||||
|
outputs-by-revision-range))))))))))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue