08/66: profiles: Store search paths in manifests.

[Manolis Fragkiskos Ragkousis]

phant0mas pushed a commit to branch wip-hurd
in repository guix.

commit 88f56a998daa29c8ea061e28ce41bb405985c044
Author: Ludovic Courtès <address@hidden>
Date:   Sat May 2 23:55:24 2015 +0200

    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.
---
 guix/packages.scm        |   15 +++++++++
 guix/profiles.scm        |   76 ++++++++++++++++++++++++++++++++++++++++-----
 guix/scripts/package.scm |   22 +------------
 tests/profiles.scm       |   22 +++++++++++++
 4 files changed, 106 insertions(+), 29 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index d5bf6db..ab26508 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -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.
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 4bb3093..2e515d5 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -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."
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1e724b4..fca70f5 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -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)
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 54fbaea..890f09a 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -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")