diff options
author | Christopher Baines <mail@cbaines.net> | 2019-03-16 21:55:09 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2019-03-16 22:20:55 +0000 |
commit | 5325cf02341fca124de8567e14adc06bcbffd5c2 (patch) | |
tree | 54b51637309a428830e46389ffe62588a9c96c87 /guix-data-service/web/view | |
parent | 902409b8284cb5827b9a8b36ef19110db28c5e60 (diff) | |
download | data-service-5325cf02341fca124de8567e14adc06bcbffd5c2.tar data-service-5325cf02341fca124de8567e14adc06bcbffd5c2.tar.gz |
Fix the JSON responses for the comparison pages
Diffstat (limited to 'guix-data-service/web/view')
-rw-r--r-- | guix-data-service/web/view/html.scm | 73 |
1 files changed, 46 insertions, 27 deletions
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 8d7405c..8640774 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -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 |