diff mbox series

[bug#53676,v2,3/4] services: pulseaudio: Add an extra-script-files configuration field.

Message ID 20220224163828.11330-3-maxim.cournoyer@gmail.com
State Accepted
Headers show
Series [bug#53676,v2,1/4] services/sound: Normalize pulseaudio-configuration accessor names. | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Maxim Cournoyer Feb. 24, 2022, 4:38 p.m. UTC 
* gnu/services/sound.scm (<pulseaudio-configuration>)
[extra-script-files]: Add field.
(extra-script-files->file-union): Add procedure.
(pulseaudio-etc): Use it.
* doc/guix.texi: Document it.
---
 doc/guix.texi          | 30 ++++++++++++++++++++++++++++++
 gnu/services/sound.scm | 38 ++++++++++++++++++++++++++++++++++++--
 2 files changed, 66 insertions(+), 2 deletions(-)

Comments

M Feb. 24, 2022, 6:53 p.m. UTC | #1 
Maxim Cournoyer schreef op do 24-02-2022 om 11:38 [-0500]:
> +  (define (file-like->name file)
> +    (match file
> +      ((? local-file?)
> +       (local-file-name file))
> +      ((? plain-file?)
> +       (plain-file-name file))
> +      ((? computed-file?)
> +       (computed-file-name file))
> +      (_ (leave (G_ "~a is not a local-file, plain-file or \
> +computed-file object~%") file))))

This would not work with things like '(file-append ...)'.
Perhaps 'extra-script-files->file-union' can be made more general
by creating a variant of 'file-union' for this use case?
Maybe something like (untested):

;; Based on 'file-union'
(define* (file-directory . files)
  ; files: (file-like1 file-like2 ...)
  (computed-file name
                 (with-imported-modules '((guix build utils))
                   (gexp
                    (begin
                      (use-modules (guix build utils))

                      (mkdir (ungexp output))
                      (chdir (ungexp output))
                      (ungexp-splicing
                       (map (lambda (source)
                              (gexp
                               (let ((target (basename source))
                                 ;; Stat the source to abort early if it does
                                 ;; not exist.
                                 (stat (ungexp source))
                                 (symlink (ungexp source) (ungexp target)))))
                            files)))))))

Greetings,
Maxime.
Maxim Cournoyer Feb. 24, 2022, 10:20 p.m. UTC | #2 
Hi Maxime,

Maxime Devos <maximedevos@telenet.be> writes:

> Maxim Cournoyer schreef op do 24-02-2022 om 11:38 [-0500]:
>> +  (define (file-like->name file)
>> +    (match file
>> +      ((? local-file?)
>> +       (local-file-name file))
>> +      ((? plain-file?)
>> +       (plain-file-name file))
>> +      ((? computed-file?)
>> +       (computed-file-name file))
>> +      (_ (leave (G_ "~a is not a local-file, plain-file or \
>> +computed-file object~%") file))))
>
> This would not work with things like '(file-append ...)'.
> Perhaps 'extra-script-files->file-union' can be made more general
> by creating a variant of 'file-union' for this use case?
> Maybe something like (untested):
>
> ;; Based on 'file-union'
> (define* (file-directory . files)
>   ; files: (file-like1 file-like2 ...)
>   (computed-file name
>                  (with-imported-modules '((guix build utils))
>                    (gexp
>                     (begin
>                       (use-modules (guix build utils))
>
>                       (mkdir (ungexp output))
>                       (chdir (ungexp output))
>                       (ungexp-splicing
>                        (map (lambda (source)
>                               (gexp
>                                (let ((target (basename source))
>                                  ;; Stat the source to abort early if it does
>                                  ;; not exist.
>                                  (stat (ungexp source))
>                                  (symlink (ungexp source) (ungexp target)))))
>                             files)))))))

Not a bad idea, but it steers a bit on the too-complicated side of
things for my taste; for one thing, I wouldn't know how to do the
validation of the file name anymore (it needs to end by ".pa").  It
could be done inside that procedure, but it'd become more tangled.

The simple file-like->name procedure above will error with an accurate
message telling the users about its limits (that it only accepts
local-file, plain-file or computed-file).

G-Exp wizards can still opt the mixed-text-file + any G-Exp
transformation they wish via the 'script-file' field.

Thanks,

Maxim
diff mbox series

Patch

diff --git a/doc/guix.texi b/doc/guix.texi
index f336c26e8a..9941be5033 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -21509,9 +21509,39 @@  List of settings to set in @file{daemon.conf}, formatted just like
 @item @code{script-file} (default: @code{(file-append pulseaudio "/etc/pulse/default.pa")})
 Script file to use as @file{default.pa}.
 
+@item @code{extra-script-files} (default: @code{'())})
+A list of file-like objects defining extra PulseAudio scripts to run at
+the initialization of the @command{pulseaudio} daemon, after the main
+@code{script-file}.  The scripts are deployed to the
+@file{/etc/pulse/default.pa.d} directory; they should have the
+@samp{.pa} file name extension.  For a reference of the available
+commands, refer to @command{man pulse-cli-syntax}.
+
 @item @code{system-script-file} (default: @code{(file-append pulseaudio "/etc/pulse/system.pa")})
 Script file to use as @file{system.pa}.
 @end table
+
+The example below sets the default PulseAudio card profile, the default
+sink and the default source to use for a old SoundBlaster Audigy sound
+card:
+@lisp
+(pulseaudio-configuration
+ (extra-script-files
+  (list (plain-file "audigy.pa"
+                    (string-append "\
+set-card-profile alsa_card.pci-0000_01_01.0 \
+  output:analog-surround-40+input:analog-mono
+set-default-source alsa_input.pci-0000_01_01.0.analog-mono
+set-default-sink alsa_output.pci-0000_01_01.0.analog-surround-40\n")))))
+@end lisp
+
+Note that @code{pulseaudio-service-type} is part of
+@code{%desktop-services}; if your operating system declaration was
+derived from one of the desktop templates, you'll want to adjust the
+above example to modify the existing @code{pulseaudio-service-type} via
+@code{modify-services} (@pxref{Service Reference,
+@code{modify-services}}), instead of defining a new one.
+
 @end deftp
 
 @deffn {Scheme Variable} ladspa-service-type
diff --git a/gnu/services/sound.scm b/gnu/services/sound.scm
index 9684e06d13..eecea1a733 100644
--- a/gnu/services/sound.scm
+++ b/gnu/services/sound.scm
@@ -26,14 +26,17 @@  (define-module (gnu services sound)
   #:use-module (gnu services)
   #:use-module (gnu system pam)
   #:use-module (gnu system shadow)
+  #:use-module (guix diagnostics)
   #:use-module (guix gexp)
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (guix store)
+  #:use-module (guix ui)
   #:use-module (gnu packages audio)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages pulseaudio)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:export (alsa-configuration
             alsa-service-type
 
@@ -125,6 +128,8 @@  (define-record-type* <pulseaudio-configuration>
                (default '((flat-volumes . no))))
   (script-file pulseaudio-configuration-script-file
                (default (file-append pulseaudio "/etc/pulse/default.pa")))
+  (extra-script-files pulseaudio-configuration-extra-script-files
+                      (default '()))
   (system-script-file pulseaudio-configuration-system-script-file
                       (default
                         (file-append pulseaudio "/etc/pulse/system.pa"))))
@@ -145,14 +150,43 @@  (define pulseaudio-environment
        ("PULSE_CLIENTCONFIG" . ,(apply mixed-text-file "client.conf"
                                        (map pulseaudio-conf-entry client-conf)))))))
 
+(define (extra-script-files->file-union extra-script-files)
+  "Return a G-exp obtained by processing EXTRA-SCRIPT-FILES with FILE-UNION."
+
+  (define (file-like->name file)
+    (match file
+      ((? local-file?)
+       (local-file-name file))
+      ((? plain-file?)
+       (plain-file-name file))
+      ((? computed-file?)
+       (computed-file-name file))
+      (_ (leave (G_ "~a is not a local-file, plain-file or \
+computed-file object~%") file))))
+
+  (define (assert-pulseaudio-script-file-name name)
+    (unless (string-suffix? ".pa" name)
+      (leave (G_ "`~a' lacks the required `.pa' file name extension~%") name))
+    name)
+
+  (let ((labels (map (compose assert-pulseaudio-script-file-name
+                              file-like->name)
+                     extra-script-files)))
+    (file-union "default.pa.d" (zip labels extra-script-files))))
+
 (define pulseaudio-etc
   (match-lambda
-    (($ <pulseaudio-configuration> _ _ default-script-file system-script-file)
+    (($ <pulseaudio-configuration> _ _ default-script-file extra-script-files
+                                   system-script-file)
      `(("pulse"
         ,(file-union
           "pulse"
           `(("default.pa" ,default-script-file)
-            ("system.pa" ,system-script-file))))))))
+            ("system.pa" ,system-script-file)
+            ,@(if (null? extra-script-files)
+                  '()
+                  `(("default.pa.d" ,(extra-script-files->file-union
+                                      extra-script-files)))))))))))
 
 (define pulseaudio-service-type
   (service-type