profiles: Generate GHC's package database cache.

* guix/profiles.scm (ghc-package-cache-file): New procedure.
  (profile-derivation): Add 'ghc-package-cache?' keyword argument.  If true
  (the default), add the result of 'ghc-package-cache-file' to 'inputs'.
* guix/scripts/package.scm (guix-package)[process-actions]: Pass
  #:ghc-package-cache? to 'profile-generation'.
* tests/packages.scm ("--search-paths with pattern"): Likewise.
* tests/profiles.scm ("profile-derivation"): Likewise.
This commit is contained in:
Federico Beffa 2015-04-04 22:51:13 +02:00
parent 283cce508a
commit 042bc828fc
4 changed files with 62 additions and 2 deletions

View File

@ -404,6 +404,55 @@ MANIFEST."
(gexp->derivation "info-dir" build (gexp->derivation "info-dir" build
#:modules '((guix build utils))))) #:modules '((guix build utils)))))
(define (ghc-package-cache-file manifest)
"Return a derivation that builds the GHC 'package.cache' file for all the
entries of MANIFEST."
(define ghc ;lazy reference
(module-ref (resolve-interface '(gnu packages haskell)) 'ghc))
(define build
#~(begin
(use-modules (guix build utils)
(srfi srfi-1) (srfi srfi-26)
(ice-9 ftw))
(define ghc-name-version
(let* ((base (basename #+ghc)))
(string-drop base
(+ 1 (string-index base #\-)))))
(define db-subdir
(string-append "lib/" ghc-name-version "/package.conf.d"))
(define db-dir
(string-append #$output "/" db-subdir))
(define (conf-files top)
(find-files (string-append top "/" db-subdir) "\\.conf$"))
(define (copy-conf-file conf)
(let ((base (basename conf)))
(copy-file conf (string-append db-dir "/" base))))
(system* (string-append #+ghc "/bin/ghc-pkg") "init" db-dir)
(for-each copy-conf-file
(append-map conf-files
'#$(manifest-inputs manifest)))
(let ((success
(zero?
(system* (string-append #+ghc "/bin/ghc-pkg") "recache"
(string-append "--package-db=" db-dir)))))
(for-each delete-file (find-files db-dir "\\.conf$"))
success)))
;; 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)
(gexp->derivation "ghc-package-cache" #~(mkdir #$output))))
(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
certificates in the /etc/ssl/certs sub-directories of the packages in certificates in the /etc/ssl/certs sub-directories of the packages in
@ -465,14 +514,18 @@ MANIFEST. Single-file bundles are required by programs such as Git and Lynx."
(define* (profile-derivation manifest (define* (profile-derivation manifest
#:key #:key
(info-dir? #t) (info-dir? #t)
(ghc-package-cache? #t)
(ca-certificate-bundle? #t)) (ca-certificate-bundle? #t))
"Return a derivation that builds a profile (aka. 'user environment') with "Return a derivation that builds a profile (aka. 'user environment') with
the given MANIFEST. The profile includes a top-level Info 'dir' file unless the given MANIFEST. The profile includes a top-level Info 'dir' file unless
INFO-DIR? is #f, and a single-file CA certificate bundle unless INFO-DIR? is #f, a GHC 'package.cache' file unless GHC-PACKAGE-CACHE? is #f
CA-CERTIFICATE-BUNDLE? is #f." and a single-file CA certificate bundle unless CA-CERTIFICATE-BUNDLE? is #f."
(mlet %store-monad ((info-dir (if info-dir? (mlet %store-monad ((info-dir (if info-dir?
(info-dir-file manifest) (info-dir-file manifest)
(return #f))) (return #f)))
(ghc-package-cache (if ghc-package-cache?
(ghc-package-cache-file manifest)
(return #f)))
(ca-cert-bundle (if ca-certificate-bundle? (ca-cert-bundle (if ca-certificate-bundle?
(ca-certificate-bundle manifest) (ca-certificate-bundle manifest)
(return #f)))) (return #f))))
@ -480,6 +533,9 @@ CA-CERTIFICATE-BUNDLE? is #f."
(append (if info-dir (append (if info-dir
(list (gexp-input info-dir)) (list (gexp-input info-dir))
'()) '())
(if ghc-package-cache
(list (gexp-input ghc-package-cache))
'())
(if ca-cert-bundle (if ca-cert-bundle
(list (gexp-input ca-cert-bundle)) (list (gexp-input ca-cert-bundle))
'()) '())

View File

@ -838,6 +838,7 @@ more information.~%"))
(profile-derivation (profile-derivation
new new
#:info-dir? (not bootstrap?) #:info-dir? (not bootstrap?)
#:ghc-package-cache? (not bootstrap?)
#:ca-certificate-bundle? (not bootstrap?)))) #:ca-certificate-bundle? (not bootstrap?))))
(prof (derivation->output-path prof-drv))) (prof (derivation->output-path prof-drv)))
(show-manifest-transaction (%store) manifest transaction (show-manifest-transaction (%store) manifest transaction

View File

@ -600,6 +600,7 @@
(manifest (map package->manifest-entry (manifest (map package->manifest-entry
(list p1 p2))) (list p1 p2)))
#:info-dir? #f #:info-dir? #f
#:ghc-package-cache? #f
#:ca-certificate-bundle? #f) #:ca-certificate-bundle? #f)
#:guile-for-build (%guile-for-build)))) #:guile-for-build (%guile-for-build))))
(build-derivations %store (list prof)) (build-derivations %store (list prof))

View File

@ -184,6 +184,7 @@
(guile (package->derivation %bootstrap-guile)) (guile (package->derivation %bootstrap-guile))
(drv (profile-derivation (manifest (list entry)) (drv (profile-derivation (manifest (list entry))
#:info-dir? #f #:info-dir? #f
#:ghc-package-cache? #f
#:ca-certificate-bundle? #f)) #:ca-certificate-bundle? #f))
(profile -> (derivation->output-path drv)) (profile -> (derivation->output-path drv))
(bindir -> (string-append profile "/bin")) (bindir -> (string-append profile "/bin"))
@ -197,6 +198,7 @@
((entry -> (package->manifest-entry packages:glibc "debug")) ((entry -> (package->manifest-entry packages:glibc "debug"))
(drv (profile-derivation (manifest (list entry)) (drv (profile-derivation (manifest (list entry))
#:info-dir? #f #:info-dir? #f
#:ghc-package-cache? #f
#:ca-certificate-bundle? #f))) #:ca-certificate-bundle? #f)))
(return (derivation-inputs drv)))) (return (derivation-inputs drv))))