From 59d78c066727d5c3df22a6e269025ae7e058b45c Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Tue, 16 Apr 2019 17:15:02 -0400
Subject: [PATCH] system: vm: Auto-detect if inputs should be registered.

The argument REGISTER-CLOSURE? of the SYSTEM-DOCKER-IMAGE procedure can be
removed and its value computed automatically, since the operating-system
definition is available in its context.  When the operating-system definition
does not contain the GUIX-SERVICE-TYPE, do not register the closure in the
database of Guix, as it takes time and doesn't serve a purpose.

* gnu/system/vm.scm (use-modules): Add (gnu services base).
(system-docker-image): Remove the REGISTER-CLOSURES? argument, as well as its
associate documentation in the docstring.
[has-guix-service-type?] Add predicate and use it to compute the value of the
REGISTER-CLOSURE? argument of the INITIALIZE procedure.
---
 gnu/system/vm.scm       | 24 +++++++++++++-----------
 guix/scripts/system.scm |  2 +-
 2 files changed, 14 insertions(+), 12 deletions(-)

diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 124abd0fc9..c57b8bf35f 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -64,6 +64,7 @@
   #:use-module (gnu system file-systems)
   #:use-module (gnu system)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu system uuid)
 
   #:use-module (srfi srfi-1)
@@ -249,6 +250,11 @@ made available under the /xchg CIFS share."
                       #:guile-for-build guile-for-build
                       #:references-graphs references-graphs)))
 
+(define (has-guix-service-type? os)
+  (find (lambda (service)
+	  (eq? (service-kind service) guix-service-type))
+        (operating-system-services os)))
+
 (define* (iso9660-image #:key
                         (name "iso9660-image")
                         file-system-label
@@ -258,7 +264,7 @@ made available under the /xchg CIFS share."
                         os
                         bootcfg-drv
                         bootloader
-                        register-closures?
+                        (register-closures? (has-guix-service-type? os))
                         (inputs '()))
   "Return a bootable, stand-alone iso9660 image.
 
@@ -343,7 +349,7 @@ INPUTS is a list of inputs (as for packages)."
                      os
                      bootcfg-drv
                      bootloader
-                     (register-closures? #t)
+                     (register-closures? (has-guix-service-type? os))
                      (inputs '())
                      copy-inputs?)
   "Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
@@ -474,14 +480,12 @@ the image."
 (define* (system-docker-image os
                               #:key
                               (name "guixsd-docker-image")
-                              register-closures?)
+                              (register-closures? (has-guix-service-type? os)))
   "Build a docker image.  OS is the desired <operating-system>.  NAME is the
-base name to use for the output file.  When REGISTER-CLOSURES? is not #f,
-register the closure of OS with Guix in the resulting Docker image.  This only
-makes sense when you want to build a Guix System Docker image that has Guix
-installed inside of it.  If you don't need Guix (e.g., your Docker
-image just contains a web server that is started by the Shepherd), then you
-should set REGISTER-CLOSURES? to #f."
+base name to use for the output file.  When REGISTER-CLOSURES? is #t, register
+the closure of OS with Guix in the resulting Docker image.  By default,
+REGISTER-CLOSURES? is set to #t only if a service of type GUIX-SERVICE-TYPE
+is present in the services definition of teh operating system."
   (define schema
     (and register-closures?
          (local-file (search-path %load-path
@@ -678,7 +682,6 @@ to USB sticks meant to be read-only."
                        #:file-system-label root-label
                        #:file-system-uuid uuid
                        #:os os
-                       #:register-closures? #t
                        #:bootcfg-drv bootcfg
                        #:bootloader (bootloader-configuration-bootloader
                                      (operating-system-bootloader os))
@@ -695,7 +698,6 @@ to USB sticks meant to be read-only."
                     #:file-system-label root-label
                     #:file-system-uuid uuid
                     #:copy-inputs? #t
-                    #:register-closures? #t
                     #:inputs `(("system" ,os)
                                ("bootcfg" ,bootcfg))))))
 
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3c3d6cbd5f..3fb504bced 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -781,7 +781,7 @@ checking this by themselves in their 'check' procedure."
                         #:disk-image-size image-size
                         #:file-system-type file-system-type))
     ((docker-image)
-     (system-docker-image os #:register-closures? #t))))
+     (system-docker-image os))))
 
 (define (maybe-suggest-running-guix-pull)
   "Suggest running 'guix pull' if this has never been done before."
-- 
2.21.0