services: Missing services are automatically instantiated.

This simplifies OS configuration: users no longer need to be aware of
what a given service depends on.

See the discussion at
<https://lists.gnu.org/archive/html/guix-devel/2018-01/msg00114.html>.

* gnu/services.scm (missing-target-error): New procedure.
(service-back-edges): Use it.
(instantiate-missing-services): New procedure.
* gnu/system.scm (operating-system-services): Call
'instantiate-missing-services'.
* tests/services.scm ("instantiate-missing-services")
("instantiate-missing-services, no default value"): New tests.
* gnu/services/version-control.scm (cgit-service-type)[extensions]: Add
FCGIWRAP-SERVICE-TYPE.
* gnu/tests/version-control.scm (%cgit-os): Remove NGINX-SERVICE-TYPE
and FCGIWRAP-SERVICE-TYPE instances.
* doc/guix.texi (Log Rotation): Remove 'mcron-service-type' in example.
(Miscellaneous Services): Remove 'nginx-service-type' and
'fcgiwrap-service-type' in Cgit example.

4 files changed, 57 insertions, 17 deletions

diff --git a/gnu/services.scm b/gnu/services.scm
index 15fc6dcb49..b020d971fd 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -24,6 +24,7 @@
   #:use-module (guix records)
   #:use-module (guix profiles)
   #:use-module (guix discovery)
+  #:use-module (guix combinators)
   #:use-module (guix sets)
   #:use-module (guix ui)
   #:use-module ((guix utils) #:select (source-properties->location))
@@ -66,6 +67,7 @@
             simple-service
             modify-services
             service-back-edges
+            instantiate-missing-services
             fold-services
 
             service-error?
@@ -630,6 +632,18 @@ kernel."
   (service      ambiguous-target-service-error-service)
   (target-type  ambiguous-target-service-error-target-type))
 
+(define (missing-target-error service target-type)
+  (raise
+   (condition (&missing-target-service-error
+               (service service)
+               (target-type target-type))
+              (&message
+               (message
+                (format #f (G_ "no target of type '~a' for service '~a'")
+                        (service-type-name target-type)
+                        (service-type-name
+                         (service-kind service))))))))
+
 (define (service-back-edges services)
   "Return a procedure that, when passed a <service>, returns the list of
 <service> objects that depend on it."
@@ -642,16 +656,7 @@ kernel."
           ((target)
            (vhash-consq target service edges))
           (()
-           (raise
-            (condition (&missing-target-service-error
-                        (service service)
-                        (target-type target-type))
-                       (&message
-                        (message
-                         (format #f (G_ "no target of type '~a' for service '~a'")
-                                 (service-type-name target-type)
-                                 (service-type-name
-                                  (service-kind service))))))))
+           (missing-target-error service target-type))
           (x
            (raise
             (condition (&ambiguous-target-service-error
@@ -669,6 +674,38 @@ kernel."
     (lambda (node)
       (reverse (vhash-foldq* cons '() node edges)))))
 
+(define (instantiate-missing-services services)
+  "Return SERVICES, a list, augmented with any services targeted by extensions
+and missing from SERVICES.  Only service types with a default value can be
+instantiated; other missing services lead to a
+'&missing-target-service-error'."
+  (define (adjust-service-list svc result instances)
+    (fold2 (lambda (extension result instances)
+             (define target-type
+               (service-extension-target extension))
+
+             (match (vhash-assq target-type instances)
+               (#f
+                (let ((default (service-type-default-value target-type)))
+                  (if (eq? &no-default-value default)
+                      (missing-target-error svc target-type)
+                      (let ((new (service target-type)))
+                        (values (cons new result)
+                                (vhash-consq target-type new instances))))))
+               (_
+                (values result instances))))
+           result
+           instances
+           (service-type-extensions (service-kind svc))))
+
+  (let ((instances (fold (lambda (service result)
+                           (vhash-consq (service-kind service) service
+                                        result))
+                         vlist-null services)))
+    (fold2 adjust-service-list
+           services instances
+           services)))
+
 (define* (fold-services services
                         #:key (target-type system-service-type))
   "Fold SERVICES by propagating their extensions down to the root of type
diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm
index 6bf656949a..7166ed3d4f 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -263,7 +263,11 @@ access to exported repositories under @file{/srv/git}."
     (list (service-extension activation-service-type
                              cgit-activation)
           (service-extension nginx-service-type
-                             cgit-configuration-nginx-config)))
+                             cgit-configuration-nginx-config)
+
+          ;; Make sure fcgiwrap is instantiated.
+          (service-extension fcgiwrap-service-type
+                             (const #t))))
    (default-value (cgit-configuration))
    (description
     "Run the Cgit web interface, which allows users to browse Git
diff --git a/gnu/system.scm b/gnu/system.scm
index 40e259f430..39452304ba 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
@@ -492,8 +492,9 @@ a container or that of a \"bare metal\" system."
 (define* (operating-system-services os #:key container?)
   "Return all the services of OS, including \"internal\" services that do not
 explicitly appear in OS."
-  (append (operating-system-user-services os)
-          (essential-services os #:container? container?)))
+  (instantiate-missing-services
+   (append (operating-system-user-services os)
+           (essential-services os #:container? container?))))
 
 
 ;;;
diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm
index c20e59985e..9882cdbe28 100644
--- a/gnu/tests/version-control.scm
+++ b/gnu/tests/version-control.scm
@@ -88,8 +88,6 @@
   (let ((base-os
          (simple-operating-system
           (dhcp-client-service)
-          (service nginx-service-type)
-          (service fcgiwrap-service-type)
           (service cgit-service-type
                    (cgit-configuration
                     (nginx %cgit-configuration-nginx)))