Factor out common desktop services

Most of the code for setting desktop layouts is common between machines.

Also, make the blueman-applet service reusable.

5 files changed, 159 insertions, 89 deletions

diff --git a/tw/home.scm b/tw/home.scm
index 4065cf3b..4843baef 100644
--- a/tw/home.scm
+++ b/tw/home.scm
@@ -246,37 +246,6 @@
        ("_JAVA_OPTIONS" .
         "$_JAVA_OPTIONS${_JAVA_OPTIONS:+ }-Djava.util.prefs.userRoot=$XDG_CONFIG_HOME/java")))))
 
-(define polybar-wrapper
-  (program-file "polybar-wrapper"
-    #~(begin
-        ;; This wrapper program checks that the monitor we want to start
-        ;; polybar on is actually connected.
-        (use-modules (ice-9 popen)
-                     (ice-9 rdelim))
-        (let* ((connected-str (string-append (getenv "POLYBAR_MONITOR") " connected"))
-               (xrandr (open-pipe* OPEN_READ #$(file-append xrandr "/bin/xrandr") "-q"))
-               (monitor-connected?
-                (let loop ((line (read-line xrandr)))
-                  (cond
-                   ((eof-object? line) #f)                   ; we didn't find our monitor connected
-                   ((string-prefix? connected-str line) #t)  ; the monitor we want is connected
-                   (else (loop (read-line xrandr)))))))      ; keep looking
-          (close-pipe xrandr)
-          (when monitor-connected?
-            (execl #$(file-append polybar "/bin/polybar")))))))
-
-(define-public (polybar-service monitor)
-  (shepherd-service
-   (documentation (string-append "Polybar desktop bar for monitor " monitor "."))
-   (provision (list (symbol-append 'polybar- (string->symbol monitor))))
-   (requirement '(xorg-setup))
-   (start #~(make-forkexec-constructor
-             (list #$polybar-wrapper)
-             #:environment-variables
-             (cons #$(string-append "POLYBAR_MONITOR=" monitor)
-                   (default-environment-variables))))
-   (stop #~(make-kill-destructor))))
-
 (define-public %interactive-packages
   (list
    ;; CLI tools
@@ -507,8 +476,6 @@ show_border=1
            (local-file "home/files/kitty.conf")
            catppuccin-kitty))
        ("mimeapps.list" ,(local-file "home/files/mimeapps.list"))
-       ("polybar/config.ini" ,(local-file "home/files/polybar.ini"))
-       ("polybar/catppuccin.ini" ,catppuccin-polybar)
        ("rofi/config.rasi" ,(local-file "home/files/rofi.rasi"))
        ("rofi/themes/catppuccin.rasi" ,catppuccin-rofi)
        ("xfce4/xfce4-screenshooter" ,xfce4-screenshooter.conf)
diff --git a/tw/home/cern.scm b/tw/home/cern.scm
index 8c6ed7d5..b03a1348 100644
--- a/tw/home/cern.scm
+++ b/tw/home/cern.scm
@@ -30,6 +30,7 @@
   #:use-module (tw packages catppuccin)
   #:use-module (tw packages xorg)
   #:use-module (tw gexp)
+  #:use-module (tw services desktop)
   #:use-module (tw services git)
   #:use-module (tw services gnupg)
   #:use-module (tw theme))
@@ -104,30 +105,18 @@
         (nighttime-brightness 0.7)
         (extra-content "fade=0")))  ; with fade=1, restarting redshift causes flickering for a few secs
 
-     (simple-service 'xorg-setup-services home-shepherd-service-type
-       (list
-        (polybar-service "DP-2")
-        (polybar-service "DP-1-8")
-
-        (shepherd-service
-         (documentation "Set up X displays on login.")
-         (provision '(xorg-setup))
-         (one-shot? #t)
-         (start #~(lambda _
-                    (system* #$(file-append numlockx "/bin/numlockx") "on")
-                    ;; Turn off the monitors if there is no input for 10 minutes.
-                    (system* #$(file-append xset "/bin/xset") "dpms" "600" "600" "600")
-                    (system* #$(file-append xrandr "/bin/xrandr")
-                             "--output" "DP-2" "--primary" "--auto")
-                    (system* #$(file-append xrandr "/bin/xrandr")
-                             ;; This can do 4K but HiDPI is a pain.
-                             "--output" "DP-1-8" "--mode" "1920x1080" "--rate" "60.00"
-                             "--left-of" "DP-2")
-                    ;; Set the desktop background picture. Hopefully doing this just after
-                    ;; xrandr works and sets it for both screens.
-                    (system* #$(file-append hsetroot "/bin/hsetroot") "-cover"
-                             (string-append (getenv "XDG_CONFIG_HOME")
-                                            "/X11/ridge-view.jpg")))))))
+     (service home-desktop-layout-service-type
+       (home-desktop-layout-configuration
+        (desktop-background "~/.config/X11/ridge-view.jpg")
+        (monitors
+         (list (home-monitor-configuration
+                (name "DP-2")
+                (xrandr-options '("--primary" "--auto")))
+               (home-monitor-configuration
+                (name "DP-1-8")
+                ;; This can do 4K but HiDPI is a pain.
+                (xrandr-options '("--mode" "1920x1080" "--rate" "60.00"
+                                  "--left-of" "DP-2")))))))
 
      ;; On my work machine, Git must always use my work PGP key.
      (service home-git-service-type
diff --git a/tw/home/lap.scm b/tw/home/lap.scm
index ae5fb629..b00b8c20 100644
--- a/tw/home/lap.scm
+++ b/tw/home/lap.scm
@@ -38,6 +38,7 @@
   #:use-module ((nongnu packages steam-client)
                 #:select (steam))
   #:use-module (tw home)
+  #:use-module (tw services desktop)
   #:use-module (tw services git)
   #:use-module (tw services gnupg)
   #:use-module (tw packages scanner)
@@ -169,38 +170,21 @@
         (nighttime-brightness 0.7)
         (extra-content "fade=0")))  ; with fade=1, restarting redshift causes flickering for a few secs
 
-     (simple-service 'laptop-gui-services home-shepherd-service-type
-       (list
-        (shepherd-service
-         (documentation "Blueman applet; provides a GUI for connection to bluetooth devices.")
-         (provision '(blueman-applet))
-         (start #~(make-forkexec-constructor
-                   (list #$(file-append blueman "/bin/blueman-applet"))))
-         (stop #~(make-kill-destructor)))
-
-        (polybar-service "eDP-1")
-        (polybar-service "HDMI-1-1")
-
-        (shepherd-service
-         (documentation "Set up X displays on login.")
-         (provision '(xorg-setup))
-         (one-shot? #t)
-         (start #~(lambda _
-                    (system* #$(file-append numlockx "/bin/numlockx") "on")
-                    ;; Turn off the monitors if there is no input for 10 minutes.
-                    (system* #$(file-append xset "/bin/xset") "dpms" "600" "600" "600")
-                    (system* #$(file-append xrandr "/bin/xrandr")
-                             "--output" "eDP-1" "--auto"
-                             ;; Don't use --auto for this monitor. That
-                             ;; configures it at 60 Hz, which causes
-                             ;; it to briefly turn off every few minutes.
-                             "--output" "HDMI-1-1" "--mode" "2560x1440" "--rate" "120.00"
-                             "--right-of" "eDP-1")
-                    ;; Set the desktop background picture. Hopefully doing this just after
-                    ;; xrandr works and sets it for both screens.
-                    (system* #$(file-append hsetroot "/bin/hsetroot") "-cover"
-                             (string-append (getenv "HOME")
-                                            "/pictures/Backgrounds/greece/IMG_20181201_104748_DRO.jpg")))))))
+     (service home-blueman-service-type)
+
+     (service home-desktop-layout-service-type
+       (home-desktop-layout-configuration
+        (desktop-background "~/pictures/Backgrounds/greece/IMG_20181201_104748_DRO.jpg")
+        (monitors
+         (list (home-monitor-configuration
+                (name "eDP-1")
+                (xrandr-options '("--auto")))
+               (home-monitor-configuration
+                (name "HDMI-1-1")
+                ;; Don't use --auto for this monitor. That configures it at 60
+                ;; Hz, which causes it to briefly turn off every few minutes.
+                (xrandr-options '("--mode" "2560x1440" "--rate" "120.00"
+                                  "--right-of" "eDP-1")))))))
 
      ;; On my private machine, I want to use my private PGP key normally, and
      ;; my work key only for work repositories.
diff --git a/tw/services/desktop.scm b/tw/services/desktop.scm
new file mode 100644
index 00000000..b0bb4e8a
--- /dev/null
+++ b/tw/services/desktop.scm
@@ -0,0 +1,130 @@
+(define-module (tw services desktop)
+  #:use-module (gnu)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services shepherd)
+  #:use-module ((gnu packages networking) #:select (blueman))
+  #:use-module ((gnu packages wm) #:select (polybar))
+  #:use-module ((gnu packages xdisorg) #:select (numlockx hsetroot))
+  #:use-module ((gnu packages xorg) #:select (xrandr xset))
+  #:use-module (gnu services configuration)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module ((guix records) #:select (match-record))
+  #:use-module (srfi srfi-1)
+  #:use-module ((tw theme) #:select (catppuccin-polybar))
+  #:export (home-desktop-layout-configuration
+            home-monitor-configuration
+            home-desktop-layout-service-type
+            home-blueman-service-type))
+
+
+;; Monitor layout and polybars
+
+(define (list-of-strings? thing)
+  (and (list? thing) (every string? thing)))
+
+(define-configuration/no-serialization home-monitor-configuration
+  (name string "The monitor's name in X11.")
+  (xrandr-options (list-of-strings '()) "Options to pass to xrandr to
+configure this monitor."))
+
+(define (list-of-monitors? thing)
+  (and (list? thing) (every home-monitor-configuration? thing)))
+
+(define-configuration/no-serialization home-desktop-layout-configuration
+  (desktop-background string "Path to an image that will be set as the desktop
+background.  An initial @code{~/} is replaced with $HOME/.")
+  (monitors list-of-monitors "List of monitor declarations to apply."))
+
+(define (polybar-config monitors)
+  `(("polybar/config.ini" ,(local-file "files/polybar.ini"))
+    ("polybar/catppuccin.ini" ,catppuccin-polybar)))
+
+(define polybar-wrapper
+  (program-file "polybar-wrapper"
+    #~(begin
+        ;; This wrapper program checks that the monitor we want to start
+        ;; polybar on is actually connected.
+        (use-modules (ice-9 popen)
+                     (ice-9 rdelim))
+        (let* ((connected-str (string-append (getenv "POLYBAR_MONITOR") " connected"))
+               (xrandr (open-pipe* OPEN_READ #$(file-append xrandr "/bin/xrandr") "-q"))
+               (monitor-connected?
+                (let loop ((line (read-line xrandr)))
+                  (cond
+                   ((eof-object? line) #f)                   ; we didn't find our monitor connected
+                   ((string-prefix? connected-str line) #t)  ; the monitor we want is connected
+                   (else (loop (read-line xrandr)))))))      ; keep looking
+          (close-pipe xrandr)
+          (when monitor-connected?
+            (execl #$(file-append polybar "/bin/polybar")))))))
+
+(define (polybar-service monitor)
+  (shepherd-service
+   (documentation (string-append "Polybar desktop bar for monitor " monitor "."))
+   (provision (list (symbol-append 'polybar- (string->symbol monitor))))
+   (requirement '(xorg-setup))
+   (start #~(make-forkexec-constructor
+             (list #$polybar-wrapper)
+             #:environment-variables
+             (cons #$(string-append "POLYBAR_MONITOR=" monitor)
+                   (default-environment-variables))))
+   (stop #~(make-kill-destructor))))
+
+(define (desktop-layout-services config)
+  (match-record config <home-desktop-layout-configuration>
+    (desktop-background monitors)
+    (cons* (shepherd-service
+            (documentation "Set up X displays on login.")
+            (provision '(xorg-setup))
+            (one-shot? #t)
+            (start #~(lambda _
+                       (define (replace-home path)
+                         (if (string-prefix? "~/" path)
+                             (string-replace path (getenv "HOME") 0 1)
+                             path))
+                       (system* #$(file-append numlockx "/bin/numlockx") "on")
+                       ;; Turn off the monitors if there is no input for 10 minutes.
+                       (system* #$(file-append xset "/bin/xset") "dpms" "600" "600" "600")
+                       ;; TODO: may need one xrandr invocation per monitor; this is
+                                        ; ;what tw/home/cern.scm had before.
+                       (system* #$(file-append xrandr "/bin/xrandr")
+                                #$@(append-map (lambda (monitor)
+                                                 (match-record monitor <home-monitor-configuration>
+                                                   (name xrandr-options)
+                                                   `("--output" ,name ,@xrandr-options)))
+                                               monitors))
+                       ;; Set the desktop background picture. Hopefully doing this just after
+                       ;; xrandr works and sets it for both screens.
+                       (system* #$(file-append hsetroot "/bin/hsetroot")
+                                "-cover" (replace-home #$desktop-background)))))
+           (map (compose polybar-service home-monitor-configuration-name) monitors))))
+
+(define home-desktop-layout-service-type
+  (service-type
+   (name 'desktop-layout)
+   (extensions
+    (list (service-extension home-shepherd-service-type desktop-layout-services)
+          (service-extension home-xdg-configuration-files-service-type polybar-config)))
+   (description
+    "Configure the desktop background, monitor layout and polybar.")))
+
+
+;; Blueman
+
+(define (blueman-services config)
+  (list (shepherd-service
+         (documentation "Blueman applet; provides a GUI for connection to bluetooth devices.")
+         (provision '(blueman-applet))
+         (start #~(make-forkexec-constructor
+                   (list #$(file-append blueman "/bin/blueman-applet"))))
+         (stop #~(make-kill-destructor)))))
+
+(define home-blueman-service-type
+  (service-type
+   (name 'blueman)
+   (default-value #f)
+   (extensions
+    (list (service-extension home-shepherd-service-type blueman-services)))
+   (description
+    "Run the Blueman applet for graphical Bluetooth control.")))
diff --git a/tw/home/files/polybar.ini b/tw/services/files/polybar.ini
index 201c5131..201c5131 100644
--- a/tw/home/files/polybar.ini
+++ b/tw/services/files/polybar.ini