Fix the JSON responses for the comparison pages

3 files changed, 102 insertions, 63 deletions

diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm
index 132def8..68cafa8 100644
--- a/guix-data-service/comparison.scm
+++ b/guix-data-service/comparison.scm
@@ -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)))
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index a8dd897..1b83b02 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -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
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