services: Generalize alsa-configuration.

* gnu/packages/sound.scm (alsa-pcm-configuration, alsa-ctl-configuration): New
configuration records.
(serialize-alsa-pcm-configuration, serialize-alsa-ctl-configuration): New variables.
(<alsa-configuration>): Remove alsa-plugins and pulseaudio?.
Add default-pcm and default-ctl.
Rename extra-options to options.
(alsa-config-file): Adjust accordingly.
(alsa-servcice-type): Add compose and extend.
(<pulseaudio-configuration>): Add alsa-lib.
(pulseaudio-alsa-configuration): New procedure.
(pulseaudio-service-type): Extend alsa-servcice-type.

1 files changed, 117 insertions, 42 deletions

diff --git a/gnu/services/sound.scm b/gnu/services/sound.scm
index b41ff3921b1..4c319153448 100644
--- a/gnu/services/sound.scm
+++ b/gnu/services/sound.scm
@@ -41,11 +41,20 @@
   #:use-module (gnu packages rust-apps)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
-  #:export (alsa-configuration
+  #:export (alsa-pcm-configuration
+            alsa-pcm-configuration-type
+            alsa-pcm-configuration-hint
+            alsa-pcm-configuration-configuration
+
+            alsa-ctl-configuration
+            alsa-ctl-configuration-type
+            alsa-ctl-configuration-configuration
+
+            alsa-configuration
             alsa-configuration?
-            alsa-configuration-alsa-plugins
-            alsa-configuration-pulseaudio?
-            alsa-configuration-extra-options
+            alsa-configuration-default-ctl
+            alsa-configuration-default-pcm
+            alsa-configuration-options
             alsa-service-type
 
             pulseaudio-configuration
@@ -81,48 +90,70 @@
 ;;; ALSA
 ;;;
 
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization alsa-pcm-configuration
+  (type symbol "The PCM type.")
+  (hint maybe-string "A human-readable description of the PCM.")
+  (configuration
+   list-of-strings
+   "Additional configuration.  Each item will be printed on a separate line."))
+
+(define-configuration/no-serialization alsa-ctl-configuration
+  (type symbol "The CTL type.")
+  (configuration
+   list-of-strings
+   "Additional configuration.  Each item will be printed on a separate line."))
+
 (define-record-type* <alsa-configuration>
   alsa-configuration make-alsa-configuration alsa-configuration?
-  (alsa-plugins alsa-configuration-alsa-plugins ;file-like
-                (default alsa-plugins))
-  (pulseaudio?   alsa-configuration-pulseaudio? ;boolean
-                 (default #t))
-  (extra-options alsa-configuration-extra-options ;string
-                 (default "")))
+  (default-pcm alsa-configuration-default-pcm (default #f))
+  (default-ctl alsa-configuration-default-ctl (default #f))
+  (options alsa-configuration-options ; string
+           (default (list))))
+
+(define (serialize-alsa-pcm-configuration config name)
+  (match-record config <alsa-pcm-configuration>
+                (type hint configuration)
+    #~(string-append
+       "pcm." #$name " {\n"
+       "  type " #$(symbol->string  type) "\n"
+       #$(if hint
+             (string-append "  hint { show on; description \"" hint "\" }\n")
+             "")
+       #$(if (null? configuration) "" "  ")
+       #$(string-join configuration "\n  ")
+       "\n}")))
+
+(define (serialize-alsa-ctl-configuration config name)
+  (match-record config <alsa-ctl-configuration>
+                (type configuration)
+    #~(string-append
+       "ctl." #$name " {\n"
+       "  type " #$(symbol->string type) "\n"
+       #$(if (null? configuration) "" "  ")
+       #$(string-join configuration "\n  ")
+       "\n}")))
 
 (define alsa-config-file
   ;; Return the ALSA configuration file.
   (match-lambda
-    (($ <alsa-configuration> alsa-plugins pulseaudio? extra-options)
-     (apply mixed-text-file "asound.conf"
-            `("# Generated by 'alsa-service'.\n\n"
-              ,@(if pulseaudio?
-                    `("# Use PulseAudio by default
-pcm_type.pulse {
-  lib \"" ,#~(string-append #$alsa-plugins:pulseaudio
-                            "/lib/alsa-lib/libasound_module_pcm_pulse.so") "\"
-}
-
-ctl_type.pulse {
-  lib \"" ,#~(string-append #$alsa-plugins:pulseaudio
-                            "/lib/alsa-lib/libasound_module_ctl_pulse.so") "\"
-}
-
-pcm.!default {
-  type pulse
-  fallback \"sysdefault\"
-  hint {
-    show on
-    description \"Default ALSA Output (currently PulseAudio Sound Server)\"
-  }
-}
-
-ctl.!default {
-  type pulse
-  fallback \"sysdefault\"
-}\n\n")
-                    '())
-              ,extra-options)))))
+    (($ <alsa-configuration> default-pcm default-ctl options)
+     (mixed-text-file
+      "asound.conf"
+      #~(string-join
+         (list
+          "# Generated by 'alsa-service'"
+          #$@options
+          #$@(if default-pcm
+                 (list
+                  (serialize-alsa-pcm-configuration default-pcm "!default"))
+                 '())
+          #$@(if default-ctl
+                (list
+                 (serialize-alsa-ctl-configuration default-ctl "!default"))
+                '()))
+         "\n")))))
 
 (define (alsa-etc-service config)
   (list `("asound.conf" ,(alsa-config-file config))))
@@ -132,6 +163,22 @@ ctl.!default {
    (name 'alsa)
    (extensions
     (list (service-extension etc-service-type alsa-etc-service)))
+   (compose concatenate)
+   (extend (lambda (config extensions)
+             (let* ((configs (cons config extensions))
+                    (options (append-map (lambda (cfg)
+                                           (alsa-configuration-options cfg))
+                                         configs))
+                    (default-pcm (any (lambda (cfg)
+                                        (alsa-configuration-default-pcm cfg))
+                                      (reverse configs)))
+                    (default-ctl (any (lambda (cfg)
+                                        (alsa-configuration-default-ctl cfg))
+                                      (reverse configs))))
+               (alsa-configuration
+                 (default-pcm default-pcm)
+                 (default-ctl default-ctl)
+                 (options options)))))
    (default-value (alsa-configuration))
    (description "Configure low-level Linux sound support, ALSA.")))
 
@@ -156,7 +203,10 @@ ctl.!default {
                       (default '()))
   (system-script-file pulseaudio-configuration-system-script-file
                       (default
-                        (file-append pulseaudio "/etc/pulse/system.pa"))))
+                        (file-append pulseaudio "/etc/pulse/system.pa")))
+  (alsa-lib pulseaudio-alsa-lib
+            (default #~(string-append #$alsa-plugins:pulseaudio
+                                      "/lib/alsa-lib"))))
 
 (define (pulseaudio-conf-entry arg)
   (match arg
@@ -237,11 +287,36 @@ computed-file object~%") file))))
             ,(apply mixed-text-file "client.conf"
                     (map pulseaudio-conf-entry client-conf)))))))))
 
+(define pulseaudio-alsa-configuration
+  (match-record-lambda <pulseaudio-configuration>
+      (alsa-lib)
+    (list
+     (alsa-configuration
+       (default-pcm
+         (alsa-pcm-configuration
+          (type 'pulse)
+          (hint "Default ALSA Output (currently PulseAudio Sound Server)")
+          (configuration (list "fallback \"sysdefault\""))))
+       (default-ctl
+         (alsa-ctl-configuration
+          (type 'pulse)
+          (configuration (list "fallback \"sysdefault\""))))
+       (options
+        (list
+         #~(string-append "pcm_type.pulse {
+  lib \"" #$alsa-lib "/libasound_module_pcm_pulse.so\"
+}")
+         #~(string-append "ctl_type.pulse {
+  lib \"" #$alsa-lib "/libasound_module_ctl_pulse.so\"
+}")))))))
+
 (define pulseaudio-service-type
   (service-type
    (name 'pulseaudio)
    (extensions
-    (list (service-extension session-environment-service-type
+    (list (service-extension alsa-service-type
+                             pulseaudio-alsa-configuration)
+          (service-extension session-environment-service-type
                              pulseaudio-environment)
           (service-extension etc-service-type pulseaudio-etc)
           (service-extension udev-service-type (const (list pulseaudio)))))