From f3f427c2e930e2fb1a72ff8bb9b4a870edfbf007 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 19 Sep 2015 11:14:42 +0200
Subject: guix system: Add '--derivation'.

* guix/scripts/system.scm (perform-action): Add #:derivations-only?
  parameter and honor it.
  (show-help, %options): Add '--derivation'.
  (guix-system): Pass #:derivations-only? to 'perform-action'.
* tests/guix-system.sh: Test it.
* doc/guix.texi (Invoking guix system): Document it.
---
 doc/guix.texi           |  5 +++++
 guix/scripts/system.scm | 30 +++++++++++++++++++++++-------
 tests/guix-system.sh    |  6 ++++++
 3 files changed, 34 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 80c8d873da..1b25bd938f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6916,6 +6916,11 @@ using the following command:
 Attempt to build for @var{system} instead of the host's system type.
 This works as per @command{guix build} (@pxref{Invoking guix build}).
 
+@item --derivation
+@itemx -d
+Return the derivation file name of the given operating system without
+building anything.
+
 @item --image-size=@var{size}
 For the @code{vm-image} and @code{disk-image} actions, create an image
 of the given @var{size}.  @var{size} may be a number of bytes, or it may
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 5e2d226dfe..71b92dacc7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -300,7 +300,7 @@ it atomically, and then run OS's activation script."
      (system-disk-image os #:disk-image-size image-size))))
 
 (define* (perform-action action os
-                         #:key grub? dry-run?
+                         #:key grub? dry-run? derivations-only?
                          use-substitutes? device target
                          image-size full-boot?
                          (mappings '()))
@@ -308,7 +308,13 @@ it atomically, and then run OS's activation script."
 the target devices for GRUB; TARGET is the target root directory; IMAGE-SIZE
 is the size of the image to be built, for the 'vm-image' and 'disk-image'
 actions.  FULL-BOOT? is used for the 'vm' action; it determines whether to
-boot directly to the kernel or to the bootloader."
+boot directly to the kernel or to the bootloader.
+
+When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
+building anything."
+  (define println
+    (cut format #t "~a~%" <>))
+
   (mlet* %store-monad
       ((sys       (system-derivation-for-action os action
                                                 #:image-size image-size
@@ -322,14 +328,17 @@ boot directly to the kernel or to the bootloader."
        (drvs   -> (if (and grub? (memq action '(init reconfigure)))
                       (list sys grub grub.cfg)
                       (list sys)))
-       (%         (maybe-build drvs #:dry-run? dry-run?
-                               #:use-substitutes? use-substitutes?)))
+       (%         (if derivations-only?
+                      (return (for-each (compose println derivation-file-name)
+                                        drvs))
+                      (maybe-build drvs #:dry-run? dry-run?
+                                   #:use-substitutes? use-substitutes?))))
 
-    (if dry-run?
+    (if (or dry-run? derivations-only?)
         (return #f)
         (begin
-          (for-each (cut format #t "~a~%" <>)
-                    (map derivation->output-path drvs))
+          (for-each (compose println derivation->output-path)
+                    drvs)
 
           ;; Make sure GRUB is accessible.
           (when grub?
@@ -382,6 +391,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
    init             initialize a root file system to run GNU.\n"))
 
   (show-build-options-help)
+  (display (_ "
+  -d, --derivation       return the derivation of the given system"))
   (display (_ "
       --on-error=STRATEGY
                          apply STRATEGY when an error occurs while reading FILE"))
@@ -425,6 +436,9 @@ Build the operating system declared in FILE according to ACTION.\n"))
          (option '(#\V "version") #f #f
                  (lambda args
                    (show-version-and-exit "guix system")))
+         (option '(#\d "derivation") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'derivations-only? #t result)))
          (option '("on-error") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'on-error (string->symbol arg)
@@ -549,6 +563,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
           (set-guile-for-build (default-guile))
           (perform-action action os
                           #:dry-run? dry?
+                          #:derivations-only? (assoc-ref opts
+                                                         'derivations-only?)
                           #:use-substitutes? (assoc-ref opts 'substitutes?)
                           #:image-size (assoc-ref opts 'image-size)
                           #:full-boot? (assoc-ref opts 'full-boot?)
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 4289db2390..d99c9bd07b 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -132,6 +132,12 @@ EOF
 make_user_config "users" "wheel"
 guix system build "$tmpfile" -n       # succeeds
 
+guix system build "$tmpfile" -d	      # succeeds
+guix system build "$tmpfile" -d | grep '\.drv$'
+
+guix system vm "$tmpfile" -d	      # succeeds
+guix system vm "$tmpfile" -d | grep '\.drv$'
+
 make_user_config "group-that-does-not-exist" "users"
 if guix system build "$tmpfile" -n 2> "$errorfile"
 then false
-- 
cgit v1.2.3