aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFederico Beffa <beffa@fbengineering.ch>2015-04-04 22:51:13 +0200
committerFederico Beffa <beffa@fbengineering.ch>2015-04-08 17:31:12 +0200
commit042bc828fcd2dc7bbacbe6ef0408722a3d51a684 (patch)
tree54d0d855fd047e9f36b4eabf6032a2607dea9de8
parent283cce508ae2d300132be21ed1e37ce9f59cd1cb (diff)
downloadguix-042bc828fcd2dc7bbacbe6ef0408722a3d51a684.tar
guix-042bc828fcd2dc7bbacbe6ef0408722a3d51a684.tar.gz
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.
-rw-r--r--guix/profiles.scm60
-rw-r--r--guix/scripts/package.scm1
-rw-r--r--tests/packages.scm1
-rw-r--r--tests/profiles.scm2
4 files changed, 62 insertions, 2 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 465aaf9477..a2f63d1cca 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -404,6 +404,55 @@ MANIFEST."
(gexp->derivation "info-dir" build
#: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)
"Return a derivation that builds a single-file bundle containing the CA
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
#:key
(info-dir? #t)
+ (ghc-package-cache? #t)
(ca-certificate-bundle? #t))
"Return a derivation that builds a profile (aka. 'user environment') with
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
-CA-CERTIFICATE-BUNDLE? is #f."
+INFO-DIR? is #f, a GHC 'package.cache' file unless GHC-PACKAGE-CACHE? is #f
+and a single-file CA certificate bundle unless CA-CERTIFICATE-BUNDLE? is #f."
(mlet %store-monad ((info-dir (if info-dir?
(info-dir-file manifest)
(return #f)))
+ (ghc-package-cache (if ghc-package-cache?
+ (ghc-package-cache-file manifest)
+ (return #f)))
(ca-cert-bundle (if ca-certificate-bundle?
(ca-certificate-bundle manifest)
(return #f))))
@@ -480,6 +533,9 @@ CA-CERTIFICATE-BUNDLE? is #f."
(append (if info-dir
(list (gexp-input info-dir))
'())
+ (if ghc-package-cache
+ (list (gexp-input ghc-package-cache))
+ '())
(if ca-cert-bundle
(list (gexp-input ca-cert-bundle))
'())
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 6190f3286d..09ae782751 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -838,6 +838,7 @@ more information.~%"))
(profile-derivation
new
#:info-dir? (not bootstrap?)
+ #:ghc-package-cache? (not bootstrap?)
#:ca-certificate-bundle? (not bootstrap?))))
(prof (derivation->output-path prof-drv)))
(show-manifest-transaction (%store) manifest transaction
diff --git a/tests/packages.scm b/tests/packages.scm
index c9dd5d859a..4e3a116cb8 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -600,6 +600,7 @@
(manifest (map package->manifest-entry
(list p1 p2)))
#:info-dir? #f
+ #:ghc-package-cache? #f
#:ca-certificate-bundle? #f)
#:guile-for-build (%guile-for-build))))
(build-derivations %store (list prof))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 7b942e35b0..d20cb9d808 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -184,6 +184,7 @@
(guile (package->derivation %bootstrap-guile))
(drv (profile-derivation (manifest (list entry))
#:info-dir? #f
+ #:ghc-package-cache? #f
#:ca-certificate-bundle? #f))
(profile -> (derivation->output-path drv))
(bindir -> (string-append profile "/bin"))
@@ -197,6 +198,7 @@
((entry -> (package->manifest-entry packages:glibc "debug"))
(drv (profile-derivation (manifest (list entry))
#:info-dir? #f
+ #:ghc-package-cache? #f
#:ca-certificate-bundle? #f)))
(return (derivation-inputs drv))))