From 5bb4dfdabea34af0bfa03d6430935124f7b60a90 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 9 Nov 2019 08:30:02 +0000
Subject: WIP

---
 guix-data-service/comparison.scm | 83 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 82 insertions(+), 1 deletion(-)

(limited to 'guix-data-service/comparison.scm')

diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm
index 9aa8863..0c7c208 100644
--- a/guix-data-service/comparison.scm
+++ b/guix-data-service/comparison.scm
@@ -4,8 +4,11 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (squee)
+  #:use-module (guix-data-service model utils)
   #:use-module (guix-data-service model derivation)
-  #:export (package-data->package-data-vhashes
+  #:export (derivation-differences-data
+
+            package-data->package-data-vhashes
             package-differences-data
             package-data-vhash->derivations
             package-data->names-and-versions
@@ -17,6 +20,84 @@
 
             lint-warning-differences-data))
 
+(define (group-to-alist process lst)
+  (fold (lambda (element result)
+          (match (process element)
+            ((key . value)
+             (match (assoc key result)
+               ((_ . existing-values)
+                `((,key . ,(cons value existing-values))
+                  ,@result))
+               (#f
+                `((,key . (,value))
+                  ,@result))))))
+        '()
+        lst))
+
+(define (derivation-differences-data conn
+                                     base-derivation-file-name
+                                     target-derivation-file-name)
+  (define base-derivation
+    (select-derivation-by-file-name conn base-derivation-file-name))
+
+  (define target-derivation
+    (select-derivation-by-file-name conn target-derivation-file-name))
+
+  `((inputs
+     . ,(group-to-alist
+         (match-lambda
+           ((file-name output-name groups)
+            (cons (if (eq? (length groups) 2)
+                      'common
+                      (first groups))
+                  (list file-name output-name))))
+         (derivation-inputs-differences-data conn
+                                             (string->number
+                                              (first base-derivation))
+                                             (string->number
+                                              (first target-derivation)))))))
+
+(define (derivation-inputs-differences-data conn
+                                            base-derivation-id
+                                            target-derivation-id)
+  (define query
+    (string-append
+     "
+SELECT derivations.file_name,
+       derivation_outputs.name,
+       relevant_derivation_inputs.derivation_ids
+FROM derivation_outputs
+INNER JOIN (
+  SELECT derivation_output_id,
+         ARRAY_AGG(derivation_id) AS derivation_ids
+  FROM derivation_inputs
+  WHERE derivation_id IN (" (simple-format #f "~A,~A"
+                                           base-derivation-id
+                                           target-derivation-id)
+  ") GROUP BY derivation_output_id
+) AS relevant_derivation_inputs
+  ON derivation_outputs.id = relevant_derivation_inputs.derivation_output_id
+INNER JOIN derivations ON derivation_outputs.derivation_id = derivations.id
+"))
+
+  (map (match-lambda
+         ((derivation_file_name derivation_output_name
+                                derivation_ids)
+          (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)
+                            '()))))))
+       (exec-query conn query)))
+
 (define* (package-differences-data conn
                                    base_guix_revision_id
                                    target_guix_revision_id
-- 
cgit v1.2.3