nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

profiles: Hooks always return a monadic value. 

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.
This commit is contained in:
Ludovic Courtès 2015-05-26 23:38:27 +02:00
parent 41766807d0
commit 07eaecfae1
1 changed files with 15 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
guix/profiles.scm
View File

@ -516,12 +516,14 @@ entries of MANIFEST, or #f if MANIFEST does not have any GHC packages."
(for-each delete-file (find-files db-dir "\\.conf$")) (for-each delete-file (find-files db-dir "\\.conf$"))
success))) success)))
(with-monad %store-monad
;; Don't depend on GHC when there's nothing to do. ;; Don't depend on GHC when there's nothing to do.
(and (any (cut string-prefix? "ghc" <>) (if (any (cut string-prefix? "ghc" <>)
(map manifest-entry-name (manifest-entries manifest))) (map manifest-entry-name (manifest-entries manifest)))
(gexp->derivation "ghc-package-cache" build (gexp->derivation "ghc-package-cache" build
#:modules '((guix build utils)) #:modules '((guix build utils))
#:local-build? #t))) #:local-build? #t)
(return #f))))
(define (ca-certificate-bundle manifest) (define (ca-certificate-bundle manifest)
"Return a derivation that builds a single-file bundle containing the CA "Return a derivation that builds a single-file bundle containing the CA
@ -602,11 +604,14 @@ the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
(mlet %store-monad ((extras (if (null? (manifest-entries manifest)) (mlet %store-monad ((extras (if (null? (manifest-entries manifest))
(return '()) (return '())
(sequence %store-monad (sequence %store-monad
(filter-map (lambda (hook) (map (lambda (hook)
(hook manifest)) (hook manifest))
hooks))))) hooks)))))
(define inputs (define inputs
(append (map gexp-input extras) (append (filter-map (lambda (gexp)
(and (gexp? gexp)
(gexp-input gexp)))
extras)
(manifest-inputs manifest))) (manifest-inputs manifest)))
(define builder (define builder