Re: Reproducible profiles

[David Thompson]

Below is a new patch set taking into account the feedback received thus
far.  The (guix profiles) module still needs to be documented in the
manual, but there's quite a lot of procedures and variables to account
for.  Would anyone be intertested in helping with this part?

>From d506ad1d8824cc694364be502acddb25b76d0020 Mon Sep 17 00:00:00 2001
From: David Thompson <address@hidden>
Date: Mon, 18 May 2015 07:49:44 -0400
Subject: [PATCH 1/3] ui: Factorize user-provided Scheme file loading.

* guix/ui.scm (make-user-module, read-scheme-file): New procedures.
* guix/scripts/system.scm (%user-module): Define in terms of
  'make-user-module'.
  (read-operating-system): Define in terms of 'read-scheme-file'.
---
 guix/scripts/system.scm | 22 ++++------------------
 guix/ui.scm             | 24 ++++++++++++++++++++++++
 2 files changed, 28 insertions(+), 18 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 1838e89..2d7c5d1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -48,28 +48,14 @@
 
 (define %user-module
   ;; Module in which the machine description file is loaded.
-  (let ((module (make-fresh-user-module)))
-    (for-each (lambda (iface)
-                (module-use! module (resolve-interface iface)))
-              '((gnu system)
-                (gnu services)
-                (gnu system shadow)))
-    module))
+  (make-user-module '((gnu system)
+                      (gnu services)
+                      (gnu system shadow))))
 
 (define (read-operating-system file)
   "Read the operating-system declaration from FILE and return it."
-  ;; TODO: Factorize.
-  (catch #t
-    (lambda ()
-      ;; Avoid ABI incompatibility with the <operating-system> record.
-      (set! %fresh-auto-compile #t)
+  (read-scheme-file file %user-module))
 
-      (save-module-excursion
-       (lambda ()
-         (set-current-module %user-module)
-         (primitive-load file))))
-    (lambda args
-      (report-load-error file args))))
 
 
 ;;;
diff --git a/guix/ui.scm b/guix/ui.scm
index 911e5ee..5a76cf4 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -48,6 +48,8 @@
             P_
             report-error
             leave
+            make-user-module
+            read-scheme-file
             report-load-error
             warn-about-load-error
             show-version-and-exit
@@ -133,6 +135,28 @@ messages."
     (report-error args ...)
     (exit 1)))
 
+(define (make-user-module modules)
+  "Return a new user module with the additional MODULES loaded."
+  ;; Module in which the machine description file is loaded.
+  (let ((module (make-fresh-user-module)))
+    (for-each (lambda (iface)
+                (module-use! module (resolve-interface iface)))
+              modules)
+    module))
+
+(define (read-scheme-file file user-module)
+  "Read the user provided Scheme source code FILE."
+  (catch #t
+    (lambda ()
+      (set! %fresh-auto-compile #t)
+
+      (save-module-excursion
+       (lambda ()
+         (set-current-module user-module)
+         (primitive-load file))))
+    (lambda args
+      (report-load-error file args))))
+
 (define (report-load-error file args)
   "Report the failure to load FILE, a user-provided Scheme file, and exit.
 ARGS is the list of arguments received by the 'throw' handler."
-- 
2.1.4

>From 5665da9934726ce0a8c4ed358b7f606d917c300a Mon Sep 17 00:00:00 2001
From: David Thompson <address@hidden>
Date: Mon, 18 May 2015 07:51:56 -0400
Subject: [PATCH 2/3] profiles: Add 'packages->manifest' procedure.

* guix/profiles.scm (packages->manifest): New procedure.
---
 guix/profiles.scm | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 11d9bf0..cbc8a9a 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -80,6 +80,7 @@
 
             profile-manifest
             package->manifest-entry
+            packages->manifest
             %default-profile-hooks
             profile-derivation
             generation-number
@@ -172,6 +173,16 @@ omitted or #f, use the first output of PACKAGE."
      (dependencies (delete-duplicates deps))
      (search-paths (package-native-search-paths package)))))
 
+(define (packages->manifest packages)
+  "Convert PACKAGES into a manifest containing entries for all of them."
+  (manifest
+   (map (match-lambda
+         ((package output)
+          (package->manifest-entry package output))
+         (package
+           (package->manifest-entry package)))
+        packages)))
+
 (define (manifest->gexp manifest)
   "Return a representation of MANIFEST as a gexp."
   (define (entry->gexp entry)
-- 
2.1.4

>From 3be657353bfebc33dc9733b820165699ac07b43d Mon Sep 17 00:00:00 2001
From: David Thompson <address@hidden>
Date: Thu, 14 May 2015 21:11:57 -0400
Subject: [PATCH 3/3] package: Add --manifest option.

* guix/scripts/package.scm (show-help): Add help text.
  (%options): Add manifest option.
  (guix-package): Add manifest option handler.
* doc/guix.texi ("Invoking guix package"): Document it.
* tests/guix-package.sh: Add test.
---
 doc/guix.texi            |  17 ++++++++
 guix/scripts/package.scm | 107 ++++++++++++++++++++++++++++-------------------
 tests/guix-package.sh    |  10 +++++
 3 files changed, 90 insertions(+), 44 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 049292d..ca5f82d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1057,6 +1057,23 @@ substring ``emacs'':
 $ guix package --upgrade . --do-not-upgrade emacs
 @end example
 
address@hidden address@hidden
address@hidden -m @var{file}
+Create a new @dfn{generation} of the profile from the manifest object
+contained in @var{file}, a Scheme source code file.
+
+A manifest file may look like this:
+
address@hidden
+(use-package-modules guile emacs gcc)
+
+(packages->manifest
+ (list guile-2.0
+       emacs
+       ;; Use a specific package output.
+       (list gcc "debug")))
address@hidden example
+
 @item --roll-back
 Roll back to the previous @dfn{generation} of the profile---i.e., undo
 the last transaction.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 15f3e13..f2ca663 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -426,6 +426,9 @@ Install, remove, or upgrade PACKAGES in a single 
transaction.\n"))
   (display (_ "
   -u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP"))
   (display (_ "
+  -m, --manifest=FILE    create a new profile generation with the manifest
+                         contained within FILE."))
+  (display (_ "
       --do-not-upgrade[=REGEXP] do not upgrade any packages matching REGEXP"))
   (display (_ "
       --roll-back        roll back to the previous generation"))
@@ -517,6 +520,10 @@ Install, remove, or upgrade PACKAGES in a single 
transaction.\n"))
                  (lambda (opt name arg result arg-handler)
                    (values (alist-cons 'roll-back? #t result)
                            #f)))
+         (option '(#\m "manifest") #t #f
+                 (lambda (opt name arg result arg-handler)
+                   (values (alist-cons 'manifest arg result)
+                           arg-handler)))
          (option '(#\l "list-generations") #f #t
                  (lambda (opt name arg result arg-handler)
                    (values (cons `(query list-generations ,(or arg ""))
@@ -783,6 +790,50 @@ more information.~%"))
     (define dry-run? (assoc-ref opts 'dry-run?))
     (define profile  (assoc-ref opts 'profile))
 
+    (define (build-and-use-profile manifest)
+      (let* ((bootstrap?  (assoc-ref opts 'bootstrap?)))
+
+        (when (equal? profile %current-profile)
+          (ensure-default-profile))
+
+        (let* ((prof-drv (run-with-store (%store)
+                           (profile-derivation
+                            manifest
+                            #:hooks (if bootstrap?
+                                        '()
+                                        %default-profile-hooks))))
+               (prof     (derivation->output-path prof-drv)))
+          (show-what-to-build (%store) (list prof-drv)
+                              #:use-substitutes?
+                              (assoc-ref opts 'substitutes?)
+                              #:dry-run? dry-run?)
+
+          (cond
+           (dry-run? #t)
+           ((and (file-exists? profile)
+                 (and=> (readlink* profile) (cut string=? prof <>)))
+            (format (current-error-port) (_ "nothing to be done~%")))
+           (else
+            (let* ((number (generation-number profile))
+
+                   ;; Always use NUMBER + 1 for the new profile,
+                   ;; possibly overwriting a "previous future
+                   ;; generation".
+                   (name   (generation-file-name profile
+                                                 (+ 1 number))))
+              (and (build-derivations (%store) (list prof-drv))
+                   (let* ((entries (manifest-entries manifest))
+                          (count   (length entries)))
+                     (switch-symlinks name prof)
+                     (switch-symlinks profile name)
+                     (unless (string=? profile %current-profile)
+                       (register-gc-root (%store) name))
+                     (format #t (N_ "~a package in profile~%"
+                                    "~a packages in profile~%"
+                                    count)
+                             count)
+                     (display-search-paths entries profile)))))))))
+
     ;; First roll back if asked to.
     (cond ((and (assoc-ref opts 'roll-back?)
                 (not dry-run?))
@@ -817,60 +868,28 @@ more information.~%"))
                (alist-delete 'delete-generations opts)))
              (_ #f))
             opts))
+          ((and (assoc-ref opts 'manifest)
+                (not dry-run?))
+           (let* ((file-name (assoc-ref opts 'manifest))
+                  (user-module (make-user-module '((guix profiles)
+                                                   (gnu))))
+                  (manifest (read-scheme-file file-name user-module)))
+             (format #t (_ "installing new manifest from ~a with ~d 
entries.~%")
+                     file-name (length (manifest-entries manifest)))
+             (build-and-use-profile manifest)))
           (else
            (let* ((manifest    (profile-manifest profile))
                   (install     (options->installable opts manifest))
                   (remove      (options->removable opts manifest))
-                  (bootstrap?  (assoc-ref opts 'bootstrap?))
                   (transaction (manifest-transaction (install install)
                                                      (remove remove)))
                   (new         (manifest-perform-transaction
                                 manifest transaction)))
 
-             (when (equal? profile %current-profile)
-               (ensure-default-profile))
-
              (unless (and (null? install) (null? remove))
-               (let* ((prof-drv (run-with-store (%store)
-                                  (profile-derivation
-                                   new
-                                   #:hooks (if bootstrap?
-                                               '()
-                                               %default-profile-hooks))))
-                      (prof     (derivation->output-path prof-drv)))
-                 (show-manifest-transaction (%store) manifest transaction
-                                            #:dry-run? dry-run?)
-                 (show-what-to-build (%store) (list prof-drv)
-                                     #:use-substitutes?
-                                     (assoc-ref opts 'substitutes?)
-                                     #:dry-run? dry-run?)
-
-                 (cond
-                  (dry-run? #t)
-                  ((and (file-exists? profile)
-                        (and=> (readlink* profile) (cut string=? prof <>)))
-                   (format (current-error-port) (_ "nothing to be done~%")))
-                  (else
-                   (let* ((number (generation-number profile))
-
-                          ;; Always use NUMBER + 1 for the new profile,
-                          ;; possibly overwriting a "previous future
-                          ;; generation".
-                          (name   (generation-file-name profile
-                                                        (+ 1 number))))
-                     (and (build-derivations (%store) (list prof-drv))
-                          (let* ((entries (manifest-entries new))
-                                 (count   (length entries)))
-                            (switch-symlinks name prof)
-                            (switch-symlinks profile name)
-                            (unless (string=? profile %current-profile)
-                              (register-gc-root (%store) name))
-                            (format #t (N_ "~a package in profile~%"
-                                           "~a packages in profile~%"
-                                           count)
-                                    count)
-                            (display-search-paths entries
-                                                  profile))))))))))))
+               (show-manifest-transaction (%store) manifest transaction
+                                          #:dry-run? dry-run?)
+               (build-and-use-profile new))))))
 
   (define (process-query opts)
     ;; Process any query specified by OPTS.  Return #t when a query was
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index a732110..4591333 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -237,3 +237,13 @@ export GUIX_BUILD_OPTIONS
 available2="`guix package -A | sort`"
 test "$available2" = "$available"
 guix package -I
+
+unset GUIX_BUILD_OPTIONS
+
+# Applying a manifest file
+cat > "$module_dir/manifest.scm"<<EOF
+(use-package-modules bootstrap)
+
+(packages->manifest (list %bootstrap-guile))
+EOF
+guix package --bootstrap -m "$module_dir/manifest.scm"
-- 
2.1.4

-- 
David Thompson
GPG Key: 0FF1D807