From 414636535033c288f061f109b7c28d2ebbc4756d Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 1 Dec 2019 07:56:07 +0000
Subject: WIP

---
 guix-data-service/jobs/load-new-guix-revision.scm | 60 ++++++++++++++++-------
 1 file changed, 43 insertions(+), 17 deletions(-)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 86c3a78..7a87e51 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -333,29 +333,55 @@ WHERE job_id = $1"
 
   (define (proc packages system-target-pairs)
     `(lambda (store)
+       (define package-transitive-supported-systems-supports-multiple-arguments? #t)
+
        (append-map
         (lambda (inferior-package-id)
           (let ((package (hashv-ref %package-table inferior-package-id)))
             (catch
               #t
               (lambda ()
-                (let ((supported-systems
-                       (catch
-                         #t
-                         (lambda ()
-                           (package-transitive-supported-systems package))
-                         (lambda (key . args)
-                           (simple-format
-                            (current-error-port)
-                            "error: while processing ~A, unable to compute transitive supported systems\n"
-                            (package-name package))
-                           (simple-format
-                            (current-error-port)
-                            "error ~A: ~A\n" key args)
-                           #f))))
-                  (if supported-systems
-                      (append-map
-                       (lambda (system)
+                (append-map
+                 (lambda (system)
+                   (let ((supported-systems
+                          (or (and
+                               package-transitive-supported-systems-supports-multiple-arguments?
+                               (catch
+                                 'wrong-number-of-args
+                                 (lambda ()
+                                   (and=> (package-transitive-supported-systems package system)
+                                          (lambda (systems)
+                                            (if (member system systems)
+                                                systems)
+                                 (lambda (key . args)
+                                   ;; Older Guix revisions don't support two
+                                   ;; arguments to
+                                   ;; package-transitive-supported-systems
+                                   (simple-format
+                                    (current-error-port)
+                                    "info: package-transitive-supported-systems doesn't support two arguments, falling back to one\n")
+                                   (set! package-transitive-supported-systems-supports-multiple-arguments? #f)
+                                   #f))))))
+                              (catch
+                                #t
+                                (lambda ()
+                                  (and=> (package-transitive-supported-systems package)
+                                         (lambda (systems)
+                                           ;; Skip this system unless it's in
+                                           ;; the list of supported systems
+                                           (if (member system systems)
+                                               systems
+                                               #f))))
+                                (lambda (key . args)
+                                  (simple-format
+                                   (current-error-port)
+                                   "error: while processing ~A, unable to compute transitive supported systems\n"
+                                   (package-name package))
+                                  (simple-format
+                                   (current-error-port)
+                                   "error ~A: ~A\n" key args)
+                                  #f)))))
+                     (if supported-systems
                          (filter-map
                           (lambda (target)
                             (catch
-- 
cgit v1.2.3