From d62ea8857d5f4ed38c1026407f3541b234176f12 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 29 Mar 2019 09:14:03 +0000
Subject: Better handle failures when computing the transative supported inputs

---
 guix-data-service/jobs/load-new-guix-revision.scm | 78 +++++++++++++----------
 1 file changed, 46 insertions(+), 32 deletions(-)

(limited to 'guix-data-service')

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 056432a..94b0c0b 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -63,38 +63,52 @@
               #t
               (lambda ()
                 (let ((supported-systems
-                       (package-transitive-supported-systems package)))
-                  (append-map
-                   (lambda (system)
-                     (filter-map
-                      (lambda (target)
-                        (catch
-                          'misc-error
-                          (lambda ()
-                            (guard (c ((package-cross-build-system-error? c)
-                                       #f))
-                              (list inferior-package-id
-                                    system
-                                    target
-                                    (derivation-file-name
-                                     (if (string=? system target)
-                                         (package-derivation store package system)
-                                         (package-cross-derivation store package
-                                                                   target
-                                                                   system))))))
-                          (lambda args
-                            ;; misc-error #f ~A ~S (No
-                            ;; cross-compilation for
-                            ;; clojure-build-system yet:
-                            #f)))
-                      (lset-intersection
-                       string=?
-                       supported-systems
-                       (list ,@(map cdr system-target-pairs)))))
-                   (lset-intersection
-                    string=?
-                    supported-systems
-                    (list ,@(map car system-target-pairs))))))
+                       (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)
+                         (filter-map
+                          (lambda (target)
+                            (catch
+                              'misc-error
+                              (lambda ()
+                                (guard (c ((package-cross-build-system-error? c)
+                                           #f))
+                                  (list inferior-package-id
+                                        system
+                                        target
+                                        (derivation-file-name
+                                         (if (string=? system target)
+                                             (package-derivation store package system)
+                                             (package-cross-derivation store package
+                                                                       target
+                                                                       system))))))
+                              (lambda args
+                                ;; misc-error #f ~A ~S (No
+                                ;; cross-compilation for
+                                ;; clojure-build-system yet:
+                                #f)))
+                          (lset-intersection
+                           string=?
+                           supported-systems
+                           (list ,@(map cdr system-target-pairs)))))
+                       (lset-intersection
+                        string=?
+                        supported-systems
+                        (list ,@(map car system-target-pairs))))
+                      '())))
               (lambda args
                 (simple-format (current-error-port)
                                "error: while processing ~A ignoring error: ~A\n"
-- 
cgit v1.2.3