home: services: home-sway-service-type: Enable extensions.

* gnu/home/services/sway.scm (%empty-sway-configuration): New value.
  (sway-combine): New procedure.
  (sway-compose): New procedure.
  (sway-extend): New procedure.
  (home-sway-service-type) [compose/extend]: New fields.
* doc/guix.texi (Sway window manager): Document this.

Change-Id: I548a18a6a273380be90c9b5b365f65a93cc02416
Signed-off-by: Ludovic Courtès <ludo@gnu.org>

2 files changed, 82 insertions, 1 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 622a4e76f06..13665b568d7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -52511,6 +52511,21 @@ providing a @file{~/.config/sway/config} file,
 @item
 adding Sway-related packages to your profile.
 @end itemize
+
+It is possible to extend this service (@pxref{Service Composition}).
+The resulting configuration file contains the concatenation of
+keybindings, modes, @i{etc.}@: found in all extensions.
+
+@quotation Note
+At the moment, only one bar configuration is allowed.  If more are
+found, an error will be raised.
+@end quotation
+@end defvar
+
+@defvar %empty-sway-configuration
+The variable @code{%empty-sway-configuration} contains an empty
+@code{sway-configuration} record.  This value can help users write
+simple service extensions.
 @end defvar
 
 @deftp {Data Type} sway-configuration
diff --git a/gnu/home/services/sway.scm b/gnu/home/services/sway.scm
index 4e521091900..34447e95f2e 100644
--- a/gnu/home/services/sway.scm
+++ b/gnu/home/services/sway.scm
@@ -50,7 +50,10 @@
             %sway-default-modes
             %sway-default-keybindings
             %sway-default-startup-programs
-            %sway-default-packages))
+            %sway-default-packages
+
+            ;; Convenient value to inherit for extensions.
+            %empty-sway-configuration))
 
 ;; Helper function.
 (define (flatmap f l)
@@ -894,9 +897,70 @@
 ;;; Definition of the Home Service.
 ;;;
 
+(define %empty-sway-configuration
+  (sway-configuration
+    (variables '())
+    (keybindings '())
+    (gestures '())
+    (packages '())
+    (inputs '())
+    (outputs '())
+    (modes '())
+    (startup+reload-programs '())
+    (startup-programs '())))
+
 (define (sway-configuration->files sway-conf)
   `((".config/sway/config" ,(sway-configuration->file sway-conf))))
 
+(define (sway-combine config1 config2)
+  (sway-configuration
+    (keybindings (append (sway-configuration-keybindings config1)
+                         (sway-configuration-keybindings config2)))
+    (gestures (append (sway-configuration-gestures config1)
+                      (sway-configuration-gestures config2)))
+    (packages (append (sway-configuration-packages config1)
+                      (sway-configuration-packages config2)))
+    (variables (append (sway-configuration-variables config1)
+                       (sway-configuration-variables config2)))
+    (inputs (append (sway-configuration-inputs config1)
+                    (sway-configuration-inputs config2)))
+    (outputs (append (sway-configuration-outputs config1)
+                     (sway-configuration-outputs config2)))
+    (bar (let ((bar1 (sway-configuration-bar config1))
+               (bar2 (sway-configuration-bar config2)))
+           (if (eq? bar1 %unset-value)
+               bar2
+               (if (eq? bar2 %unset-value)
+                   bar1
+                   (throw "[Sway configuration] Too many bar configurations \
+have been found.")))))
+    (modes (append (sway-configuration-modes config1)
+                   (sway-configuration-modes config2)))
+    (startup+reload-programs
+     (append (sway-configuration-startup+reload-programs config1)
+             (sway-configuration-startup+reload-programs config2)))
+    (startup-programs
+     (append (sway-configuration-startup-programs config1)
+             (sway-configuration-startup-programs config2)))
+    (extra-content
+     (append (sway-configuration-extra-content config1)
+             (sway-configuration-extra-content config2)))))
+
+(define (sway-compose lst)
+  "Naive composition procedure for @code{home-sway-service-type}.  Most fields
+of above configuration records are lists.  The composition procedure simply
+concatenates them."
+  (match lst
+    (() %unset-value)
+    ((h) h)
+    ((h . t)
+     (fold sway-combine h t))))
+
+(define (sway-extend ini res)
+  (if (eq? res %unset-value)
+      ini
+      (sway-combine ini res)))
+
 (define home-sway-service-type
   (service-type
    (name 'home-sway-config)
@@ -905,6 +969,8 @@
                              sway-configuration->files)
           (service-extension home-profile-service-type
                              sway-configuration-packages)))
+   (compose sway-compose)
+   (extend sway-extend)
    (description "Configure Sway by providing a file
 @file{~/.config/sway/config}.")
    (default-value (sway-configuration))))