profiles: Add 'packages->manifest' procedure.

* guix/profiles.scm (packages->manifest): New procedure.
This commit is contained in:
David Thompson 2015-05-18 07:51:56 -04:00
parent 7ea1432e22
commit 8404ed5c3e

View file

@ -80,6 +80,7 @@ (define-module (guix profiles)
profile-manifest profile-manifest
package->manifest-entry package->manifest-entry
packages->manifest
%default-profile-hooks %default-profile-hooks
profile-derivation profile-derivation
generation-number generation-number
@ -172,6 +173,18 @@ (define* (package->manifest-entry package #:optional output)
(dependencies (delete-duplicates deps)) (dependencies (delete-duplicates deps))
(search-paths (package-native-search-paths package))))) (search-paths (package-native-search-paths package)))))
(define (packages->manifest packages)
"Return a list of manifest entries, one for each item listed in PACKAGES.
Elements of PACKAGES can be either package objects or package/string tuples
denoting a specific output of a package."
(manifest
(map (match-lambda
((package output)
(package->manifest-entry package output))
(package
(package->manifest-entry package)))
packages)))
(define (manifest->gexp manifest) (define (manifest->gexp manifest)
"Return a representation of MANIFEST as a gexp." "Return a representation of MANIFEST as a gexp."
(define (entry->gexp entry) (define (entry->gexp entry)
@ -469,7 +482,7 @@ (define ghc ;lazy reference
(module-ref (resolve-interface '(gnu packages haskell)) 'ghc)) (module-ref (resolve-interface '(gnu packages haskell)) 'ghc))
(define build (define build
#~(begin #~(begin
(use-modules (guix build utils) (use-modules (guix build utils)
(srfi srfi-1) (srfi srfi-26) (srfi srfi-1) (srfi srfi-26)
(ice-9 ftw)) (ice-9 ftw))
@ -478,20 +491,20 @@ (define ghc-name-version
(let* ((base (basename #+ghc))) (let* ((base (basename #+ghc)))
(string-drop base (string-drop base
(+ 1 (string-index base #\-))))) (+ 1 (string-index base #\-)))))
(define db-subdir (define db-subdir
(string-append "lib/" ghc-name-version "/package.conf.d")) (string-append "lib/" ghc-name-version "/package.conf.d"))
(define db-dir (define db-dir
(string-append #$output "/" db-subdir)) (string-append #$output "/" db-subdir))
(define (conf-files top) (define (conf-files top)
(find-files (string-append top "/" db-subdir) "\\.conf$")) (find-files (string-append top "/" db-subdir) "\\.conf$"))
(define (copy-conf-file conf) (define (copy-conf-file conf)
(let ((base (basename conf))) (let ((base (basename conf)))
(copy-file conf (string-append db-dir "/" base)))) (copy-file conf (string-append db-dir "/" base))))
(system* (string-append #+ghc "/bin/ghc-pkg") "init" db-dir) (system* (string-append #+ghc "/bin/ghc-pkg") "init" db-dir)
(for-each copy-conf-file (for-each copy-conf-file
(append-map conf-files (append-map conf-files