From 042bc828fcd2dc7bbacbe6ef0408722a3d51a684 Mon Sep 17 00:00:00 2001 From: Federico Beffa Date: Sat, 4 Apr 2015 22:51:13 +0200 Subject: [PATCH] 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. --- guix/profiles.scm | 60 ++++++++++++++++++++++++++++++++++++++-- guix/scripts/package.scm | 1 + tests/packages.scm | 1 + tests/profiles.scm | 2 ++ 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))))