GNU bug report logs - #29930
[PATCH 4/5] profiles: Filter out unwanted manifest entries for profile hooks.

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guix-patches; Reported by: 宋文武 <iyzsong@HIDDEN>; Keywords: patch; merged with #29925, #29926, #29929; dated Mon, 1 Jan 2018 10:34:08 UTC; Maintainer for guix-patches is guix-patches@HIDDEN.
Merged 29925 29926 29929 29930. Request was from ludo@HIDDEN (Ludovic Courtès) to control <at> debbugs.gnu.org. Full text available.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 1 Jan 2018 10:34:02 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Jan 01 05:34:02 2018
Received: from localhost ([127.0.0.1]:59258 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1eVxPt-0000tr-JA
	for submit <at> debbugs.gnu.org; Mon, 01 Jan 2018 05:34:02 -0500
Received: from eggs.gnu.org ([208.118.235.92]:57824)
 by debbugs.gnu.org with esmtp (Exim 4.84_2)
 (envelope-from <iyzsong@HIDDEN>) id 1eVxPs-0000sg-GX
 for submit <at> debbugs.gnu.org; Mon, 01 Jan 2018 05:34:01 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <iyzsong@HIDDEN>) id 1eVxPl-0004Qy-DZ
 for submit <at> debbugs.gnu.org; Mon, 01 Jan 2018 05:33:55 -0500
X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org
X-Spam-Level: 
X-Spam-Status: No, score=-0.5 required=5.0 tests=BAYES_05 autolearn=disabled
 version=3.3.2
Received: from lists.gnu.org ([2001:4830:134:3::11]:44204)
 by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32)
 (Exim 4.71) (envelope-from <iyzsong@HIDDEN>)
 id 1eVxPl-0004Qs-AD
 for submit <at> debbugs.gnu.org; Mon, 01 Jan 2018 05:33:53 -0500
Received: from eggs.gnu.org ([2001:4830:134:3::10]:48757)
 by lists.gnu.org with esmtp (Exim 4.71)
 (envelope-from <iyzsong@HIDDEN>) id 1eVxPj-0006LK-7f
 for guix-patches@HIDDEN; Mon, 01 Jan 2018 05:33:53 -0500
Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
 (envelope-from <iyzsong@HIDDEN>) id 1eVxPh-0004O8-8p
 for guix-patches@HIDDEN; Mon, 01 Jan 2018 05:33:51 -0500
Received: from rezeros.cc ([45.76.207.221]:56206)
 by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32)
 (Exim 4.71) (envelope-from <iyzsong@HIDDEN>)
 id 1eVxPg-0004LU-PN
 for guix-patches@HIDDEN; Mon, 01 Jan 2018 05:33:49 -0500
Received: from localhost (36.24.33.173 [36.24.33.173])
 by rezeros.cc (OpenSMTPD) with ESMTPSA id 270d52ce
 (TLSv1.2:ECDHE-RSA-AES256-GCM-SHA384:256:NO); 
 Mon, 1 Jan 2018 10:33:19 +0000 (UTC)
Received: from localhost.localdomain (localhost [127.0.0.1])
 by localhost (OpenSMTPD) with ESMTP id 4f28b8f3;
 Mon, 1 Jan 2018 10:33:37 +0000 (UTC)
From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= <iyzsong@HIDDEN>
To: guix-patches@HIDDEN
Subject: [PATCH 4/5] profiles: Filter out unwanted manifest entries for
 profile hooks.
Date: Mon,  1 Jan 2018 18:33:35 +0800
Message-Id: <20180101103336.8613-5-iyzsong@HIDDEN>
X-Mailer: git-send-email 2.14.1
In-Reply-To: <20180101103336.8613-1-iyzsong@HIDDEN>
References: <20180101103336.8613-1-iyzsong@HIDDEN>
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
 [fuzzy]
X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x
X-Received-From: 2001:4830:134:3::11
X-Spam-Score: -5.0 (-----)
X-Debbugs-Envelope-To: submit
Cc: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= <iyzsong@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -5.0 (-----)

* guix/profiles.scm (manual-database, fonts-dir-file, ghc-package-cache-file)
(ca-certificate-bundle, gtk-icon-themes, gtk-im-modules)
(xdg-desktop-database, xdg-mime-database): Use 'eval-gexp' to filter out
unwanted manifest inputs.
---
 guix/profiles.scm | 164 ++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 111 insertions(+), 53 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index f6e455c96..7d69d1a53 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -733,7 +733,15 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages."
   (define ghc                                     ;lazy reference
     (module-ref (resolve-interface '(gnu packages haskell)) 'ghc))
 
-  (define build
+  (define interested
+    (eval-gexp
+     #~(filter
+        (lambda (input)
+          (file-exists? (string-append input "/lib/ghc-"
+                                       #$(package-version ghc))))
+        '#$(manifest-inputs manifest))))
+
+  (define (build inputs)
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils)
@@ -763,9 +771,7 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages."
 
           (system* (string-append #+ghc "/bin/ghc-pkg") "init" db-dir)
           (for-each copy-conf-file
-                    (append-map conf-files
-                                (delete-duplicates
-                                 '#$(manifest-inputs manifest))))
+                    (append-map conf-files '#$inputs))
           (let ((success
                  (zero?
                   (system* (string-append #+ghc "/bin/ghc-pkg") "recache"
@@ -773,11 +779,10 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages."
             (for-each delete-file (find-files db-dir "\\.conf$"))
             (exit success)))))
 
-  (with-monad %store-monad
+  (mlet* %store-monad ((inputs interested))
     ;; Don't depend on GHC when there's nothing to do.
-    (if (any (cut string-prefix? "ghc" <>)
-             (map manifest-entry-name (manifest-entries manifest)))
-        (gexp->derivation "ghc-package-cache" build
+    (if (not (null? inputs))
+        (gexp->derivation "ghc-package-cache" (build inputs)
                           #:local-build? #t
                           #:substitutable? #f)
         (return #f))))
@@ -789,10 +794,17 @@ MANIFEST.  Single-file bundles are required by programs such as Git and Lynx."
   ;; See <http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00429.html>
   ;; for a discussion.
 
+  (define interested
+    (eval-gexp
+     #~(filter
+        (lambda (input)
+          (file-exists? (string-append input "/etc/ssl/certs")))
+        '#$(manifest-inputs manifest))))
+
   (define glibc-utf8-locales                      ;lazy reference
     (module-ref (resolve-interface '(gnu packages base)) 'glibc-utf8-locales))
 
-  (define build
+  (define (build inputs)
     (with-imported-modules '((guix build utils))
       #~(begin
           (use-modules (guix build utils)
@@ -828,7 +840,7 @@ MANIFEST.  Single-file bundles are required by programs such as Git and Lynx."
                                  #+(package-version glibc-utf8-locales)))
           (setlocale LC_ALL "en_US.utf8")
 
-          (match (append-map ca-files '#$(manifest-inputs manifest))
+          (match (append-map ca-files '#$inputs)
             (()
              ;; Since there are no CA files, just create an empty directory.  Do
              ;; not create the etc/ssl/certs sub-directory, since that would
@@ -844,9 +856,10 @@ MANIFEST.  Single-file bundles are required by programs such as Git and Lynx."
                                                  "/ca-certificates.crt"))
                #t))))))
 
-  (gexp->derivation "ca-certificate-bundle" build
-                    #:local-build? #t
-                    #:substitutable? #f))
+  (mlet* %store-monad ((inputs interested))
+    (gexp->derivation "ca-certificate-bundle" (build inputs)
+                      #:local-build? #t
+                      #:substitutable? #f)))
 
 (define (gtk-icon-themes manifest)
   "Return a derivation that unions all icon themes from manifest entries and
@@ -854,7 +867,15 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
   (define gtk+  ; lazy reference
     (module-ref (resolve-interface '(gnu packages gtk)) 'gtk+))
 
-  (mlet %store-monad ((%gtk+ (manifest-lookup-package manifest "gtk+"))
+  (define interested
+    (eval-gexp
+     #~(filter
+        (lambda (input)
+          (file-exists? (string-append input "/share/icons")))
+        '#$(manifest-inputs manifest))))
+
+  (mlet %store-monad ((inputs interested)
+                      (%gtk+ (manifest-lookup-package manifest "gtk+"))
                       ;; XXX: Can't use gtk-update-icon-cache corresponding
                       ;; to the gtk+ referenced by 'manifest'.  Because
                       ;; '%gtk+' can be either a package or store path, and
@@ -877,9 +898,8 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
                          (ice-9 ftw))
 
             (let* ((destdir  (string-append #$output "/share/icons"))
-                   (icondirs (filter file-exists?
-                                     (map (cut string-append <> "/share/icons")
-                                          '#$(manifest-inputs manifest)))))
+                   (icondirs (map (cut string-append <> "/share/icons")
+                                  '#$inputs)))
 
               ;; Union all the icons.
               (mkdir-p (string-append #$output "/share"))
@@ -907,8 +927,18 @@ creates the GTK+ 'icon-theme.cache' file for each theme."
 (define (gtk-im-modules manifest)
   "Return a derivation that builds the cache files for input method modules
 for both major versions of GTK+."
-
-  (mlet %store-monad ((gtk+   (manifest-lookup-package manifest "gtk+" "3"))
+  (define interested
+    (eval-gexp
+     (with-imported-modules '((guix build utils))
+       #~(begin
+           (use-modules (guix build utils))
+           (filter
+            (lambda (input)
+              (not (null? (find-files input "^immodules$" #:directories? #t))))
+            '#$(manifest-inputs manifest))))))
+
+  (mlet %store-monad ((inputs interested)
+                      (gtk+   (manifest-lookup-package manifest "gtk+" "3"))
                       (gtk+-2 (manifest-lookup-package manifest "gtk+" "2")))
 
     (define (build gtk gtk-version query)
@@ -932,7 +962,7 @@ for both major versions of GTK+."
                      (moddirs (cons (string-append #$gtk prefix "/immodules")
                                     (filter file-exists?
                                             (map (cut string-append <> prefix "/immodules")
-                                                 '#$(manifest-inputs manifest)))))
+                                                 '#$inputs))))
                      (modules (append-map (cut find-files <> "\\.so$")
                                           moddirs)))
 
@@ -980,11 +1010,19 @@ for both major versions of GTK+."
   "Return a derivation that builds the @file{mimeinfo.cache} database from
 desktop files.  It's used to query what applications can handle a given
 MIME type."
+  (define interested
+    (eval-gexp
+     #~(filter
+        (lambda (input)
+          (file-exists? (string-append input "/share/applications")))
+        '#$(manifest-inputs manifest))))
+
   (define desktop-file-utils            ; lazy reference
     (module-ref (resolve-interface '(gnu packages freedesktop))
                 'desktop-file-utils))
 
-  (mlet %store-monad ((glib
+  (mlet %store-monad ((inputs interested)
+                      (glib
                        (manifest-lookup-package
                         manifest "glib")))
     (define build
@@ -995,10 +1033,9 @@ MIME type."
                          (guix build utils)
                          (guix build union))
             (let* ((destdir (string-append #$output "/share/applications"))
-                   (appdirs (filter file-exists?
-                                    (map (cut string-append <>
-                                              "/share/applications")
-                                         '#$(manifest-inputs manifest))))
+                   (appdirs (map (cut string-append <>
+                                      "/share/applications")
+                                 '#$inputs))
                    (update-desktop-database (string-append
                                              #+desktop-file-utils
                                              "/bin/update-desktop-database")))
@@ -1017,10 +1054,18 @@ MIME type."
 (define (xdg-mime-database manifest)
   "Return a derivation that builds the @file{mime.cache} database from manifest
 entries.  It's used to query the MIME type of a given file."
+  (define interested
+    (eval-gexp
+     #~(filter
+        (lambda (input)
+          (file-exists? (string-append input "/share/mime/packages")))
+        '#$(manifest-inputs manifest))))
+
   (define shared-mime-info  ; lazy reference
     (module-ref (resolve-interface '(gnu packages gnome)) 'shared-mime-info))
 
-  (mlet %store-monad ((glib
+  (mlet %store-monad ((inputs interested)
+                      (glib
                        (manifest-lookup-package
                         manifest "glib")))
     (define build
@@ -1032,11 +1077,10 @@ entries.  It's used to query the MIME type of a given file."
                          (guix build union))
             (let* ((datadir (string-append #$output "/share"))
                    (destdir (string-append datadir "/mime"))
-                   (pkgdirs (filter file-exists?
-                                    (map (cut string-append <>
-                                              "/share/mime/packages")
-                                         (cons #+shared-mime-info
-                                               '#$(manifest-inputs manifest)))))
+                   (pkgdirs (map (cut string-append <>
+                                      "/share/mime/packages")
+                                 (cons #+shared-mime-info
+                                       '#$inputs)))
                    (update-mime-database (string-append
                                           #+shared-mime-info
                                           "/bin/update-mime-database")))
@@ -1059,21 +1103,27 @@ entries.  It's used to query the MIME type of a given file."
 (define (fonts-dir-file manifest)
   "Return a derivation that builds the @file{fonts.dir} and @file{fonts.scale}
 files for the fonts of the @var{manifest} entries."
+  (define interested
+    (eval-gexp
+     #~(filter
+        (lambda (input)
+          (file-exists? (string-append input "/share/fonts")))
+        '#$(manifest-inputs manifest))))
+
   (define mkfontscale
     (module-ref (resolve-interface '(gnu packages xorg)) 'mkfontscale))
 
   (define mkfontdir
     (module-ref (resolve-interface '(gnu packages xorg)) 'mkfontdir))
 
-  (define build
+  (define (build inputs)
     #~(begin
         (use-modules (srfi srfi-26)
                      (guix build utils)
                      (guix build union))
-        (let ((fonts-dirs (filter file-exists?
-                                  (map (cut string-append <>
-                                            "/share/fonts")
-                                       '#$(manifest-inputs manifest)))))
+        (let ((fonts-dirs (map (cut string-append <>
+                                    "/share/fonts")
+                               '#$inputs)))
           (mkdir #$output)
           (if (null? fonts-dirs)
               (exit #t)
@@ -1116,16 +1166,24 @@ files for the fonts of the @var{manifest} entries."
                                   (delete-file fonts-dir-file))))
                             directories)))))))
 
-  (gexp->derivation "fonts-dir" build
-                    #:modules '((guix build utils)
-                                (guix build union)
-                                (srfi srfi-26))
-                    #:local-build? #t
-                    #:substitutable? #f))
+  (mlet* %store-monad ((inputs interested))
+    (gexp->derivation "fonts-dir" (build inputs)
+                      #:modules '((guix build utils)
+                                  (guix build union)
+                                  (srfi srfi-26))
+                      #:local-build? #t
+                      #:substitutable? #f)))
 
 (define (manual-database manifest)
   "Return a derivation that builds the manual page database (\"mandb\") for
 the entries in MANIFEST."
+  (define interested
+    (eval-gexp
+     #~(filter
+        (lambda (input)
+          (file-exists? (string-append input "/share/man")))
+        '#$(manifest-inputs manifest))))
+
   (define gdbm-ffi
     (module-ref (resolve-interface '(gnu packages guile))
                 'guile-gdbm-ffi))
@@ -1148,7 +1206,7 @@ the entries in MANIFEST."
                   (source-module-closure `((guix build utils)
                                            (guix man-db))))))
 
-  (define build
+  (define (build inputs)
     (with-imported-modules modules
       #~(begin
           (add-to-load-path (string-append #$gdbm-ffi "/share/guile/site/"
@@ -1162,10 +1220,8 @@ the entries in MANIFEST."
           (define (compute-entries)
             (append-map (lambda (directory)
                           (let ((man (string-append directory "/share/man")))
-                            (if (directory-exists? man)
-                                (mandb-entries man)
-                                '())))
-                        '#$(manifest-inputs manifest)))
+                            (mandb-entries man)))
+                        '#$inputs))
 
           (define man-directory
             (string-append #$output "/share/man"))
@@ -1186,14 +1242,16 @@ the entries in MANIFEST."
                        (* (time-nanosecond duration) (expt 10 -9))))
             (force-output)))))
 
-  (gexp->derivation "manual-database" build
+  (mlet* %store-monad ((inputs interested))
+    (gexp->derivation
+     "manual-databased" (build inputs)
 
-                    ;; Work around GDBM 1.13 issue whereby uninitialized bytes
-                    ;; get written to disk:
-                    ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=29654#23>.
-                    #:env-vars `(("MALLOC_PERTURB_" . "1"))
+     ;; Work around GDBM 1.13 issue whereby uninitialized bytes get written to
+     ;; disk:
+     ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=29654#23>.
+     #:env-vars `(("MALLOC_PERTURB_" . "1"))
 
-                    #:local-build? #t))
+     #:local-build? #t)))
 
 (define %default-profile-hooks
   ;; This is the list of derivation-returning procedures that are called by
-- 
2.13.3





Acknowledgement sent to 宋文武 <iyzsong@HIDDEN>:
New bug report received and forwarded. Copy sent to guix-patches@HIDDEN. Full text available.
Report forwarded to guix-patches@HIDDEN:
bug#29930; Package guix-patches. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Wed, 7 Mar 2018 14:15:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.