From patchwork Sat Dec 24 13:51:31 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Bruno Victal X-Patchwork-Id: 45562 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 5448527BBEB; Sat, 24 Dec 2022 13:56:23 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-3.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 430E927BBE9 for ; Sat, 24 Dec 2022 13:56:20 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1p950T-0000RB-03; Sat, 24 Dec 2022 08:56:09 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1p950N-0000Qg-Le for guix-patches@gnu.org; Sat, 24 Dec 2022 08:56:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1p950L-0003Tn-TE for guix-patches@gnu.org; Sat, 24 Dec 2022 08:56:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1p950L-0001ie-Pc for guix-patches@gnu.org; Sat, 24 Dec 2022 08:56:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#59866] [PATCH v5 1/2] services: mpd: rewrite using 'define-configuration'. References: In-Reply-To: Resent-From: mirai@makinata.eu Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 24 Dec 2022 13:56:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 59866 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 59866@debbugs.gnu.org Cc: Bruno Victal Received: via spool by 59866-submit@debbugs.gnu.org id=B59866.16718901196575 (code B ref 59866); Sat, 24 Dec 2022 13:56:01 +0000 Received: (at 59866) by debbugs.gnu.org; 24 Dec 2022 13:55:19 +0000 Received: from localhost ([127.0.0.1]:43110 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1p94ze-0001hz-2T for submit@debbugs.gnu.org; Sat, 24 Dec 2022 08:55:18 -0500 Received: from smtpm5.myservices.hosting ([185.26.105.236]:52658) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1p94zc-0001hq-Dr for 59866@debbugs.gnu.org; Sat, 24 Dec 2022 08:55:17 -0500 Received: from mail1.netim.hosting (unknown [185.26.106.172]) by smtpm5.myservices.hosting (Postfix) with ESMTP id 27ACB20C62 for <59866@debbugs.gnu.org>; Sat, 24 Dec 2022 14:55:14 +0100 (CET) Received: from localhost (localhost [127.0.0.1]) by mail1.netim.hosting (Postfix) with ESMTP id 4BCA08009F; Sat, 24 Dec 2022 14:55:14 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at mail1.netim.hosting Received: from mail1.netim.hosting ([127.0.0.1]) by localhost (mail1-1.netim.hosting [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id PsQ3Rg-zBAAs; Sat, 24 Dec 2022 14:55:13 +0100 (CET) Received: from guix-nuc.home.arpa (bl12-93-156.dsl.telepac.pt [85.245.93.156]) (Authenticated sender: lumen@makinata.eu) by mail1.netim.hosting (Postfix) with ESMTPSA id B2A448009D; Sat, 24 Dec 2022 14:55:12 +0100 (CET) From: mirai@makinata.eu Date: Sat, 24 Dec 2022 13:51:31 +0000 Message-Id: <8448291fc734b10d0dc9ce50d6a5131d477b537f.1671889887.git.mirai@makinata.eu> X-Mailer: git-send-email 2.38.1 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches From: Bruno Victal * gnu/services/audio.scm (mpd-configuration, mpd-output): Rewrite using define-configuration. (uglify-field-name): New procedure. (free-form-args?, list-of-mpd-output?): New predicate. --- Changes since v4: * Copyright line moved to patch 1/2. * Retitled commit message and added ChangeLog formatted entries. gnu/services/audio.scm | 218 ++++++++++++++++++++++++----------------- 1 file changed, 130 insertions(+), 88 deletions(-) base-commit: aae8371f72805cc35e31817e4120468eee4a4a80 diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm index c60053f33c..1a1026f342 100644 --- a/gnu/services/audio.scm +++ b/gnu/services/audio.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017 Peter Mikkelsen ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2020 Ludovic Courtès +;;; Copyright © 2022 Bruno Victal ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +22,7 @@ (define-module (gnu services audio) #:use-module (guix gexp) #:use-module (gnu services) + #:use-module (gnu services configuration) #:use-module (gnu services shepherd) #:use-module (gnu system shadow) #:use-module (gnu packages admin) @@ -28,6 +30,8 @@ (define-module (gnu services audio) #:use-module (guix records) #:use-module (ice-9 match) #:use-module (ice-9 format) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:export (mpd-output mpd-output? mpd-configuration @@ -40,93 +44,131 @@ (define-module (gnu services audio) ;;; ;;; Code: -(define-record-type* - mpd-output make-mpd-output - mpd-output? - (type mpd-output-type - (default "pulse")) - (name mpd-output-name - (default "MPD")) - (enabled? mpd-output-enabled? - (default #t)) - (tags? mpd-output-tags? - (default #t)) - (always-on? mpd-output-always-on? - (default #f)) - (mixer-type mpd-output-mixer-type - ;; valid: hardware, software, null, none - (default #f)) - (extra-options mpd-output-extra-options - (default '()))) - -(define-record-type* - mpd-configuration make-mpd-configuration - mpd-configuration? - (user mpd-configuration-user - (default "mpd")) - (music-dir mpd-configuration-music-dir - (default "~/Music")) - (playlist-dir mpd-configuration-playlist-dir - (default "~/.mpd/playlists")) - (db-file mpd-configuration-db-file - (default "~/.mpd/tag_cache")) - (state-file mpd-configuration-state-file - (default "~/.mpd/state")) - (sticker-file mpd-configuration-sticker-file - (default "~/.mpd/sticker.sql")) - (port mpd-configuration-port - (default "6600")) - (address mpd-configuration-address - (default "any")) - (outputs mpd-configuration-outputs - (default (list (mpd-output))))) - -(define (mpd-output->string output) - "Convert the OUTPUT of type to a configuration file snippet." - (let ((extra (string-join - (map (match-lambda - ((key . value) - (format #f " ~a \"~a\"" - (string-map - (lambda (c) (if (char=? c #\-) #\_ c)) - (symbol->string key)) - value))) - (mpd-output-extra-options output)) - "\n"))) - (format #f "\ -audio_output { - type \"~a\" - name \"~a\" -~:[ enabled \"no\"~%~;~]\ -~:[ tags \"no\"~%~;~]\ -~:[~; always_on \"yes\"~%~]\ -~@[ mixer_type \"~a\"~%~]\ -~a~%}~%" - (mpd-output-type output) - (mpd-output-name output) - (mpd-output-enabled? output) - (mpd-output-tags? output) - (mpd-output-always-on? output) - (mpd-output-mixer-type output) - extra))) - -(define (mpd-config->file config) - (apply - mixed-text-file "mpd.conf" - "pid_file \"" (mpd-file-name config "pid") "\"\n" - (append (map mpd-output->string - (mpd-configuration-outputs config)) - (map (match-lambda - ((config-name config-val) - (string-append config-name " \"" (config-val config) "\"\n"))) - `(("user" ,mpd-configuration-user) - ("music_directory" ,mpd-configuration-music-dir) - ("playlist_directory" ,mpd-configuration-playlist-dir) - ("db_file" ,mpd-configuration-db-file) - ("state_file" ,mpd-configuration-state-file) - ("sticker_file" ,mpd-configuration-sticker-file) - ("port" ,mpd-configuration-port) - ("bind_to_address" ,mpd-configuration-address)))))) +(define (uglify-field-name field-name) + (let ((str (symbol->string field-name))) + (string-join (string-split (if (string-suffix? "?" str) + (string-drop-right str 1) + str) + #\-) + "_"))) + +(define (free-form-args? val) + (match val + (() #t) + ((((? symbol?) . (? string?)) . val) (free-form-args? val)) + (_ #f))) + +(define* (mpd-serialize-field field-name value #:optional (indent-level 0)) + #~(begin + (use-modules ((ice-9 format))) + (format #f "~v/~a \"~a\"~%" #$indent-level #$(if (string? field-name) + field-name + (uglify-field-name field-name)) #$value))) + +(define* (mpd-serialize-free-form-args field-name value #:optional (indent-level 0)) + (generic-serialize-alist string-append (cut mpd-serialize-field <> <> indent-level) value)) + +(define mpd-serialize-number mpd-serialize-field) + +(define mpd-serialize-string mpd-serialize-field) + +(define* (mpd-serialize-boolean field-name value #:optional (indent-level 0)) + (mpd-serialize-field field-name (if value "yes" "no") indent-level)) + +(define (mpd-serialize-list-of-mpd-output field-name value) + #~(string-append "\naudio_output {\n" + #$@(map (cut serialize-configuration <> + mpd-output-fields) + value) + "}\n")) + +(define (mpd-serialize-configuration configuration) + (mixed-text-file + "mpd.conf" + (serialize-configuration configuration mpd-configuration-fields))) + +(define mpd-subsystem-serialize-field (cut mpd-serialize-field <> <> 1)) +(define mpd-subsystem-serialize-string (cut mpd-serialize-string <> <> 1)) +(define mpd-subsystem-serialize-number (cut mpd-serialize-number <> <> 1)) +(define mpd-subsystem-serialize-boolean (cut mpd-serialize-boolean <> <> 1)) +(define mpd-subsystem-serialize-free-form-args (cut mpd-serialize-free-form-args <> <> 1)) + +(define-configuration mpd-output + (name + (string "MPD") + "The name of the audio output.") + (type + (string "pulse") + "The type of audio output.") + (enabled? + (boolean #t) + "Specifies whether this audio output is enabled when MPD is started. By +default, all audio outputs are enabled. This is just the default +setting when there is no state file; with a state file, the previous +state is restored.") + (tags? + (boolean #t) + "If set to @code{#f}, then MPD will not send tags to this output. This +is only useful for output plugins that can receive tags, for example the +@code{httpd} output plugin.") + (always-on? + (boolean #f) + "If set to @code{#t}, then MPD attempts to keep this audio output always +open. This may be useful for streaming servers, when you don’t want to +disconnect all listeners even when playback is accidentally stopped.") + (mixer-type + (string "none") + "This field accepts a symbol that specifies which mixer should be used +for this audio output: the @code{hardware} mixer, the @code{software} +mixer, the @code{null} mixer (allows setting the volume, but with no +effect; this can be used as a trick to implement an external mixer +External Mixer) or no mixer (@code{none}).") + (extra-options + (free-form-args '()) + "An association list of option symbols to string values to be appended to +the audio output configuration.") + (prefix mpd-subsystem-)) + +(define list-of-mpd-output? + (list-of mpd-output?)) + +(define-configuration mpd-configuration + (user + (string "mpd") + "The user to run mpd as.") + (music-dir + (string "~/Music") + "The directory to scan for music files." + (lambda (_ x) + (mpd-serialize-field "music_directory" x))) + (playlist-dir + (string "~/.mpd/playlists") + "The directory to store playlists." + (lambda (_ x) + (mpd-serialize-field "playlist_directory" x))) + (db-file + (string "~/.mpd/tag_cache") + "The location of the music database.") + (state-file + (string "~/.mpd/state") + "The location of the file that stores current MPD's state.") + (sticker-file + (string "~/.mpd/sticker.sql") + "The location of the sticker database.") + (port + (string "6600") + "The port to run mpd on.") + (address + (string "any") + "The address that mpd will bind to. +To use a Unix domain socket, an absolute path can be specified here." + (lambda (_ x) + (mpd-serialize-field "bind_to_address" x))) + (outputs + (list-of-mpd-output (list (mpd-output))) + "The audio outputs that MPD can use. +By default this is a single output using pulseaudio.") + (prefix mpd-)) (define (mpd-file-name config file) "Return a path in /var/run/mpd/ that is writable @@ -143,7 +185,7 @@ (define (mpd-shepherd-service config) (start #~(make-forkexec-constructor (list #$(file-append mpd "/bin/mpd") "--no-daemon" - #$(mpd-config->file config)) + #$(mpd-serialize-configuration config)) #:environment-variables ;; Required to detect PulseAudio when run under a user account. (list (string-append