dotfiles/oni/home/services/picom.scm

(define-module (oni home services picom)
  #:use-module (gnu services configuration)
  #:use-module (gnu packages compton)
  #:use-module (gnu services xorg)
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:use-module (gnu home services utils)
  #:use-module (guix packages)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (guix i18n)
  #:use-module (guix modules)
  #:use-module (guix diagnostics)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)

  #:export (home-picom-service-type
            home-picom-configuration))

(define (serialize-alist field value)
  (string-append
   (symbol->string field)
   ": {\n"
   (apply string-append
          (map (lambda (type)
                 (string-append
                  "  "
                  (symbol->string (car type))
                  " = "
                  (cond
                   ((list? (cdr type))
                    (string-append
                     "{ "
                     (apply string-append
                            (map (lambda (option)
                                   (string-append (symbol->string (car option)) " = " (if (cdr option) "true" "false")))
                                 (cdr type)))
                     " },"))
                   ((string? (cdr type))
                    (string-append "\"" (cdr type) "\";"))
                   ((number? (cdr type))
                    (string-append (number->string (cdr type)) ";")))
                  "\n"))
               value))
   "}\n"))

(define (serialize-boolean field value)
  (string-append (symbol->string field) " = " (if value "true" "false") ";\n"))

(define (serialize-list field value)
  (string-append (symbol->string field) " = [\n"
                 (apply string-append (map (lambda (item)
                                             (string-append "  \"" item "\",\n"))
                                           value))
                 "];\n"))

(define (serialize-number field value)
  (string-append (symbol->string field) " = " (number->string value) ";\n"))

(define (serialize-percentage field value)
  (serialize-number field (/ value 100.0)))

(define (serialize-string field value)
  (string-append (symbol->string field) " = \"" value "\";\n"))

(define (percentage? value)
  (and (number? value)
       (<= 0 value 100)))

(define-configuration home-picom-configuration
  (package
    (package picom)
    "Package to use for setting Picom")
  (backend
   (string "xrender")
   "Specify the backend to use: xrender, glx, or xr_glx_hybrid")
  (glx-no-stencil
   (boolean #f)
   "GLX backend: avoid using stencil buffer, useful if you don’t have a stencil buffer")
  (detect-transient
   (boolean #f)
   "Use WM_TRANSIENT_FOR to group windows, and consider windows in the same group focused at the same time")
  (shadow
   (boolean #f)
   "Enabled client-side shadows on windows")
  (shadow-radius
   (number 12)
   "The blur radius for shadows, in pixels")
  (shadow-opacity
   (percentage 75)
   "The opacity of shadows")
  (shadow-offset-x
   (number -15)
   "The left offset for shadows, in pixels")
  (shadow-offset-y
   (number -15)
   "The top offset for shadows, in pixels")
  (shadow-exclude
   (list '())
   "Specify a list of conditions of windows that should have no shadow")
  (wintypes
   (alist '())
   "Window-type-specific settings")
  (corner-radius
   (number 0)
   "Sets the radius of rounded window corners")
  (inactive-opacity
   (percentage 100)
   "Opacity of inactive windows")
  (active-opacity
   (percentage 100)
   "Default opacity for active windows")
  (frame-opacity
   (percentage 100)
   "Opacity of window titlebars and borders")
  (inactive-opacity-override
   (boolean #f)
   "Let inactive opacity set by -i override the _NET_WM_WINDOW_OPACITY values of windows")
  (blur-background
   (boolean #f)
   "Blur background of semi-transparent / ARGB windows")
  (blur-background-frame
   (boolean #f)
   "Blur background of windows when the window frame is not opaque")
  (blur-background-fixed
   (boolean #f)
   "Use fixed blur strength rather than adjusting according to window opacity")
  (blur
   (alist '())
   "Configure how the window background is blurred")
  (blur-background-exclude
   (list '())
   "Exclude conditions for background blur")
  (focus-exclude
   (list '())
   "Specify a list of conditions of windows that should always be considered focused")
  (fading
   (boolean #f)
   "Fade windows in/out when opening/closing and when opacity changes, unless no-fading-openclose is set")
  (fade-in-step
   (percentage 2.8)
   "Opacity change between steps while fading in")
  (fade-out-step
   (percentage 3)
   "Opacity change between steps while fading out"))

(define (home-picom-config-file config)
  (computed-file
   "picom.conf"
   #~(call-with-output-file #$output
       (lambda (port)
         (display #$(serialize-configuration config home-picom-configuration-fields) port)))))

(define (home-picom-files-service config)
  `(("picom.conf"
     ,(home-picom-config-file config))))

(define (home-picom-profile-service config)
  (list (home-picom-configuration-package config)))

(define (home-picom-shepherd-service config)
  (list
    (shepherd-service
      (documentation "Start Picom")
      (provision '(picom))
      (auto-start? #t)
      (start
       #~(make-forkexec-constructor
          (list #$(file-append (home-picom-configuration-package config) "/bin/picom")
                "--config" #$(home-picom-config-file config))
          #:log-file (format #f "~a/.local/var/log/picom.log" (getenv "HOME"))))
      (stop #~(make-kill-destructor)))))

(define home-picom-service-type
  (service-type (name 'home-picom)
                (extensions
                 (list (service-extension
                        home-xdg-configuration-files-service-type
                        home-picom-files-service)
                       (service-extension
                        home-profile-service-type
                        home-picom-profile-service)
                       (service-extension
                        home-shepherd-service-type
                        home-picom-shepherd-service)))
                (compose concatenate)
                (default-value (home-picom-configuration))
                (description "Configure Picom")))

(define (generate-home-picom-documentation)
  (generate-documentation
   `((home-picom-configuration
      ,home-picom-configuration-fields))
   'home-picom-configuration))