4 files changed, 62 insertions(+), 2 deletions(-)

M guix/profiles.scm
M guix/scripts/package.scm
M tests/packages.scm
M tests/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))
                   '())

@@ 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

@@ 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))

@@ 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))))