Change data handling when comparing derivations

comparison.scm: return query data for derivation comparison as an alist,
instead of list.
html.scm: Access derivation differences data using assq-ref.
controller.scm: remove mapping for outputs/inputs/sources.
utils.scm: add group-to-alist/vector function.

Signed-off-by: Christopher Baines <mail@cbaines.net>

4 files changed, 97 insertions, 154 deletions

diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm
index d40f8e6..3eee5f7 100644
--- a/guix-data-service/comparison.scm
+++ b/guix-data-service/comparison.scm
@@ -74,19 +74,20 @@
               'value))
 
   `((outputs
-     . ,(group-to-alist
+     . ,(group-to-alist/vector
          group-by-last-element
          (derivation-outputs-differences-data conn
                                               (first base-derivation)
                                               (first target-derivation))))
     (inputs
-     . ,(group-to-alist
+     . ,(group-to-alist/vector
          group-by-last-element
          (derivation-inputs-differences-data conn
                                              (first base-derivation)
                                              (first target-derivation))))
+
     (sources
-     . ,(group-to-alist
+     . ,(group-to-alist/vector
          group-by-last-element
          (derivation-sources-differences-data conn
                                               (first base-derivation)
@@ -107,9 +108,9 @@
                         (target . ,target-builder))))
               (arguments
                . ,(if (eq? base-args target-args)
-                      `((common . ,base-args))
-                      `((base . ,base-args)
-                        (target . ,target-args))))
+                      `((common . ,(list->vector base-args)))
+                      `((base . ,(list->vector base-args))
+                        (target . ,(list->vector target-args)))))
               (environment-variables
                . ,(map (lambda (key)
                          (let ((base-value (fetch-value base-env-vars key))
@@ -158,19 +159,23 @@ GROUP BY 1, 2, 3, 4, 5"))
           (let ((parsed-derivation-ids
                  (map string->number
                       (parse-postgresql-array-string derivation_ids))))
-            (list output-name
-                  path
-                  hash-algorithm
-                  hash
-                  recursive
-                  (append (if (memq base-derivation-id
-                                    parsed-derivation-ids)
-                              '(base)
-                              '())
-                          (if (memq target-derivation-id
-                                    parsed-derivation-ids)
-                              '(target)
-                              '()))))))
+            `((output-name . ,output-name)
+              (path . ,path)
+              ,@(if (string? hash-algorithm)
+                    `((hash-algorithm . ,hash-algorithm))
+                    `((hash-algorithm . null)))
+              ,@(if (string? hash)
+                    `((hash . ,hash))
+                    `((hash . null)))
+              (recursive . ,(string=? recursive "t"))
+              ,(append (if (memq base-derivation-id
+                                 parsed-derivation-ids)
+                           '(base)
+                           '())
+                       (if (memq target-derivation-id
+                                 parsed-derivation-ids)
+                           '(target)
+                           '()))))))
        (exec-query conn query)))
 
 (define (derivation-inputs-differences-data conn
@@ -202,16 +207,16 @@ INNER JOIN derivations ON derivation_outputs.derivation_id = derivations.id
           (let ((parsed-derivation-ids
                  (map string->number
                       (parse-postgresql-array-string derivation_ids))))
-          (list derivation_file_name
-                derivation_output_name
-                (append (if (memq base-derivation-id
-                                  parsed-derivation-ids)
-                            '(base)
-                            '())
-                        (if (memq target-derivation-id
-                                  parsed-derivation-ids)
-                            '(target)
-                            '()))))))
+            `((derivation_file_name . ,derivation_file_name)
+              (derivation_output_name . ,derivation_output_name)
+              ,(append (if (memq base-derivation-id
+                                 parsed-derivation-ids)
+                           '(base)
+                           '())
+                       (if (memq target-derivation-id
+                                 parsed-derivation-ids)
+                           '(target)
+                           '()))))))
        (exec-query conn query)))
 
 (define (derivation-sources-differences-data conn
@@ -235,15 +240,15 @@ GROUP BY derivation_source_files.store_path"))
           (let ((parsed-derivation-ids
                  (map string->number
                       (parse-postgresql-array-string derivation_ids))))
-            (list store_path
-                  (append (if (memq base-derivation-id
-                                    parsed-derivation-ids)
-                              '(base)
-                              '())
-                          (if (memq target-derivation-id
-                                    parsed-derivation-ids)
-                              '(target)
-                              '()))))))
+            `((store_path . ,store_path)
+              ,(append (if (memq base-derivation-id
+                                 parsed-derivation-ids)
+                           '(base)
+                           '())
+                       (if (memq target-derivation-id
+                                 parsed-derivation-ids)
+                           '(target)
+                           '()))))))
        (exec-query conn query)))
 
 (define* (package-derivation-differences-data conn
diff --git a/guix-data-service/model/utils.scm b/guix-data-service/model/utils.scm
index 13947bd..b11cee5 100644
--- a/guix-data-service/model/utils.scm
+++ b/guix-data-service/model/utils.scm
@@ -33,6 +33,7 @@
             deduplicate-strings
             group-list-by-first-n-fields
             group-to-alist
+            group-to-alist/vector
             insert-missing-data-and-return-all-ids))
 
 (define NULL '())
@@ -114,6 +115,13 @@
         '()
         lst))
 
+(define (group-to-alist/vector process lst)
+  (map
+   (match-lambda
+     ((label . items)
+      (cons label (list->vector items))))
+   (group-to-alist process lst)))
+
 (define (table-schema conn table-name)
   (let ((results
          (exec-query
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index 30cf835..bbc9829 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -589,82 +589,18 @@
                  '(application/json text/html)
                  mime-types)
             ((application/json)
-             (let ((outputs
-                    (map
-                     (lambda (label items)
-                       (cons label
-                             (list->vector
-                              (map
-                               (match-lambda
-                                 ((name path hash-alg hash recursive)
-                                  `((name . ,name)
-                                    (path . ,path)
-                                    ,@(if (string? hash-alg)
-                                          `((hash-algorithm . ,hash-alg))
-                                          '())
-                                    ,@(if (string? hash)
-                                          `((hash . ,hash))
-                                          '())
-                                    (recursive . ,(string=? recursive "t")))))
-                               (or items '())))))
-                     '(base target common)
-                     (let ((output-groups (assq-ref data 'outputs)))
-                       (list (assq-ref output-groups 'base)
-                             (assq-ref output-groups 'target)
-                             (assq-ref output-groups 'common)))))
-
-                   (inputs
-                    (map
-                     (lambda (label items)
-                       (cons label
-                             (list->vector
-                              (map
-                               (match-lambda
-                                 ((derivation output)
-                                  `((derivation . ,derivation)
-                                    (output . ,output))))
-                               (or items '())))))
-                     '(base target common)
-                     (let ((input-groups (assq-ref data 'inputs)))
-                       (list (assq-ref input-groups 'base)
-                             (assq-ref input-groups 'target)
-                             (assq-ref input-groups 'common)))))
-
-                   (sources
-                    (map
-                     (lambda (label items)
-                       (cons label
-                             (list->vector
-                              (map
-                               (match-lambda
-                                 ((derivation)
-                                  `((derivation . ,derivation))))
-                               (or items '())))))
-                     '(base target common)
-                     (let ((source-groups (assq-ref data 'sources)))
-                       (list (assq-ref source-groups 'base)
-                             (assq-ref source-groups 'target)
-                             (assq-ref source-groups 'common)))))
-
-                   (arguments
-                    (map
-                     (match-lambda
-                       ((label args ...)
-                        `(,label . ,(list->vector args))))
-                     (assq-ref data 'arguments))))
-
-               (render-json
-                `((base                  . ((derivation . ,base-derivation)))
-                  (target                . ((derivation . ,target-derivation)))
-                  (outputs               . ,outputs)
-                  (inputs                . ,inputs)
-                  (sources               . ,sources)
-                  (system                . ,(assq-ref data 'system))
-                  (builder               . ,(assq-ref data 'builder))
-                  (arguments             . ,arguments)
-                  (environment-variables . ,(assq-ref
-                                             data 'environment-variables)))
-                #:extra-headers http-headers-for-unchanging-content)))
+             (render-json
+              `((base                  . ((derivation . ,base-derivation)))
+                (target                . ((derivation . ,target-derivation)))
+                (outputs               . ,(assq-ref data 'outputs))
+                (inputs                . ,(assq-ref data 'inputs))
+                (sources               . ,(assq-ref data 'sources))
+                (system                . ,(assq-ref data 'system))
+                (builder               . ,(assq-ref data 'builder))
+                (arguments             . ,(assq-ref data 'arguments))
+                (environment-variables . ,(assq-ref
+                                           data 'environment-variables)))
+              #:extra-headers http-headers-for-unchanging-content))
             (else
              (render-html
               #:sxml (compare/derivation
diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm
index be98f43..128e3f4 100644
--- a/guix-data-service/web/compare/html.scm
+++ b/guix-data-service/web/compare/html.scm
@@ -494,27 +494,23 @@
                  (th "Hash")
                  (th "Recursive")))
                (tbody
-                ,@(let ((base-outputs (assq-ref outputs 'base))
-                        (target-outputs (assq-ref outputs 'target))
-                        (common-outputs (assq-ref outputs 'common)))
-                    (append-map
-                     (lambda (label items)
-                       (map
-                        (match-lambda
-                          ((name path hash-algorithm hash recursive)
-                           `(tr
-                             (td ,label)
-                             (td ,name)
-                             (td (a (@ (href ,path))
-                                    ,(display-store-item path)))
-                             (td ,hash-algorithm)
-                             (td ,hash)
-                             (td ,recursive))))
-                        (or items '())))
-                     (list base target "Common")
-                     (list (assq-ref outputs 'base)
-                           (assq-ref outputs 'target)
-                           (assq-ref outputs 'common))))))))
+                ,@(append-map
+                   (lambda (label items)
+                     (map
+                      (lambda (alist)
+                        `(tr
+                          (td ,label)
+                          (td ,(assq-ref alist 'output-name))
+                          (td (a (@ (href ,(assq-ref alist 'path)))
+                                 ,(display-store-item (assq-ref alist 'path))))
+                          (td ,(assq-ref alist 'hash-algorithm))
+                          (td ,(assq-ref alist 'hash))
+                          (td ,(assq-ref alist 'recursive))))
+                      (or (and=> items vector->list) '())))
+                   (list base target "Common")
+                   (list (assq-ref outputs 'base)
+                         (assq-ref outputs 'target)
+                         (assq-ref outputs 'common)))))))
         (h2 "Inputs")
         ,@(let ((inputs (assq-ref data 'inputs)))
             `((table
@@ -528,14 +524,13 @@
                 ,@(append-map
                    (lambda (label items)
                      (map
-                      (match-lambda
-                        ((derivation outputs)
-                         `(tr
-                           (td ,label)
-                           (td (a (@ (href ,derivation))
-                                  ,(display-store-item derivation)))
-                           (td ,outputs))))
-                      (or items '())))
+                      (lambda (alist)
+                        `(tr
+                          (td ,label)
+                          (td (a (@ (href ,(assq-ref alist 'derivation_file_name)))
+                                 ,(display-store-item (assq-ref alist 'derivation_file_name))))
+                          (td ,(assq-ref alist 'derivation_output_name))))
+                      (or (and=> items vector->list) '())))
                    (list base target)
                    (list (assq-ref inputs 'base)
                          (assq-ref inputs 'target)))))))
@@ -552,13 +547,12 @@
                 ,@(append-map
                    (lambda (label items)
                      (map
-                      (match-lambda
-                        ((file)
-                         `(tr
-                           (td ,label)
-                           (td (a (@ (href ,file))
-                                  ,(display-store-item file))))))
-                      (or items '())))
+                      (lambda (alist)
+                        `(tr
+                          (td ,label)
+                          (td (a (@ (href ,(assq-ref alist 'store_path)))
+                                 ,(display-store-item (assq-ref alist 'store_path))))))
+                      (or (and=> items vector->list) '())))
                    (list base target "Common")
                    (list (assq-ref sources 'base)
                          (assq-ref sources 'target)
@@ -622,8 +616,8 @@
                            (td (ol
                                 ,@(map (lambda (arg)
                                          `(li ,(display-possible-store-item arg)))
-                                       (or common-args
-                                           base-args)))))
+                                       (or (and=> common-args vector->list)
+                                           (vector->list base-args))))))
                           (tr
                            (td ,target)
                            (td ,(display-possible-store-item
@@ -632,8 +626,8 @@
                            (td (ol
                                 ,@(map (lambda (arg)
                                          `(li ,(display-possible-store-item arg)))
-                                       (or common-args
-                                           target-args))))))))))))
+                                       (or (and=> common-args vector->list)
+                                           (vector->list target-args)))))))))))))
         (h2 "Environment variables")
         ,(let ((environment-variables (assq-ref data 'environment-variables)))
            `(table