mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Fix the JSON responses for the comparison pages
This commit is contained in:
Christopher Baines
parent
902409b828
commit
5325cf0234
3 changed files with 102 additions and 63 deletions
|
|
@ -126,20 +126,30 @@ ORDER BY base_packages.name DESC, base_packages.version, target_packages.name, t
|
|||
vhash))
|
||||
|
||||
(define (package-data-vhashes->new-packages base-packages-vhash target-packages-vhash)
|
||||
(vlist->list
|
||||
(package-data-vhash->package-name-and-version-vhash
|
||||
(vlist-filter (match-lambda
|
||||
((name . details)
|
||||
(not (vhash-assoc name base-packages-vhash))))
|
||||
target-packages-vhash))))
|
||||
(map
|
||||
(match-lambda
|
||||
(((name . version) metadata ...)
|
||||
`((name . ,name)
|
||||
(version . ,version))))
|
||||
(vlist->list
|
||||
(package-data-vhash->package-name-and-version-vhash
|
||||
(vlist-filter (match-lambda
|
||||
((name . details)
|
||||
(not (vhash-assoc name base-packages-vhash))))
|
||||
target-packages-vhash)))))
|
||||
|
||||
(define (package-data-vhashes->removed-packages base-packages-vhash target-packages-vhash)
|
||||
(vlist->list
|
||||
(package-data-vhash->package-name-and-version-vhash
|
||||
(vlist-filter (match-lambda
|
||||
((name . details)
|
||||
(not (vhash-assoc name target-packages-vhash))))
|
||||
base-packages-vhash))))
|
||||
(map
|
||||
(match-lambda
|
||||
(((name . version) metadata ...)
|
||||
`((name . ,name)
|
||||
(version . ,version))))
|
||||
(vlist->list
|
||||
(package-data-vhash->package-name-and-version-vhash
|
||||
(vlist-filter (match-lambda
|
||||
((name . details)
|
||||
(not (vhash-assoc name target-packages-vhash))))
|
||||
base-packages-vhash)))))
|
||||
|
||||
(define (package-data-vhash->package-versions-vhash package-data-vhash)
|
||||
(define (system-and-target<? a b)
|
||||
|
|
@ -180,8 +190,10 @@ ORDER BY base_packages.name DESC, base_packages.version, target_packages.name, t
|
|||
(begin
|
||||
(if (equal? base-versions target-versions)
|
||||
result
|
||||
`((,name . ((base . ,(map car base-versions))
|
||||
(target . ,(map car target-versions))))
|
||||
`((,name . ((base . ,(list->vector
|
||||
(map car base-versions)))
|
||||
(target . ,(list->vector
|
||||
(map car target-versions)))))
|
||||
,@result)))
|
||||
result)))
|
||||
'()
|
||||
|
|
@ -197,25 +209,33 @@ ORDER BY base_packages.name DESC, base_packages.version, target_packages.name, t
|
|||
(define (derivation-system-and-target-list->alist lst)
|
||||
(if (null? lst)
|
||||
'()
|
||||
`((,(cdr (first lst)) . ,(car (first lst)))
|
||||
`(,(match (first lst)
|
||||
((derivation-file-name system target)
|
||||
`((system . ,system)
|
||||
(target . ,target)
|
||||
(derivation-file-name . ,derivation-file-name))))
|
||||
,@(derivation-system-and-target-list->alist (cdr lst)))))
|
||||
|
||||
(vhash-fold
|
||||
(lambda (name-and-version target-packages-entry result)
|
||||
(let ((base-packages-entry
|
||||
(vhash-assoc name-and-version
|
||||
base-package-details-by-name-and-version)))
|
||||
(if base-packages-entry
|
||||
(let ((base-derivations (map cdr (cdr base-packages-entry)))
|
||||
(target-derivations (map cdr target-packages-entry)))
|
||||
(if (equal? base-derivations target-derivations)
|
||||
result
|
||||
`((,name-and-version
|
||||
. ((base . ,(derivation-system-and-target-list->alist
|
||||
base-derivations))
|
||||
(target . ,(derivation-system-and-target-list->alist
|
||||
target-derivations))))
|
||||
,@result)))
|
||||
result)))
|
||||
'()
|
||||
target-package-details-by-name-and-version))
|
||||
(list->vector
|
||||
(vhash-fold
|
||||
(lambda (name-and-version target-packages-entry result)
|
||||
(let ((base-packages-entry
|
||||
(vhash-assoc name-and-version
|
||||
base-package-details-by-name-and-version)))
|
||||
(if base-packages-entry
|
||||
(let ((base-derivations (map cdr (cdr base-packages-entry)))
|
||||
(target-derivations (map cdr target-packages-entry)))
|
||||
(if (equal? base-derivations target-derivations)
|
||||
result
|
||||
`(((name . ,(car name-and-version))
|
||||
(version . ,(cdr name-and-version))
|
||||
(base . ,(list->vector
|
||||
(derivation-system-and-target-list->alist
|
||||
base-derivations)))
|
||||
(target . ,(list->vector
|
||||
(derivation-system-and-target-list->alist
|
||||
target-derivations))))
|
||||
,@result)))
|
||||
result)))
|
||||
'()
|
||||
target-package-details-by-name-and-version)))
|
||||
|
|
|
|||
|
|
@ -121,8 +121,8 @@
|
|||
(cond
|
||||
((eq? content-type 'json)
|
||||
(render-json
|
||||
`((new-packages . ,new-packages)
|
||||
(removed-packages . ,removed-packages)
|
||||
`((new-packages . ,(list->vector new-packages))
|
||||
(removed-packages . ,(list->vector removed-packages))
|
||||
(version-changes . ,version-changes)
|
||||
(derivation-changes . ,derivation-changes))))
|
||||
(else
|
||||
|
|
|
|||
|
|
@ -593,7 +593,8 @@
|
|||
(tbody
|
||||
,@(map
|
||||
(match-lambda
|
||||
(((name . version) metadata)
|
||||
((('name . name)
|
||||
('version . version))
|
||||
`(tr
|
||||
(td ,name)
|
||||
(td ,version))))
|
||||
|
|
@ -612,7 +613,8 @@
|
|||
(tbody
|
||||
,@(map
|
||||
(match-lambda
|
||||
(((name . version) metadata)
|
||||
((('name . name)
|
||||
('version . version))
|
||||
`(tr
|
||||
(td ,name)
|
||||
(td ,version))))
|
||||
|
|
@ -636,7 +638,7 @@
|
|||
(td ,name)
|
||||
(td (ul
|
||||
,@(map (match-lambda
|
||||
((type . version)
|
||||
((type . #(version))
|
||||
`(li (@ (class ,(if (eq? type 'base)
|
||||
"text-danger"
|
||||
"text-success")))
|
||||
|
|
@ -665,33 +667,50 @@
|
|||
(tbody
|
||||
,@(append-map
|
||||
(match-lambda
|
||||
(((name . version) . (('base . base-derivations)
|
||||
('target . target-derivations)))
|
||||
((('name . name)
|
||||
('version . version)
|
||||
('base . base-derivations)
|
||||
('target . target-derivations))
|
||||
(let* ((system-and-versions
|
||||
(delete-duplicates
|
||||
(append (map car base-derivations)
|
||||
(map car target-derivations))))
|
||||
(append (map (lambda (details)
|
||||
(cons (assq-ref details 'system)
|
||||
(assq-ref details 'target)))
|
||||
(vector->list base-derivations))
|
||||
(map (lambda (details)
|
||||
(cons (assq-ref details 'system)
|
||||
(assq-ref details 'target)))
|
||||
(vector->list target-derivations)))))
|
||||
(data-columns
|
||||
(map
|
||||
(lambda (system-and-target)
|
||||
(let ((base-derivation-file-name
|
||||
(assoc-ref base-derivations system-and-target))
|
||||
(target-derivation-file-name
|
||||
(assoc-ref target-derivations system-and-target)))
|
||||
`((td (samp (@ (style "white-space: nowrap;"))
|
||||
,(car system-and-target)))
|
||||
(td (samp (@ (style "white-space: nowrap;"))
|
||||
,(cdr system-and-target)))
|
||||
(td (a (@ (style "display: block;")
|
||||
(href ,base-derivation-file-name))
|
||||
(span (@ (class "text-danger glyphicon glyphicon-minus pull-left")
|
||||
(style "font-size: 1.5em; padding-right: 0.4em;")))
|
||||
,(display-store-item-short base-derivation-file-name))
|
||||
(a (@ (style "display: block;")
|
||||
(href ,target-derivation-file-name))
|
||||
(span (@ (class "text-success glyphicon glyphicon-plus pull-left")
|
||||
(style "font-size: 1.5em; padding-right: 0.4em;")))
|
||||
,(display-store-item-short target-derivation-file-name))))))
|
||||
(match-lambda
|
||||
((system . target)
|
||||
(let ((base-derivation-file-name
|
||||
(assq-ref (find (lambda (details)
|
||||
(and (string=? (assq-ref details 'system) system)
|
||||
(string=? (assq-ref details 'target) target)))
|
||||
(vector->list base-derivations))
|
||||
'derivation-file-name))
|
||||
(target-derivation-file-name
|
||||
(assq-ref (find (lambda (details)
|
||||
(and (string=? (assq-ref details 'system) system)
|
||||
(string=? (assq-ref details 'target) target)))
|
||||
(vector->list target-derivations))
|
||||
'derivation-file-name)))
|
||||
`((td (samp (@ (style "white-space: nowrap;"))
|
||||
,system))
|
||||
(td (samp (@ (style "white-space: nowrap;"))
|
||||
,target))
|
||||
(td (a (@ (style "display: block;")
|
||||
(href ,base-derivation-file-name))
|
||||
(span (@ (class "text-danger glyphicon glyphicon-minus pull-left")
|
||||
(style "font-size: 1.5em; padding-right: 0.4em;")))
|
||||
,(display-store-item-short base-derivation-file-name))
|
||||
(a (@ (style "display: block;")
|
||||
(href ,target-derivation-file-name))
|
||||
(span (@ (class "text-success glyphicon glyphicon-plus pull-left")
|
||||
(style "font-size: 1.5em; padding-right: 0.4em;")))
|
||||
,(display-store-item-short target-derivation-file-name)))))))
|
||||
system-and-versions)))
|
||||
|
||||
`((tr (td (@ (rowspan , (length system-and-versions)))
|
||||
|
|
@ -702,7 +721,7 @@
|
|||
,@(map (lambda (data-row)
|
||||
`(tr ,data-row))
|
||||
(cdr data-columns))))))
|
||||
derivation-changes)))))))))
|
||||
(vector->list derivation-changes))))))))))
|
||||
|
||||
(define (compare/derivations base-commit
|
||||
target-commit
|
||||
|
|
|
|||
Loading…
Reference in a new issue