1054 lines
41 KiB
Scheme
1054 lines
41 KiB
Scheme
;;; Guix Data Service -- Information about Guix over time
|
|
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
|
|
;;;
|
|
;;; This program is free software: you can redistribute it and/or
|
|
;;; modify it under the terms of the GNU Affero General Public License
|
|
;;; as published by the Free Software Foundation, either version 3 of
|
|
;;; the License, or (at your option) any later version.
|
|
;;;
|
|
;;; This program is distributed in the hope that it will be useful,
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;;; Affero General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU Affero General Public
|
|
;;; License along with this program. If not, see
|
|
;;; <http://www.gnu.org/licenses/>.
|
|
|
|
(define-module (guix-data-service web revision html)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (texinfo)
|
|
#:use-module (texinfo html)
|
|
#:use-module (json)
|
|
#:use-module (guix-data-service web util)
|
|
#:use-module (guix-data-service web html-utils)
|
|
#:use-module (guix-data-service web query-parameters)
|
|
#:use-module (guix-data-service web view html)
|
|
#:export (view-revision-news
|
|
view-revision-package
|
|
view-revision-package-and-version
|
|
view-revision
|
|
view-revision-packages
|
|
view-revision-derivations
|
|
view-revision-derivation-outputs
|
|
view-revision-lint-warnings
|
|
unknown-revision))
|
|
|
|
(define* (view-revision-news commit-hash
|
|
query-parameters
|
|
news-entries)
|
|
(layout
|
|
#:body
|
|
`(,(header)
|
|
(div
|
|
(@ (class "container"))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
(h3 (a (@ (style "white-space: nowrap;")
|
|
(href ,(string-append "/revision/" commit-hash)))
|
|
"Revision " (samp ,commit-hash)))))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
(h1 "Channel News Entries")
|
|
,@(map
|
|
(match-lambda
|
|
((commit tag title-text body-text)
|
|
`(div
|
|
(h4 ,@(if (null? commit)
|
|
'()
|
|
`(("Commit: " (samp ,commit))))
|
|
,@(if (null? tag)
|
|
'()
|
|
`(("Tag: " ,tag))))
|
|
(table
|
|
(@ (class "table"))
|
|
(thead
|
|
(tr
|
|
(th (@ (class "col-sm-1")) "Language")
|
|
(th (@ (class "col-sm-3")) "Title")
|
|
(th (@ (class "col-sm-8")) "Body"))
|
|
(tbody
|
|
,@(map (lambda (lang)
|
|
`(tr
|
|
(td ,lang)
|
|
(td ,(stexi->shtml
|
|
(texi-fragment->stexi
|
|
(assoc-ref title-text lang))))
|
|
(td ,
|
|
(stexi->shtml
|
|
(texi-fragment->stexi
|
|
(assoc-ref body-text lang))))))
|
|
(sort
|
|
(delete-duplicates
|
|
(append (map car title-text)
|
|
(map car body-text)))
|
|
string<?))))))))
|
|
news-entries)))))))
|
|
|
|
(define* (view-revision-package revision-commit-hash
|
|
name
|
|
versions
|
|
git-repositories-and-branches
|
|
#: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"))
|
|
,(append-map
|
|
(match-lambda
|
|
(((id label url cgit-url-base) . branches)
|
|
(map (match-lambda
|
|
((branch-name datetime)
|
|
`(a (@ (class "btn btn-default btn-lg pull-right")
|
|
(href ,(simple-format
|
|
#f "/repository/~A/branch/~A/package/~A"
|
|
id branch-name name)))
|
|
,(simple-format #f "View ~A branch version history"
|
|
branch-name))))
|
|
branches)))
|
|
git-repositories-and-branches)
|
|
(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
|
|
lint-warnings
|
|
#:key 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 " @ " ,version)))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
,(match package-metadata
|
|
(((synopsis description home-page file line column-number
|
|
licenses))
|
|
`(dl
|
|
(@ (class "dl-horizontal"))
|
|
(dt "Synopsis")
|
|
(dd ,(stexi->shtml (texi-fragment->stexi synopsis)))
|
|
(dt "Description")
|
|
(dd ,(stexi->shtml (texi-fragment->stexi description)))
|
|
(dt "Home page")
|
|
(dd (a (@ (href ,home-page)) ,home-page))
|
|
,@(if (and file (not (string-null? file))
|
|
(not (null? git-repositories)))
|
|
`((dt "Location")
|
|
(dd ,@(map
|
|
(match-lambda
|
|
((id label url cgit-url-base)
|
|
(if
|
|
(and cgit-url-base
|
|
(not (string-null? cgit-url-base)))
|
|
`(a (@ (href
|
|
,(string-append
|
|
cgit-url-base "tree/"
|
|
file "?id=" revision-commit-hash
|
|
"#n" line)))
|
|
,file
|
|
" (line: " ,line
|
|
", column: " ,column-number ")")
|
|
'())))
|
|
git-repositories)))
|
|
'())
|
|
,@(if (> (vector-length licenses) 0)
|
|
`((dt ,(if (eq? (vector-length licenses) 1)
|
|
"License"
|
|
"Licenses"))
|
|
(dd (ul
|
|
,@(map (lambda (license)
|
|
`(li (a (@ (href ,(assoc-ref license "uri")))
|
|
,(assoc-ref license "name"))))
|
|
(vector->list licenses)))))
|
|
'()))))))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
(h3 "Derivations")
|
|
(table
|
|
(@ (class "table"))
|
|
(thead
|
|
(tr
|
|
(th "System")
|
|
(th "Target")
|
|
(th "Derivation")
|
|
(th "Build status")))
|
|
(tbody
|
|
,@(map
|
|
(match-lambda
|
|
((system target file-name status)
|
|
`(tr
|
|
(td (samp ,system))
|
|
(td (samp ,target))
|
|
(td (a (@ (href ,file-name))
|
|
,(display-store-item-short file-name)))
|
|
(td ,(build-status-span status)))))
|
|
derivations)))))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
(h3 "Lint warnings")
|
|
(table
|
|
(@ (class "table"))
|
|
(thead
|
|
(tr
|
|
(th "Linter")
|
|
(th "Message")
|
|
(th "Location")))
|
|
(tbody
|
|
,@(map
|
|
(match-lambda
|
|
((id lint-checker-name lint-checker-description
|
|
lint-checker-network-dependent
|
|
file line-number column-number
|
|
message)
|
|
`(tr
|
|
(td (span (@ (style "font-family: monospace; display: block;"))
|
|
,lint-checker-name)
|
|
(p (@ (style "font-size: small; margin: 6px 0 0px;"))
|
|
,lint-checker-description))
|
|
(td ,message)
|
|
(td
|
|
,@(if (and file (not (string-null? file)))
|
|
`((ul
|
|
,@(map
|
|
(match-lambda
|
|
((id label url cgit-url-base)
|
|
(let ((output
|
|
`(,file
|
|
" "
|
|
(span
|
|
(@ (style "white-space: nowrap"))
|
|
"(line: " ,line-number
|
|
", column: " ,column-number ")"))))
|
|
(if
|
|
(and cgit-url-base
|
|
(not (string-null? cgit-url-base)))
|
|
`(li
|
|
(a (@ (href
|
|
,(string-append
|
|
cgit-url-base "tree/"
|
|
file "?id=" revision-commit-hash
|
|
"#n" line-number)))
|
|
,@output))
|
|
`(li ,@output)))))
|
|
git-repositories)))
|
|
'())))))
|
|
lint-warnings)))))))))
|
|
|
|
(define (view-revision/git-repositories git-repositories-and-branches
|
|
commit-hash)
|
|
`((h3 "Git repositories")
|
|
,@(map
|
|
(match-lambda
|
|
(((id label url cgit-url-base) . branches)
|
|
`((a (@ (href ,(string-append
|
|
"/repository/" id)))
|
|
(h4 ,url))
|
|
,@(map
|
|
(match-lambda
|
|
((name datetime)
|
|
`(div
|
|
(a (@ (href ,(string-append "/repository/" id
|
|
"/branch/" name)))
|
|
,name)
|
|
" at " ,datetime
|
|
,@(if (string-null? cgit-url-base)
|
|
'()
|
|
`(" "
|
|
(a (@ (href ,(string-append
|
|
cgit-url-base
|
|
"commit/?id="
|
|
commit-hash)))
|
|
"(View cgit)"))))))
|
|
branches))))
|
|
git-repositories-and-branches)))
|
|
|
|
(define (view-revision/jobs-and-events jobs-and-events)
|
|
`((h3 "Jobs")
|
|
(table
|
|
(@ (class "table"))
|
|
(thead
|
|
(tr
|
|
(th "Source")
|
|
(th "Events")
|
|
(th "")))
|
|
(tbody
|
|
,@(map (match-lambda
|
|
((id commit source git-repository-id created-at succeeded-at
|
|
events log-exists?)
|
|
`(tr
|
|
(@ (class
|
|
,(let ((event-names
|
|
(map (lambda (event)
|
|
(assoc-ref event "event"))
|
|
(vector->list events))))
|
|
(cond
|
|
((member "success" event-names)
|
|
"success")
|
|
((member "failure" event-names)
|
|
"danger")
|
|
((member "start" event-names)
|
|
"info")
|
|
(else
|
|
""))))
|
|
(title ,(simple-format #f "Job id: ~A" id)))
|
|
(td ,source)
|
|
(td
|
|
(dl
|
|
,@(map
|
|
(lambda (event)
|
|
`((dt ,(assoc-ref event "event"))
|
|
(dd ,(assoc-ref event "occurred_at"))))
|
|
(cons
|
|
`(("event" . "created")
|
|
("occurred_at" . ,created-at))
|
|
(vector->list events)))))
|
|
(td
|
|
,@(if log-exists?
|
|
`((a (@ (href ,(string-append "/job/" id)))
|
|
"View log"))
|
|
'())))))
|
|
jobs-and-events)))))
|
|
|
|
(define (view-revision/lint-warning-counts path-base lint-warning-counts)
|
|
`((h3 "Lint warnings")
|
|
(a (@ (href ,(string-append path-base "/lint-warnings")))
|
|
"View lint warnings")
|
|
(table
|
|
(@ (class "table"))
|
|
(thead
|
|
(tr
|
|
(th "Linter")
|
|
(th "Count")))
|
|
(tbody
|
|
,@(map (match-lambda
|
|
((name description network-dependent count)
|
|
`(tr
|
|
(td (span (@ (style "font-family: monospace; display: block;"))
|
|
,name)
|
|
(p (@ (style "margin: 6px 0 0px;"))
|
|
,description))
|
|
(td ,count))))
|
|
lint-warning-counts)))))
|
|
|
|
(define* (view-revision commit-hash packages-count
|
|
git-repositories-and-branches derivations-count
|
|
jobs-and-events
|
|
lint-warning-counts
|
|
#:key (path-base "/revision/")
|
|
header-text)
|
|
(layout
|
|
#:body
|
|
`(,(header)
|
|
(div
|
|
(@ (class "container"))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-md-12"))
|
|
(h1 (@ (style "white-space: nowrap;"))
|
|
,@header-text)))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-md-6"))
|
|
(h2 "Packages")
|
|
(strong (@ (class "text-center")
|
|
(style "font-size: 2em; display: block;"))
|
|
,packages-count)
|
|
(a (@ (href ,(string-append path-base "/packages")))
|
|
"View packages")
|
|
|
|
,@(if (null? git-repositories-and-branches)
|
|
'()
|
|
(view-revision/git-repositories git-repositories-and-branches
|
|
commit-hash))
|
|
,@(view-revision/jobs-and-events jobs-and-events)
|
|
,@(view-revision/lint-warning-counts path-base
|
|
lint-warning-counts))
|
|
(div
|
|
(@ (class "col-md-6"))
|
|
(h3 "Derivations")
|
|
(table
|
|
(@ (class "table")
|
|
(style "white-space: nowrap;"))
|
|
(thead
|
|
(tr
|
|
(th "System")
|
|
(th "Target")
|
|
(th "Derivations")))
|
|
(tbody
|
|
,@(map (match-lambda
|
|
((system target count)
|
|
(if (string=? system target)
|
|
`(tr
|
|
(td (@ (class "text-center")
|
|
(colspan 2))
|
|
(samp ,system))
|
|
(td (samp ,count)))
|
|
`(tr
|
|
(td (samp ,system))
|
|
(td (samp ,target))
|
|
(td (samp ,count))))))
|
|
derivations-count)))))))))
|
|
|
|
(define* (view-revision-packages revision-commit-hash
|
|
query-parameters
|
|
packages
|
|
git-repositories
|
|
show-next-page?
|
|
#:key path-base
|
|
header-text header-link)
|
|
(define field-options
|
|
(map
|
|
(lambda (field)
|
|
(cons field
|
|
(hyphenate-words
|
|
(string-downcase field))))
|
|
'("Version" "Synopsis" "Description"
|
|
"Home page" "Location" "Licenses")))
|
|
|
|
(layout
|
|
#:body
|
|
`(,(header)
|
|
(div
|
|
(@ (class "container"))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
(h3 (a (@ (style "white-space: nowrap;")
|
|
(href ,header-link))
|
|
,@header-text))))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-md-12"))
|
|
(div
|
|
(@ (class "well"))
|
|
(form
|
|
(@ (method "get")
|
|
(action "")
|
|
(style "padding-bottom: 0")
|
|
(class "form-horizontal"))
|
|
,(form-horizontal-control
|
|
"Search query" query-parameters
|
|
#:help-text
|
|
"List packages where the name or synopsis match the query.")
|
|
,(form-horizontal-control
|
|
"Fields" query-parameters
|
|
#:name "field"
|
|
#:options field-options
|
|
#:help-text "Fields to return in the response.")
|
|
,(form-horizontal-control
|
|
"After name" query-parameters
|
|
#:help-text
|
|
"List packages that are alphabetically after the given name.")
|
|
,(form-horizontal-control
|
|
"Limit results" query-parameters
|
|
#:help-text "The maximum number of packages by name to return.")
|
|
,(form-horizontal-control
|
|
"All results" query-parameters
|
|
#:type "checkbox"
|
|
#:help-text "Return all results.")
|
|
(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-sm-12"))
|
|
(a (@ (class "btn btn-default btn-lg pull-right")
|
|
(href ,(let ((query-parameter-string
|
|
(query-parameters->string query-parameters)))
|
|
(string-append
|
|
path-base ".json"
|
|
(if (string-null? query-parameter-string)
|
|
""
|
|
(string-append "?" query-parameter-string))))))
|
|
"View JSON")))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
(h1 "Packages")
|
|
(table
|
|
(@ (class "table table-responsive"))
|
|
(thead
|
|
(tr
|
|
(th (@ (class "col-md-3")) "Name")
|
|
,@(filter-map
|
|
(match-lambda
|
|
((label . value)
|
|
(if (member value (assq-ref query-parameters 'field))
|
|
`(th (@ (class "col-md-3")) ,label)
|
|
#f)))
|
|
field-options)
|
|
(th (@ (class "col-md-3")) "")))
|
|
(tbody
|
|
,@(let ((fields (assq-ref query-parameters 'field)))
|
|
(map
|
|
(match-lambda
|
|
((name version synopsis description home-page
|
|
location-file location-line
|
|
location-column-number licenses)
|
|
`(tr
|
|
(td ,name)
|
|
,@(if (member "version" fields)
|
|
`((td ,version))
|
|
'())
|
|
,(if (member "synopsis" fields)
|
|
`((td ,(stexi->shtml (texi-fragment->stexi synopsis))))
|
|
'())
|
|
,(if (member "description" fields)
|
|
`((td ,(stexi->shtml (texi-fragment->stexi description))))
|
|
'())
|
|
,(if (member "home-page" fields)
|
|
`((td ,home-page))
|
|
'())
|
|
,(if (member "location" fields)
|
|
`((td
|
|
,@(if (and location-file
|
|
(not (string-null? location-file)))
|
|
`((ul
|
|
,@(map
|
|
(match-lambda
|
|
((id label url cgit-url-base)
|
|
(if
|
|
(and cgit-url-base
|
|
(not (string-null? cgit-url-base)))
|
|
`(li
|
|
(a (@ (href
|
|
,(string-append
|
|
cgit-url-base "tree/"
|
|
location-file "?id=" revision-commit-hash
|
|
"#n" location-line)))
|
|
,location-file
|
|
" (line: " ,location-line
|
|
", column: " ,location-column-number ")"))
|
|
`(li ,location-file
|
|
" (line: " ,location-line
|
|
", column: " ,location-column-number ")"))))
|
|
git-repositories)))
|
|
'())))
|
|
'())
|
|
,(if (member "licenses" fields)
|
|
`((td
|
|
(ul
|
|
(@ (class "list-inline"))
|
|
,@(map (lambda (license)
|
|
`(li (a (@ (href ,(assoc-ref license "uri")))
|
|
,(assoc-ref license "name"))))
|
|
(vector->list
|
|
(json-string->scm licenses))))))
|
|
'())
|
|
(td (@ (class "text-right"))
|
|
(a (@ (href ,(string-append
|
|
(string-drop-right path-base 1)
|
|
"/" name "/" version)))
|
|
"More information")))))
|
|
packages))))))
|
|
,@(if show-next-page?
|
|
`((div
|
|
(@ (class "row"))
|
|
(a (@ (href
|
|
,(next-page-link path-base
|
|
query-parameters
|
|
'after_name
|
|
(car (last packages)))))
|
|
"Next page")))
|
|
'())))))
|
|
|
|
(define* (view-revision-derivations commit-hash
|
|
query-parameters
|
|
valid-systems
|
|
derivations
|
|
show-next-page?
|
|
#:key (path-base "/revision/")
|
|
header-text
|
|
header-link)
|
|
(layout
|
|
#:body
|
|
`(,(header)
|
|
(div
|
|
(@ (class "container"))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
(h3 (a (@ (style "white-space: nowrap;")
|
|
(href ,header-link))
|
|
,@header-text))))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-md-12"))
|
|
(div
|
|
(@ (class "well"))
|
|
(form
|
|
(@ (method "get")
|
|
(action "")
|
|
(style "padding-bottom: 0")
|
|
(class "form-horizontal"))
|
|
,(form-horizontal-control
|
|
"Search query" query-parameters
|
|
#:help-text
|
|
"List packages where the name or synopsis match the query.")
|
|
,(form-horizontal-control
|
|
"System" query-parameters
|
|
#:options valid-systems
|
|
#:help-text "Only include derivations for this system."
|
|
#:font-family "monospace")
|
|
,(form-horizontal-control
|
|
"Target" query-parameters
|
|
#:options valid-systems
|
|
#:help-text "Only include derivations that are build for this system."
|
|
#:font-family "monospace")
|
|
,(form-horizontal-control
|
|
"Minimum builds" query-parameters
|
|
#:help-text "Only show derivations with a minimum number of known builds.")
|
|
,(form-horizontal-control
|
|
"Maximum builds" query-parameters
|
|
#:help-text "Only show derivations with a maximum number of known builds.")
|
|
,(form-horizontal-control
|
|
"After name" query-parameters
|
|
#:help-text
|
|
"List packages that are alphabetically after the given name.")
|
|
,(form-horizontal-control
|
|
"Limit results" query-parameters
|
|
#:help-text "The maximum number of packages by name to return.")
|
|
,(form-horizontal-control
|
|
"All results" query-parameters
|
|
#:type "checkbox"
|
|
#:help-text "Return all results.")
|
|
(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"))
|
|
(p "Showing " ,(length derivations) " results")
|
|
(table
|
|
(@ (class "table"))
|
|
(thead
|
|
(tr
|
|
(th "File name")
|
|
(th "System")
|
|
(th "Target")))
|
|
(tbody
|
|
,@(map
|
|
(match-lambda
|
|
((file-name system target builds outputs)
|
|
(let ((build-server-ids
|
|
(sort
|
|
(delete-duplicates
|
|
(append
|
|
(map (lambda (build)
|
|
(assoc-ref build "build_server_id"))
|
|
(vector->list builds))
|
|
(append-map
|
|
(lambda (output)
|
|
(map (lambda (nar)
|
|
(assoc-ref nar "build_server_id"))
|
|
(vector->list
|
|
(or (assoc-ref output "nars")
|
|
#()))))
|
|
(vector->list outputs))))
|
|
<)))
|
|
`(tr
|
|
(td (a (@ (href ,file-name))
|
|
,(display-store-item-short file-name)))
|
|
(td (@ (style "font-family: monospace;"))
|
|
,system)
|
|
(td (@ (style "font-family: monospace;"))
|
|
,target)
|
|
(td ,@(map
|
|
(lambda (build-server-id)
|
|
`(div
|
|
,@(map build-status-alist->build-icon
|
|
(filter
|
|
(lambda (build)
|
|
(eq? build-server-id
|
|
(assoc-ref build "build_server_id")))
|
|
(vector->list builds)))
|
|
,@(map (lambda (output)
|
|
`(div
|
|
"Output: " ,(assoc-ref output "output_name")
|
|
,@(map (lambda (nar)
|
|
`(div
|
|
(a (@ (href
|
|
,(assoc-ref output "output_path")))
|
|
"Build server "
|
|
,(assoc-ref nar "build_server_id"))))
|
|
(filter
|
|
(lambda (nar)
|
|
(eq? build-server-id
|
|
(assoc-ref nar "build_server_id")))
|
|
(vector->list
|
|
(or (assoc-ref output "nars")
|
|
#()))))))
|
|
(vector->list outputs))))
|
|
build-server-ids))))))
|
|
derivations)))
|
|
,@(if show-next-page?
|
|
`((div
|
|
(@ (class "row"))
|
|
(a (@ (href
|
|
,(next-page-link path-base
|
|
query-parameters
|
|
'after_name
|
|
(car (last derivations)))))
|
|
"Next page")))
|
|
'())))))))
|
|
|
|
(define* (view-revision-derivation-outputs commit-hash
|
|
query-parameters
|
|
derivation-outputs
|
|
show-next-page?
|
|
#:key (path-base "/revision/")
|
|
header-text
|
|
header-link)
|
|
(layout
|
|
#:body
|
|
`(,(header)
|
|
(div
|
|
(@ (class "container"))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
(h3 (a (@ (style "white-space: nowrap;")
|
|
(href ,header-link))
|
|
,@header-text))))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-md-12"))
|
|
(div
|
|
(@ (class "well"))
|
|
(form
|
|
(@ (method "get")
|
|
(action "")
|
|
(style "padding-bottom: 0")
|
|
(class "form-horizontal"))
|
|
,(form-horizontal-control
|
|
"Search query" query-parameters
|
|
#:help-text
|
|
"List packages where the derivation output path matches this query.")
|
|
,(form-horizontal-control
|
|
"Reproducibility status" query-parameters
|
|
#:allow-selecting-multiple-options #f
|
|
#:options '(("Any" . "any")
|
|
("Unknown" . "unknown")
|
|
("Reproducible" . "reproducible")
|
|
("Unreproducible" . "unreproducible"))
|
|
#:help-text "Do the known hashes for this output suggest it's reproducible, or not reproducible.")
|
|
,(form-horizontal-control
|
|
"After path" query-parameters
|
|
#:help-text
|
|
"List packages that are alphabetically after the given name.")
|
|
,(form-horizontal-control
|
|
"Limit results" query-parameters
|
|
#:help-text "The maximum number of packages by name to return.")
|
|
,(form-horizontal-control
|
|
"All results" query-parameters
|
|
#:type "checkbox"
|
|
#:help-text "Return all results.")
|
|
(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"))
|
|
(p "Showing " ,(length derivation-outputs) " results")
|
|
(table
|
|
(@ (class "table"))
|
|
(thead
|
|
(tr
|
|
(th "Path")
|
|
(th "Hash")
|
|
(th "Nars")))
|
|
(tbody
|
|
,@(map
|
|
(match-lambda
|
|
((path hash-algorithm hash recursive nars)
|
|
`(tr
|
|
(td (a (@ (href ,path))
|
|
,(display-store-item-short path)))
|
|
(td
|
|
,@(if
|
|
(null? hash-algorithm)
|
|
'()
|
|
`(,hash)))
|
|
(td
|
|
,@(map (lambda (nar)
|
|
`(div
|
|
,(assoc-ref nar "build_server_id")
|
|
" "
|
|
,(assoc-ref nar "hash")))
|
|
(vector->list nars))))))
|
|
derivation-outputs)))
|
|
,@(if show-next-page?
|
|
`((div
|
|
(@ (class "row"))
|
|
(a (@ (href
|
|
,(next-page-link path-base
|
|
query-parameters
|
|
'after_path
|
|
(car (last derivation-outputs)))))
|
|
"Next page")))
|
|
'())))))))
|
|
|
|
(define* (view-revision-lint-warnings revision-commit-hash
|
|
query-parameters
|
|
lint-warnings
|
|
git-repositories
|
|
lint-checker-options
|
|
#:key path-base
|
|
header-text header-link)
|
|
(define field-options
|
|
(map
|
|
(lambda (field)
|
|
(cons field
|
|
(hyphenate-words
|
|
(string-downcase field))))
|
|
'("Linter" "Message" "Location")))
|
|
|
|
(layout
|
|
#:body
|
|
`(,(header)
|
|
(div
|
|
(@ (class "container"))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
(h3 (a (@ (style "white-space: nowrap;")
|
|
(href ,header-link))
|
|
,@header-text))))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-md-12"))
|
|
(div
|
|
(@ (class "well"))
|
|
(form
|
|
(@ (method "get")
|
|
(action "")
|
|
(style "padding-bottom: 0")
|
|
(class "form-horizontal"))
|
|
,(form-horizontal-control
|
|
"Package query" query-parameters
|
|
#:help-text
|
|
"Lint warnings where the package name matches the query.")
|
|
,(form-horizontal-control
|
|
"Linter" query-parameters
|
|
#:options lint-checker-options
|
|
#:help-text
|
|
"Lint warnings for specific lint checkers.")
|
|
,(form-horizontal-control
|
|
"Message query" query-parameters
|
|
#:help-text
|
|
"Lint warnings where the message matches the query.")
|
|
,(form-horizontal-control
|
|
"Fields" query-parameters
|
|
#:name "field"
|
|
#:options field-options
|
|
#:help-text "Fields to return in the response.")
|
|
(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-sm-12"))
|
|
(a (@ (class "btn btn-default btn-lg pull-right")
|
|
(href ,(let ((query-parameter-string
|
|
(query-parameters->string query-parameters)))
|
|
(string-append
|
|
path-base ".json"
|
|
(if (string-null? query-parameter-string)
|
|
""
|
|
(string-append "?" query-parameter-string))))))
|
|
"View JSON")))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-sm-12"))
|
|
(h1 "Lint warnings")
|
|
(table
|
|
(@ (class "table table-responsive"))
|
|
(thead
|
|
(tr
|
|
(th (@ (class "col-md-3")) "Package")
|
|
,@(filter-map
|
|
(match-lambda
|
|
((label . value)
|
|
(if (member value (assq-ref query-parameters 'field))
|
|
`(th (@ (class "col-md-3")) ,label)
|
|
#f)))
|
|
field-options)
|
|
(th (@ (class "col-md-3")) "")))
|
|
(tbody
|
|
,@(let ((fields (assq-ref query-parameters 'field)))
|
|
(map
|
|
(match-lambda
|
|
((id lint-checker-name lint-checker-description
|
|
lint-checker-network-dependent
|
|
package-name package-version file line-number column-number
|
|
message)
|
|
`(tr
|
|
(td (a (@ (href ,(string-append
|
|
(string-join
|
|
(drop-right (string-split path-base #\/) 1)
|
|
"/")
|
|
"/package/" package-name "/" package-version)))
|
|
,package-name " @ " ,package-version))
|
|
,@(if (member "linter" fields)
|
|
`((td (span (@ (style "font-family: monospace; display: block;"))
|
|
,lint-checker-name)
|
|
(p (@ (style "font-size: small; margin: 6px 0 0px;"))
|
|
,lint-checker-description)))
|
|
'())
|
|
,@(if (member "message" fields)
|
|
`((td ,message))
|
|
'())
|
|
,@(if (member "location" fields)
|
|
`((td
|
|
,@(if (and file (not (string-null? file)))
|
|
`((ul
|
|
,@(map
|
|
(match-lambda
|
|
((id label url cgit-url-base)
|
|
(let ((output
|
|
`(,file
|
|
" "
|
|
(span
|
|
(@ (style "white-space: nowrap"))
|
|
"(line: " ,line-number
|
|
", column: " ,column-number ")"))))
|
|
(if
|
|
(and cgit-url-base
|
|
(not (string-null? cgit-url-base)))
|
|
`(li
|
|
(a (@ (href
|
|
,(string-append
|
|
cgit-url-base "tree/"
|
|
file "?id=" revision-commit-hash
|
|
"#n" line-number)))
|
|
,@output))
|
|
`(li ,@output)))))
|
|
git-repositories)))
|
|
'())))
|
|
'()))))
|
|
lint-warnings))))))))))
|
|
|
|
(define (unknown-revision commit-hash job git-repositories-and-branches
|
|
jobs-and-events)
|
|
(layout
|
|
#:body
|
|
`(,(header)
|
|
(div
|
|
(@ (class "container"))
|
|
,@(match job
|
|
(()
|
|
`((h1 "Unknown revision")
|
|
(p "No known revision with commit "
|
|
(strong (samp ,commit-hash)))))
|
|
((jobs ...)
|
|
`((div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-md-12"))
|
|
(h1 (@ (style "white-space: nowrap;"))
|
|
"Revision " (samp ,commit-hash))))
|
|
(div
|
|
(@ (class "row"))
|
|
(div
|
|
(@ (class "col-md-6"))
|
|
(h2 "Packages")
|
|
(strong (@ (class "text-center")
|
|
(style "font-size: 2em; display: block;"))
|
|
"Unknown")
|
|
|
|
,@(if (null? git-repositories-and-branches)
|
|
'()
|
|
(view-revision/git-repositories
|
|
git-repositories-and-branches
|
|
commit-hash))
|
|
,@(view-revision/jobs-and-events jobs-and-events))
|
|
(div
|
|
(@ (class "col-md-6"))
|
|
(h3 "Derivations")
|
|
(strong (@ (class "text-center")
|
|
(style "font-size: 2em; display: block;"))
|
|
"Unknown"))))))))))
|