mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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:
parent
283cce508a
commit
042bc828fc
4 changed files with 62 additions and 2 deletions
|
@ -404,6 +404,55 @@ (define (install-info info)
|
||||||
(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 @@ (define (dump file port)
|
||||||
(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 @@ (define inputs
|
||||||
(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))
|
||||||
'())
|
'())
|
||||||
|
|
|
@ -838,6 +838,7 @@ (define profile (assoc-ref opts 'profile))
|
||||||
(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
|
||||||
|
|
|
@ -600,6 +600,7 @@ (define read-at
|
||||||
(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))
|
||||||
|
|
|
@ -184,6 +184,7 @@ (define glibc
|
||||||
(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 @@ (define glibc
|
||||||
((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))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue