~ruther/guix-local

75988317b22efee2b2719e7d559fa9ff01a9db9a — Ludovic Courtès 7 years ago e8aa4e9
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.
3 files changed, 55 insertions(+), 41 deletions(-)

M gnu/installer.scm
M gnu/installer/newt/services.scm
M gnu/installer/services.scm
M gnu/installer.scm => gnu/installer.scm +1 -2
@@ 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)

M gnu/installer/newt/services.scm => gnu/installer/newt/services.scm +3 -3
@@ 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 ()

M gnu/installer/services.scm => gnu/installer/services.scm +51 -36
@@ 1,5 1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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))))))