08/11: installer: Generalize desktop environments to system services.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 75988317b22efee2b2719e7d559fa9ff01a9db9a
Author: Ludovic Courtès <address@hidden>
Date:   Sun Apr 7 17:15:06 2019 +0200

    installer: Generalize desktop environments to system services.
    
    * gnu/installer/services.scm (<desktop-environment>): Rename to...
    (<system-service>): ... this.  Add a 'type' field.
    (%desktop-environments): Rename to...
    (%system-services): ... this.
    (desktop-system-service?): New procedure.
    (desktop-environments->configuration): Rename to...
    (system-services->configuration): ... this.  Determine the base list of
    services based on whether SERVICES contains at least one "desktop"
    service.
    * gnu/installer/newt/services.scm (run-desktop-environments-cbt-page):
    Adjust accordingly.
    * gnu/installer.scm (installer-steps): Likewise.
---
 gnu/installer.scm               |  3 +-
 gnu/installer/newt/services.scm |  6 +--
 gnu/installer/services.scm      | 87 ++++++++++++++++++++++++-----------------
 3 files changed, 55 insertions(+), 41 deletions(-)

diff --git a/gnu/installer.scm b/gnu/installer.scm
index 5694cef..50e2e7d 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -256,8 +256,7 @@ selected keymap."
           (description (G_ "Services"))
           (compute (lambda _
                      ((installer-services-page current-installer))))
-         (configuration-formatter
-           desktop-environments->configuration))
+         (configuration-formatter system-services->configuration))
 
         (installer-step
           (id 'final)
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index adeb1d7..2cbfc5c 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.scm
@@ -32,11 +32,11 @@
 environments."
   (run-checkbox-tree-page
    #:info-text (G_ "Please select the desktop(s) environment(s) you wish to \
-install. If you select multiple desktops environments, we will be able to \
+install. If you select multiple desktops environments, you will be able to \
 choose the one to use on the log-in screen.")
    #:title (G_ "Desktop environment")
-   #:items %desktop-environments
-   #:item->text desktop-environment-name
+   #:items (filter desktop-system-service? %system-services)
+   #:item->text system-service-name
    #:checkbox-tree-height 5
    #:exit-button-callback-procedure
    (lambda ()
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index 2b6625f..8e482b7 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <address@hidden>
+;;; Copyright © 2019 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,44 +19,58 @@
 
 (define-module (gnu installer services)
   #:use-module (guix records)
-  #:export (<desktop-environment>
-            desktop-environment
-            make-desktop-environment
-            desktop-environment-name
-            desktop-environment-snippet
+  #:use-module (srfi srfi-1)
+  #:export (system-service?
+            system-service-name
+            system-service-type
+            system-service-snippet
 
-            %desktop-environments
-            desktop-environments->configuration))
+            desktop-system-service?
 
-(define-record-type* <desktop-environment>
-  desktop-environment make-desktop-environment
-  desktop-environment?
-  (name            desktop-environment-name) ;string
-  (snippet         desktop-environment-snippet)) ;symbol
+            %system-services
+            system-services->configuration))
+
+(define-record-type* <system-service>
+  system-service make-system-service
+  system-service?
+  (name            system-service-name)           ;string
+  (type            system-service-type)           ;symbol
+  (snippet         system-service-snippet))       ;sexp
 
 ;; This is the list of desktop environments supported as services.
-(define %desktop-environments
-  (list
-   (desktop-environment
-    (name "GNOME")
-    (snippet '(service gnome-desktop-service-type)))
-   (desktop-environment
-    (name "Xfce")
-    ;; TODO: Use 'xfce-desktop-service-type' when the 'guix' package provides
-    ;; it with a default value.
-    (snippet '(xfce-desktop-service)))
-   (desktop-environment
-    (name "MATE")
-    (snippet '(service mate-desktop-service-type)))
-   (desktop-environment
-    (name "Enlightenment")
-    (snippet '(service enlightenment-desktop-service-type)))))
+(define %system-services
+  (let-syntax ((desktop-environment (syntax-rules ()
+                                      ((_ fields ...)
+                                       (system-service
+                                        (type 'desktop)
+                                        fields ...)))))
+    (list
+     (desktop-environment
+      (name "GNOME")
+      (snippet '(service gnome-desktop-service-type)))
+     (desktop-environment
+      (name "Xfce")
+      ;; TODO: Use 'xfce-desktop-service-type' when the 'guix' package provides
+      ;; it with a default value.
+      (snippet '(xfce-desktop-service)))
+     (desktop-environment
+      (name "MATE")
+      (snippet '(service mate-desktop-service-type)))
+     (desktop-environment
+      (name "Enlightenment")
+      (snippet '(service enlightenment-desktop-service-type))))))
+
+(define (desktop-system-service? service)
+  "Return true if SERVICE is a desktop environment service."
+  (eq? 'desktop (system-service-type service)))
 
-(define (desktop-environments->configuration desktop-environments)
-  "Return the configuration field for DESKTOP-ENVIRONMENTS."
-  (let ((snippets
-         (map desktop-environment-snippet desktop-environments)))
-    `(,@(if (null? snippets)
-            '()
-            `((services (cons* ,@snippets
-                               %desktop-services)))))))
+(define (system-services->configuration services)
+  "Return the configuration field for SERVICES."
+  (let* ((snippets (map system-service-snippet services))
+         (desktop? (find desktop-system-service? services))
+         (base     (if desktop?
+                       '%desktop-services
+                       '%base-services)))
+    (if (null? snippets)
+        `((services ,base))
+        `((services (cons* ,@snippets ,base))))))