cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add some navigation buttons

Browse source 
Both to the packages and derivations packages, as well as the JSON
representation of the pages.
This commit is contained in:
Christopher Baines 2019-02-26 08:33:17 +00:00
parent 2836a848cb
commit 46c724456f
Signed by: cbaines
GPG key ID: 5E28A33B0B84F577
1 changed files with 209 additions and 151 deletions
Download patch file Download diff file Expand all files Collapse all files

360
guix-data-service/web/view/html.scm
View file

@ -138,6 +138,10 @@
removed-packages removed-packages
version-changes version-changes
other-changes) other-changes)
(define query-params
(string-append "?base_commit=" base-commit
"&target_commit=" target-commit))
(layout (layout
#:extra-headers #:extra-headers
'((cache-control . ((max-age . 60)))) '((cache-control . ((max-age . 60))))
@ -145,76 +149,34 @@
`(,(header) `(,(header)
(div (div
(@ (class "container")) (@ (class "container"))
(h1 "Comparing " (div
(samp ,(string-take base-commit 8) "…") (@ (class "row"))
" and " (h1 (@ (class "pull-left"))
(samp ,(string-take target-commit 8) "…")) "Comparing "
(h3 "New packages") (samp ,(string-take base-commit 8) "…")
,(if (null? new-packages) " and "
'(p "No new packages") (samp ,(string-take target-commit 8) "…"))
`(table (div
(@ (class "table")) (@ (class "btn-group-vertical btn-group-lg pull-right") (role "group"))
(thead (a (@ (class "btn btn-default")
(tr (href ,(string-append "/compare/packages" query-params)))
(th (@ (class "col-md-3")) "Name") "Compare packages")
(th (@ (class "col-md-9")) "Version"))) (a (@ (class "btn btn-default")
(tbody (href ,(string-append "/compare/derivations" query-params)))
,@(map "Compare derivations")))
(match-lambda (div
((name version rest ...) (@ (class "row") (style "clear: left;"))
`(tr (a (@ (class "btn btn-default btn-lg")
(td ,name) (href ,(string-append
(td ,version)))) "/compare.json" query-params)))
new-packages)))) "View JSON"))
(h3 "Removed packages") (div
,(if (null? removed-packages) (@ (class "row"))
'(p "No removed packages") (h3 (@ (style "clear: both;"))
`(table "New packages")
(@ (class "table")) ,(if (null? new-packages)
(thead '(p "No new packages")
(tr `(table
(th (@ (class "col-md-3")) "Name")
(th (@ (class "col-md-9")) "Version")))
(tbody
,@(map
(match-lambda
((name version rest ...)
`(tr
(td ,name)
(td ,version))))
removed-packages))))
(h3 "Version changes")
,(if (null? version-changes)
'(p "No version changes")
`(table
(@ (class "table"))
(thead
(tr
(th (@ (class "col-md-3")) "Name")
(th (@ (class "col-md-9")) "Versions")))
(tbody
,@(map
(match-lambda
((name . versions)
`(tr
(td ,name)
(td (ul
,@(map (match-lambda
((type . version)
`(li (@ (class ,(if (eq? type 'base)
"text-danger"
"text-success")))
,version
,(if (eq? type 'base)
" (old)"
" (new)"))))
versions))))))
version-changes))))
(h3 "Other changed packages")
,@(if (null? other-changes)
'((p "No other changes"))
`((p "The metadata or derivation for these packages has changed.")
(table
(@ (class "table")) (@ (class "table"))
(thead (thead
(tr (tr
@ -223,16 +185,88 @@
(tbody (tbody
,@(map ,@(map
(match-lambda (match-lambda
(((name . version) . (metadata-id derivation-id)) ((name version rest ...)
`(tr `(tr
(td ,name) (td ,name)
(td ,version)))) (td ,version))))
other-changes))))))))) new-packages)))))
(div
(@ (class "row"))
(h3 "Removed packages")
,(if (null? removed-packages)
'(p "No removed packages")
`(table
(@ (class "table"))
(thead
(tr
(th (@ (class "col-md-3")) "Name")
(th (@ (class "col-md-9")) "Version")))
(tbody
,@(map
(match-lambda
((name version rest ...)
`(tr
(td ,name)
(td ,version))))
removed-packages)))))
(div
(@ (class "row"))
(h3 "Version changes")
,(if (null? version-changes)
'(p "No version changes")
`(table
(@ (class "table"))
(thead
(tr
(th (@ (class "col-md-3")) "Name")
(th (@ (class "col-md-9")) "Versions")))
(tbody
,@(map
(match-lambda
((name . versions)
`(tr
(td ,name)
(td (ul
,@(map (match-lambda
((type . version)
`(li (@ (class ,(if (eq? type 'base)
"text-danger"
"text-success")))
,version
,(if (eq? type 'base)
" (old)"
" (new)"))))
versions))))))
version-changes)))))
(div
(@ (class "row"))
(h3 "Other changed packages")
,@(if (null? other-changes)
'((p "No other changes"))
`((p "The metadata or derivation for these packages has changed.")
(table
(@ (class "table"))
(thead
(tr
(th (@ (class "col-md-3")) "Name")
(th (@ (class "col-md-9")) "Version")))
(tbody
,@(map
(match-lambda
(((name . version) . (metadata-id derivation-id))
`(tr
(td ,name)
(td ,version))))
other-changes))))))))))
(define (compare/derivations base-commit (define (compare/derivations base-commit
target-commit target-commit
base-derivations base-derivations
target-derivations) target-derivations)
(define query-params
(string-append "?base_commit=" base-commit
"&target_commit=" target-commit))
(layout (layout
#:extra-headers #:extra-headers
'((cache-control . ((max-age . 60)))) '((cache-control . ((max-age . 60))))
@ -240,47 +274,61 @@
`(,(header) `(,(header)
(div (div
(@ (class "container")) (@ (class "container"))
(h1 "Comparing " (div
(samp ,(string-take base-commit 8) "…") (@ (class "row"))
" and " (h1 "Comparing "
(samp ,(string-take target-commit 8) "…")) (samp ,(string-take base-commit 8) "…")
(h3 "Base (" " and "
(samp ,base-commit) (samp ,(string-take target-commit 8) "…"))
")") (a (@ (class "btn btn-default btn-lg")
(p "Derivations found only in the base revision.") (href ,(string-append
(table "/compare/derivations.json" query-params)))
(@ (class "table")) "View JSON"))
(thead (div
(tr (@ (class "row"))
(th (@ (class "col-md-12")) "File Name"))) (h3 "Base ("
(tbody (samp ,base-commit)
,@(map ")")
(match-lambda (p "Derivations found only in the base revision.")
((id file-name) (table
`(tr (@ (class "table"))
(td ,file-name)))) (thead
base-derivations))) (tr
(h3 "Target (" (th (@ (class "col-md-12")) "File Name")))
(samp ,target-commit) (tbody
")") ,@(map
(p "Derivations found only in the target revision.") (match-lambda
(table ((id file-name)
(@ (class "table")) `(tr
(thead (td ,file-name))))
(tr base-derivations))))
(th (@ (class "col-md-12")) "File Name"))) (div
(tbody (@ (class "row"))
,@(map (h3 "Target ("
(match-lambda (samp ,target-commit)
((id file-name) ")")
`(tr (p "Derivations found only in the target revision.")
(td ,file-name)))) (table
target-derivations))))))) (@ (class "table"))
(thead
(tr
(th (@ (class "col-md-12")) "File Name")))
(tbody
,@(map
(match-lambda
((id file-name)
`(tr
(td ,file-name))))
target-derivations))))))))
(define (compare/packages base-commit (define (compare/packages base-commit
target-commit target-commit
base-packages-vhash base-packages-vhash
target-packages-vhash) target-packages-vhash)
(define query-params
(string-append "?base_commit=" base-commit
"&target_commit=" target-commit))
(layout (layout
#:extra-headers #:extra-headers
'((cache-control . ((max-age . 60)))) '((cache-control . ((max-age . 60))))
@ -288,46 +336,56 @@
`(,(header) `(,(header)
(div (div
(@ (class "container")) (@ (class "container"))
(h1 "Comparing " (div
(samp ,(string-take base-commit 8) "…") (@ (class "row"))
" and " (h1 "Comparing "
(samp ,(string-take target-commit 8) "…")) (samp ,(string-take base-commit 8) "…")
(h3 "Base (" " and "
(samp ,base-commit) (samp ,(string-take target-commit 8) "…"))
")") (a (@ (class "btn btn-default btn-lg")
(p "Packages found in the base revision.") (href ,(string-append
(table "/compare/packages.json" query-params)))
(@ (class "table")) "View JSON"))
(thead (div
(tr (@ (class "row"))
(th (@ (class "col-md-6")) "Name") (h3 "Base ("
(th (@ (class "col-md-6")) "Version"))) (samp ,base-commit)
(tbody ")")
,@(map (p "Packages found in the base revision.")
(match-lambda (table
((name version rest ...) (@ (class "table"))
`(tr (thead
(td ,name) (tr
(td ,version)))) (th (@ (class "col-md-6")) "Name")
(vlist->list base-packages-vhash)))) (th (@ (class "col-md-6")) "Version")))
(h3 "Target (" (tbody
(samp ,target-commit) ,@(map
")") (match-lambda
(p "Packages found in the target revision.") ((name version rest ...)
(table `(tr
(@ (class "table")) (td ,name)
(thead (td ,version))))
(tr (vlist->list base-packages-vhash)))))
(th (@ (class "col-md-6")) "Name") (div
(th (@ (class "col-md-6")) "Version"))) (@ (class "row"))
(tbody (h3 "Target ("
,@(map (samp ,target-commit)
(match-lambda ")")
((name version rest ...) (p "Packages found in the target revision.")
`(tr (table
(td ,name) (@ (class "table"))
(td ,version)))) (thead
(vlist->list target-packages-vhash)))))))) (tr
(th (@ (class "col-md-6")) "Name")
(th (@ (class "col-md-6")) "Version")))
(tbody
,@(map
(match-lambda
((name version rest ...)
`(tr
(td ,name)
(td ,version))))
(vlist->list target-packages-vhash)))))))))
(define (compare-unknown-commit base-commit target-commit (define (compare-unknown-commit base-commit target-commit
base-exists? target-exists? base-exists? target-exists?