[bug#40454] [PATCH] services: Add udev-rules-service helper.

[Brice Waegeneire]

* doc/guix.texi (Base services): Add documentation for
'udev-rules-service'. Replace examples of 'udev-service-type' extension
with 'udev-rules-service'.
* gnu/services/base.scm (udev-rules-service): New procedure.
---
 doc/guix.texi         | 46 +++++++++++++++++++++----------------------
 gnu/services/base.scm | 22 +++++++++++++++++++++
 2 files changed, 45 insertions(+), 23 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index bc5602474e..da7fbbc12c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12785,8 +12785,12 @@ A directory path where the @command{guix-daemon} will 
perform builds.
 @deffn {Scheme Procedure} udev-service [#:udev @var{eudev} #:rules @code{'()}]
 Run @var{udev}, which populates the @file{/dev} directory dynamically.
 udev rules can be provided as a list of files through the @var{rules}
-variable.  The procedures @code{udev-rule} and @code{file->udev-rule} from
-@code{(gnu services base)} simplify the creation of such rule files.
+variable.  The procedures @code{udev-rule}, @code{udev-rules-service}
+and @code{file->udev-rule} from @code{(gnu services base)} simplify the
+creation of such rule files.
+
+The @command{herd rules udev} command, as root, returns the name of the
+directory containing all the active udev rules.
 @end deffn
 
 @deffn {Scheme Procedure} udev-rule [@var{file-name} @var{contents}]
@@ -12805,23 +12809,27 @@ upon detecting a USB device with a given product 
identifier.
                    "ATTR@{product@}==\"Example\", "
                    "RUN+=\"/path/to/script\"")))
 @end lisp
-
-The @command{herd rules udev} command, as root, returns the name of the
-directory containing all the active udev rules.
 @end deffn
 
-Here we show how the default @var{udev-service} can be extended with it.
+@deffn {Scheme Procedure} udev-rules-service [@var{name} @var{rules}] @
+               [#:groups @var{groups}]
+Return a service that extends @code{udev-service-type } with @var{rules}
+and @code{account-service-type} with @var{groups} as system groups.
+This works by creating a singleton service type
+@var{name}@code{-udev-rules}, of which the returned service is an
+instance.
+
+Here we show how it can be used to extend @var{udev-service} with the
+previously defined rule @code{%example-udev-rule}.
 
 @lisp
 (operating-system
  ;; @dots{}
  (services
- (modify-services %desktop-services
-   (udev-service-type config =>
-     (udev-configuration (inherit config)
-      (rules (append (udev-configuration-rules config)
-                     (list %example-udev-rule))))))))
+   (cons* (udev-rules-service 'usb-thing %example-udev-rule)
+          %desktop-services)))
 @end lisp
+@end deffn
 
 @deffn {Scheme Procedure} file->udev-rule [@var{file-name} @var{file}]
 Return a udev file named @var{file-name} containing the rules defined
@@ -12861,7 +12869,7 @@ without root privileges.  It also details how to create 
the
 the rules defined within the @var{android-udev-rules} package.  To
 create such a group, we must define it both as part of the
 @var{supplementary-groups} of our @var{user-account} declaration, as
-well as in the @var{groups} field of the @var{operating-system} record.
+well as in the @var{groups} of the @var{udev-rules-service} procedure.
 
 @lisp
 (use-modules (gnu packages android)  ;for android-udev-rules
@@ -12875,19 +12883,11 @@ well as in the @var{groups} field of the 
@var{operating-system} record.
                 (supplementary-groups
                  '("adbusers"   ;for adb
                    "wheel" "netdev" "audio" "video")))))
-
-  (groups (cons (user-group (system? #t) (name "adbusers"))
-                %base-groups))
-
   ;; @dots{}
-
   (services
-   (modify-services %desktop-services
-     (udev-service-type
-      config =>
-      (udev-configuration (inherit config)
-                          (rules (cons android-udev-rules
-                                       (udev-configuration-rules config))))))))
+    (cons* (udev-rules-service 'android android-udev-rules
+                               #:groups '("adbusers"))
+           %desktop-services)))
 @end lisp
 
 @defvr {Scheme Variable} urandom-seed-service-type
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 8d9a563e2b..070765ab83 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -12,6 +12,7 @@
 ;;; Copyright © 2019 John Soo <address@hidden>
 ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <address@hidden>
 ;;; Copyright © 2020 Florian Pelz <address@hidden>
+;;; Copyright © 2020 Brice Waegeneire <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -92,6 +93,7 @@
             udev-service
             udev-rule
             file->udev-rule
+            udev-rules-service
 
             login-configuration
             login-configuration?
@@ -2122,6 +2124,26 @@ extra rules from the packages listed in @var{rules}."
   (service udev-service-type
            (udev-configuration (udev udev) (rules rules))))
 
+(define* (udev-rules-service name rules #:key (groups '()))
+  "Return a service that extends udev-service-type with RULES and
+account-service-type with GROUPS as system groups.  This works by creating a
+singleton service type NAME-udev-rules, of which the returned service is an
+instance."
+  (let* ((name (symbol-append name '-udev-rules))
+         (account-extension
+          (const (map (lambda (group)
+                        (user-group (name group) (system? #t)))
+                      groups)))
+         (udev-extension (const (list rules)))
+         (type (service-type
+                (name name)
+                (extensions (list
+                             (service-extension
+                              account-service-type account-extension)
+                             (service-extension
+                              udev-service-type udev-extension))))))
+    (service type #f)))
+
 (define swap-service-type
   (shepherd-service-type
    'swap
-- 
2.26.0