From 07eaecfae1add0b1b0d78047c0ac7b1229592dcb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 26 May 2015 23:38:27 +0200
Subject: [PATCH] profiles: Hooks always return a monadic value.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Suggested by 宋文武 <iyzsong@gmail.com>.

* guix/profiles.scm (ghc-package-cache-file): Return a monadic #f, not just
  #f, when MANIFEST contains no GHC package.
  (profile-derivation): Do not filter based on the return value of HOOK;
  instead filter based on the value of items in EXTRAS.
---
 guix/profiles.scm | 25 +++++++++++++++----------
 1 file changed, 15 insertions(+), 10 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 9cb226eda7..9011449aa8 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -516,12 +516,14 @@ (define (copy-conf-file conf)
           (for-each delete-file (find-files db-dir "\\.conf$"))
           success)))
 
-  ;; Don't depend on GHC when there's nothing to do.
-  (and (any (cut string-prefix? "ghc" <>)
-            (map manifest-entry-name (manifest-entries manifest)))
-       (gexp->derivation "ghc-package-cache" build
-                         #:modules '((guix build utils))
-                         #:local-build? #t)))
+  (with-monad %store-monad
+    ;; 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
+                          #:modules '((guix build utils))
+                          #:local-build? #t)
+        (return #f))))
 
 (define (ca-certificate-bundle manifest)
   "Return a derivation that builds a single-file bundle containing the CA
@@ -602,11 +604,14 @@ (define* (profile-derivation manifest
   (mlet %store-monad ((extras (if (null? (manifest-entries manifest))
                                   (return '())
                                   (sequence %store-monad
-                                            (filter-map (lambda (hook)
-                                                          (hook manifest))
-                                                        hooks)))))
+                                            (map (lambda (hook)
+                                                   (hook manifest))
+                                                 hooks)))))
     (define inputs
-      (append (map gexp-input extras)
+      (append (filter-map (lambda (gexp)
+                            (and (gexp? gexp)
+                                 (gexp-input gexp)))
+                          extras)
               (manifest-inputs manifest)))
 
     (define builder