gnu: aspell-dict-en: Update to 2016.01.19-0.

[jackhill/guix/guix.git] / build-aux / check-available-binaries.scm

diff --git a/build-aux/check-available-binaries.scm b/build-aux/check-available-binaries.scm
index d5163a9..771dcd9 100644 (file)
--- a/build-aux/check-available-binaries.scm
+++ b/build-aux/check-available-binaries.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,33 +26,28 @@
              (gnu packages emacs)
              (gnu packages make-bootstrap)
              (srfi srfi-1)
-             (srfi srfi-26))
+             (srfi srfi-26)
+             (ice-9 format))
 
-(define %supported-systems
-  '("x86_64-linux" "i686-linux"))
+(with-store store
+  (parameterize ((%graft? #f))
+    (let* ((native (append-map (lambda (system)
+                                 (map (cut package-derivation store <> system)
+                                      (list %bootstrap-tarballs emacs)))
+                               %hydra-supported-systems))
+           (cross  (map (cut package-cross-derivation store
+                             %bootstrap-tarballs <>)
+                        '("mips64el-linux-gnuabi64")))
+           (total  (append native cross)))
 
-(let* ((store  (open-connection))
-       (native (append-map (lambda (system)
-                             (map (cut package-derivation store <> system)
-                                  (list %bootstrap-tarballs emacs)))
-                           %supported-systems))
-       (cross  (map (cut package-cross-derivation store
-                         %bootstrap-tarballs <>)
-                    '("mips64el-linux-gnuabi64")))
-       (total  (append native cross)))
-  (define (warn proc)
-    (lambda (drv)
-      (or (proc drv)
-          (begin
-            (format (current-error-port) "~a is not substitutable~%"
-                    drv)
-            #f))))
-
-  (set-build-options store #:use-substitutes? #t)
-  (let ((result (every (compose (warn (cut has-substitutes? store <>))
-                                derivation->output-path)
-                       total)))
-    (when result
-      (format (current-error-port) "~a packages found substitutable~%"
-              (length total)))
-    (exit result)))
+      (set-build-options store #:use-substitutes? #t)
+      (let* ((total     (map derivation->output-path total))
+             (available (substitutable-paths store total))
+             (missing   (lset-difference string=? total available)))
+        (if (null? missing)
+            (format (current-error-port) "~a packages found substitutable~%"
+                    (length total))
+            (format (current-error-port)
+                    "~a packages are not substitutable:~%~{  ~a~%~}~%"
+                    (length missing) missing))
+        (exit (null? missing))))))