~ruther/guix-local

dedb17ad010ee9ef67f3f4f3997dd17f226c8090 — Ludovic Courtès 11 years ago b9212a5
profiles: Store search paths in manifests.

Discussed in <http://bugs.gnu.org/20255>.

* guix/packages.scm (sexp->search-path-specification): New variable.
* guix/profiles.scm (<manifest-entry>)[search-paths]: New field.
  (package->manifest-entry): Initialize it.
  (manifest->gexp): Match it.  Wrap #$deps in (propagated-inputs ...).
  Emit (search-paths ...).  Increment version.
  (find-package): New procedure.
  (sexp->manifest)[infer-search-paths]: New procedure.
  Use it to initialize the 'search-paths' field for versions 0 and 1.
  Add case for version 2.
* guix/scripts/package.scm (search-path-environment-variables)[manifest-entry->package]:
  Remove.
  Use 'manifest-entry-search-paths' instead of 'manifest-entry->package'
  plus 'package-native-search-paths'.
* tests/profiles.scm ("profile-manifest, search-paths"): New test.
4 files changed, 106 insertions(+), 29 deletions(-)

M guix/packages.scm
M guix/profiles.scm
M guix/scripts/package.scm
M tests/profiles.scm
M guix/packages.scm => guix/packages.scm +15 -0
@@ 56,6 56,7 @@
            search-path-specification
            search-path-specification?
            search-path-specification->sexp
            sexp->search-path-specification

            package
            package?


@@ 202,10 203,24 @@ representation."
(define (search-path-specification->sexp spec)
  "Return an sexp representing SPEC, a <search-path-specification>.  The sexp
corresponds to the arguments expected by `set-path-environment-variable'."
  ;; Note that this sexp format is used both by build systems and in
  ;; (guix profiles), so think twice before you change it.
  (match spec
    (($ <search-path-specification> variable files separator type pattern)
     `(,variable ,files ,separator ,type ,pattern))))

(define (sexp->search-path-specification sexp)
  "Convert SEXP, which is as returned by 'search-path-specification->sexp', to
a <search-path-specification> object."
  (match sexp
    ((variable files separator type pattern)
     (search-path-specification
      (variable variable)
      (files files)
      (separator separator)
      (file-type type)
      (file-pattern pattern)))))

(define %supported-systems
  ;; This is the list of system types that are supported.  By default, we
  ;; expect all packages to build successfully here.

M guix/profiles.scm => guix/profiles.scm +67 -9
@@ 59,6 59,7 @@
            manifest-entry-output
            manifest-entry-item
            manifest-entry-dependencies
            manifest-entry-search-paths

            manifest-pattern
            manifest-pattern?


@@ 133,6 134,8 @@
                (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


@@ 165,25 168,60 @@ omitted or #f, use the first output of PACKAGE."
     (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) ...)))


@@ 193,7 231,8 @@ omitted or #f, use the first output of PACKAGE."
              (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


@@ 215,11 254,30 @@ omitted or #f, use the first output of PACKAGE."
                 (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."

M guix/scripts/package.scm => guix/scripts/package.scm +2 -20
@@ 384,22 384,6 @@ current settings and report only settings not already effective."
                     %user-profile-directory
                     profile)))

    ;; The search path info is not stored in the manifest.  Thus, we infer the
    ;; search paths from same-named packages found in the distro.

    (define manifest-entry->package
      (match-lambda
       (($ <manifest-entry> name version)
        ;; 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 search-path-definition
      (match-lambda
       (($ <search-path-specification> variable files separator


@@ 426,10 410,8 @@ current settings and report only settings not already effective."
                      variable
                      (string-join path separator)))))))

    (let* ((packages     (filter-map manifest-entry->package entries))
           (search-paths (delete-duplicates
                          (append-map package-native-search-paths
                                      packages))))
    (let ((search-paths (delete-duplicates
                         (append-map manifest-entry-search-paths entries))))
      (filter-map search-path-definition search-paths))))

(define (display-search-paths entries profile)

M tests/profiles.scm => tests/profiles.scm +22 -0
@@ 26,6 26,7 @@
  #:use-module (guix derivations)
  #:use-module (gnu packages bootstrap)
  #:use-module ((gnu packages base) #:prefix packages:)
  #:use-module ((gnu packages guile) #:prefix packages:)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (srfi srfi-11)


@@ 198,6 199,27 @@
                                       #:hooks '())))
    (return (derivation-inputs drv))))

(test-assertm "profile-manifest, search-paths"
  (mlet* %store-monad
      ((guile ->   (package
                     (inherit %bootstrap-guile)
                     (native-search-paths
                      (package-native-search-paths packages:guile-2.0))))
       (entry ->   (package->manifest-entry guile))
       (drv        (profile-derivation (manifest (list entry))
                                       #:hooks '()))
       (profile -> (derivation->output-path drv)))
    (mbegin %store-monad
      (built-derivations (list drv))

      ;; Read the manifest back and make sure search paths are preserved.
      (let ((manifest (profile-manifest profile)))
        (match (manifest-entries manifest)
          ((result)
           (return (equal? (manifest-entry-search-paths result)
                           (manifest-entry-search-paths entry)
                           (package-native-search-paths
                            packages:guile-2.0)))))))))
(test-end "profiles")