manifest-entry-output
manifest-entry-item
manifest-entry-dependencies
+ manifest-entry-search-paths
manifest-pattern
manifest-pattern?
profile-manifest
package->manifest-entry
+ %default-profile-hooks
profile-derivation
generation-number
generation-numbers
(default "out"))
(item manifest-entry-item) ; package | store path
(dependencies manifest-entry-dependencies ; (store path | package)*
+ (default '()))
+ (search-paths manifest-entry-search-paths ; search-path-specification*
(default '())))
(define-record-type* <manifest-pattern> manifest-pattern
(version (package-version package))
(output (or output (car (package-outputs package))))
(item package)
- (dependencies (delete-duplicates deps)))))
+ (dependencies (delete-duplicates deps))
+ (search-paths (package-native-search-paths package)))))
(define (manifest->gexp manifest)
"Return a representation of MANIFEST as a gexp."
(define (entry->gexp entry)
(match entry
- (($ <manifest-entry> name version output (? string? path) (deps ...))
- #~(#$name #$version #$output #$path #$deps))
- (($ <manifest-entry> name version output (? package? package) (deps ...))
+ (($ <manifest-entry> name version output (? string? path)
+ (deps ...) (search-paths ...))
+ #~(#$name #$version #$output #$path
+ (propagated-inputs #$deps)
+ (search-paths #$(map search-path-specification->sexp
+ search-paths))))
+ (($ <manifest-entry> name version output (? package? package)
+ (deps ...) (search-paths ...))
#~(#$name #$version #$output
- (ungexp package (or output "out")) #$deps))))
+ (ungexp package (or output "out"))
+ (propagated-inputs #$deps)
+ (search-paths #$(map search-path-specification->sexp
+ search-paths))))))
(match manifest
(($ <manifest> (entries ...))
- #~(manifest (version 1)
+ #~(manifest (version 2)
(packages #$(map entry->gexp entries))))))
+(define (find-package name version)
+ "Return a package from the distro matching NAME and possibly VERSION. This
+procedure is here for backward-compatibility and will eventually vanish."
+ (define find-best-packages-by-name ;break abstractions
+ (module-ref (resolve-interface '(gnu packages))
+ 'find-best-packages-by-name))
+
+ ;; Use 'find-best-packages-by-name' and not 'find-packages-by-name'; the
+ ;; former traverses the module tree only once and then allows for efficient
+ ;; access via a vhash.
+ (match (find-best-packages-by-name name version)
+ ((p _ ...) p)
+ (_
+ (match (find-best-packages-by-name name #f)
+ ((p _ ...) p)
+ (_ #f)))))
+
(define (sexp->manifest sexp)
"Parse SEXP as a manifest."
+ (define (infer-search-paths name version)
+ ;; Infer the search path specifications for NAME-VERSION by looking up a
+ ;; same-named package in the distro. Useful for the old manifest formats
+ ;; that did not store search path info.
+ (let ((package (find-package name version)))
+ (if package
+ (package-native-search-paths package)
+ '())))
+
(match sexp
(('manifest ('version 0)
('packages ((name version output path) ...)))
(name name)
(version version)
(output output)
- (item path)))
+ (item path)
+ (search-paths (infer-search-paths name version))))
name version output path)))
;; Version 1 adds a list of propagated inputs to the
(version version)
(output output)
(item path)
- (dependencies deps))))
+ (dependencies deps)
+ (search-paths (infer-search-paths name version)))))
name version output path deps)))
+ ;; Version 2 adds search paths and is slightly more verbose.
+ (('manifest ('version 2 minor-version ...)
+ ('packages ((name version output path
+ ('propagated-inputs deps)
+ ('search-paths search-paths)
+ extra-stuff ...)
+ ...)))
+ (manifest
+ (map (lambda (name version output path deps search-paths)
+ (manifest-entry
+ (name name)
+ (version version)
+ (output output)
+ (item path)
+ (dependencies deps)
+ (search-paths (map sexp->search-path-specification
+ search-paths))))
+ name version output path deps search-paths)))
(_
- (error "unsupported manifest format" manifest))))
+ (error "unsupported manifest format" sexp))))
(define (read-manifest port)
"Return the packages listed in MANIFEST."
(append-map info-files
'#$(manifest-inputs manifest)))))
- ;; Don't depend on Texinfo when there's nothing to do.
- (if (null? (manifest-entries manifest))
- (gexp->derivation "info-dir" #~(mkdir #$output))
- (gexp->derivation "info-dir" build
- #:modules '((guix build utils)))))
+ (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."
+entries of MANIFEST, or #f if MANIFEST does not have any GHC packages."
(define ghc ;lazy reference
(module-ref (resolve-interface '(gnu packages haskell)) 'ghc))
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))))
+ (and (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)))
(define (ca-certificate-bundle manifest)
"Return a derivation that builds a single-file bundle containing the CA
(rnrs io ports)
(srfi srfi-1)
(srfi srfi-26)
- (ice-9 ftw))
+ (ice-9 ftw)
+ (ice-9 match))
(define (pem-file? file)
(string-suffix? ".pem" file))
(setenv "LOCPATH" (string-append #+glibc-utf8-locales "/lib/locale"))
(setlocale LC_ALL "en_US.UTF-8")
- (let ((ca-files (append-map ca-files
- '#$(manifest-inputs manifest)))
- (result (string-append #$output "/etc/ssl/certs")))
- (mkdir-p result)
- (concatenate-files ca-files
- (string-append result
- "/ca-certificates.crt")))))
-
- ;; Don't depend on 'glibc-utf8-locales' and its dependencies when there's
- ;; nothing to do.
- (if (null? (manifest-entries manifest))
- (gexp->derivation "ca-certificate-bundle" #~(mkdir #$output))
- (gexp->derivation "ca-certificate-bundle" build
- #:modules '((guix build utils))
- #:local-build? #t)))
+ (match (append-map ca-files '#$(manifest-inputs manifest))
+ (()
+ ;; Since there are no CA files, just create an empty directory. Do
+ ;; not create the etc/ssl/certs sub-directory, since that would
+ ;; wrongfully lead to a message about 'SSL_CERT_DIR' needing to be
+ ;; defined.
+ (mkdir #$output)
+ #t)
+ ((ca-files ...)
+ (let ((result (string-append #$output "/etc/ssl/certs")))
+ (mkdir-p result)
+ (concatenate-files ca-files
+ (string-append result
+ "/ca-certificates.crt"))
+ #t)))))
+
+ (gexp->derivation "ca-certificate-bundle" build
+ #:modules '((guix build utils))
+ #:local-build? #t))
+
+(define %default-profile-hooks
+ ;; This is the list of derivation-returning procedures that are called by
+ ;; default when making a non-empty profile.
+ (list info-dir-file
+ ghc-package-cache-file
+ ca-certificate-bundle))
(define* (profile-derivation manifest
#:key
- (info-dir? #t)
- (ghc-package-cache? #t)
- (ca-certificate-bundle? #t))
+ (hooks %default-profile-hooks))
"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, 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))))
+the given MANIFEST. The profile includes additional derivations returned by
+the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc."
+ (mlet %store-monad ((extras (if (null? (manifest-entries manifest))
+ (return '())
+ (sequence %store-monad
+ (filter-map (lambda (hook)
+ (hook manifest))
+ hooks)))))
(define inputs
- (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))
- '())
+ (append (map gexp-input extras)
(manifest-inputs manifest)))
(define builder
HCoop / jackhill / guix / guix.git / blobdiff