path: root/sigils/home/services/hyprland.scm

(define-module (sigils home services hyprland)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (gnu home services)
  #:use-module (gnu home services shepherd)
  #:use-module (gnu services configuration)
  #:use-module (sigils packages hyprland)

  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)

  #:export (hypr-config?

            %default-hyprland-config

            home-hyprland-configuration
            home-hyprland-service-type

            home-hyprpaper-configuration
            home-hyprpaper-service-type

            home-hyprlock-configuration
            home-hyprlock-service-type

            home-hypridle-configuration
            home-hypridle-service-type))

(define hypr-config? list?)

(define (serialize-hypr-config var)
  (define (align nestness)
    (apply string-append
           (map (const "    ") (iota nestness))))

  (define (serialize-term term)
    (match term
      (('rgba color) (list (format #f "rgba(~a)" (symbol->string color))))
      (('rgb color) (list (format #f "rgb(~a)" (symbol->string color))))
      ;; I'd say it's not the most elegant way.
      (('rgba r g b a) (list (format #f "rgba(~a, ~a, ~a, ~a)" r g b a)))
      (('rgb r g b) (list (format #f "rgb(~a, ~a, ~a)" r g b)))

      ((e lst ...)
       (append
        (serialize-term e)
        (append-map (lambda (n)
                      `(" " ,@(serialize-term n)))
                    lst)))
      (single
       `(,(match single
            (#t "true")
            (#f "false")
            ((? symbol? e) (symbol->string e))
            ((? number? e) (number->string e))
            ((? string? e) e)
            (() "")
            (e e))))))

  (define* (serialize-config
            config #:optional (nestness 0))
    (match config
      ((term ((expressions ...) ...))
       `(,(align nestness) ,@(serialize-term term) " {\n"
         ,@(append-map (lambda (e)
                         (serialize-config e (1+ nestness)))
                       expressions)
         ,(align nestness) "}\n"))

      ((term r . est)
       `(,(align nestness)
         ,@(serialize-term term)
         " = "
         ,@(serialize-term r)
         ,@(append-map
            (lambda (t)
              `(", " ,@(serialize-term t)))
            est)
         "\n"))

      ((term . rterm)
       `(,(align nestness)
         ,@(serialize-term term)
         " = "
         ,@(serialize-term rterm)
         "\n"))))

  (append-map serialize-config var))

;;; Hyprland

(define %default-hyprland-config
  '((autogenerated 0)
    ;; monitors
    (monitor () preferred auto auto)
    ;; vars
    ($terminal kitty)
    ($fileManager dolphin)
    ($menu (wofi --show drun))
    (env XCURSOR_SIZE 24)
    (env HYPRCURSOR_SIZE 24)
    ($mainMod SUPER)
    ;; general
    (general ((gaps_in 5)
              (gaps_out 20)
              (border_size 2)
              (col.active_border ((rgba 33ccffee) (rgba 00ff99ee) 45deg))
              (col.inactive_border (rgba 595959aa)) ;; Ugly trick
              (resize_on_border #f)
              (allow_tearing #f)
              (layout dwindle)))
    ;; decoration
    (decoration ((rounding 10)
                 (active_opacity 1.0)
                 (inactive_opacity 1.0)
                 (shadow ((enabled #t)
                          (range 4)
                          (render_power 3)
                          (color (rgba 1a1a1aee))))
                 (blur ((enabled #t)
                        (size 3)
                        (passes 1)
                        (vibrancy 0.1696)))))
    ;; animations
    (animations ((enabled "yes, please :)")
                 (bezier easeOutQuint 0.23.1 0.32 1)
                 (bezier easeInOutCubic 0.65 0.05 0.36 1)
                 (bezier linear 0 0 1 1)
                 (bezier almostLinear 0.5 0.5 0.75 1.0)
                 (bezier quick 0.15 0 0.1 1)

                 (animation global 1 10 default)
                 (animation border 1 5.39 easeOutQuint)
                 (animation windows 1 4.79 easeOutQuint)
                 (animation windowsIn 1 4.1 easeOutQuint (popin 87%))
                 (animation windowsOut 1 1.49 linear (popin 87%))
                 (animation fadeIn 1 1.73 almostLinear)
                 (animation fadeOut 1 1.46 almostLinear)
                 (animation fade 1 3.03 quick)
                 (animation layers 1 3.81 easeOutQuint)
                 (animation layersIn 1 4 easeOutQuint fade)
                 (animation layersOut 1 1.5 linear fade)
                 (animation fadeLayersIn 1 1.79 almostLinear)
                 (animation fadeLayersOut 1 1.39 almostLinear)
                 (animation workspaces 1 1.94 almostLinear fade)
                 (animation workspacesIn 1 1.21 almostLinear fade)
                 (animation workspacesOut 1 1.94 almostLinear fade)))
    ;; dwindle
    (dwindle ((pseudotile #t)
              (preserve_split #t)))
    ;; master
    (master ((new_status master)))
    ;; misc
    (misc ((force_default_wallpaper -1)
           (disable_hyprland_logo #f)))
    ;; input
    (input ((kb_layout us)
            (kb_variant)
            (kb_model)
            (kb_options)
            (kb_rules)
            (follow_mouse 1)
            (sensitivity 0)
            (touchpad ((natural_scroll #f)))))
    ;; gestures
    (gestures ((workspace_swipe #f)))
    ;; device
    (device ((name epic-mouse-v1)
             (sensitivity -0.5)))
    ;; binds
    (bind $mainMod Q exec $terminal)
    (bind $mainMod C killactive ())
    (bind $mainMod M exit ())
    (bind $mainMod E exec $fileManager)
    (bind $mainMod V togglefloating ())
    (bind $mainMod R exec $menu)
    (bind $mainMod P pseudo ())
    (bind $mainMod J togglesplit ())
    (bind $mainMod left movefocus l)
    (bind $mainMod right movefocus r)
    (bind $mainMod up movefocus u)
    (bind $mainMod down movefocus d)
    (bind $mainMod 1 workspace 1)
    (bind $mainMod 2 workspace 2)
    (bind $mainMod 3 workspace 3)
    (bind $mainMod 4 workspace 4)
    (bind $mainMod 5 workspace 5)
    (bind $mainMod 6 workspace 6)
    (bind $mainMod 7 workspace 7)
    (bind $mainMod 8 workspace 8)
    (bind $mainMod 9 workspace 9)
    (bind $mainMod 0 workspace 10)
    (bind ($mainMod SHIFT) 1 movetoworkspace 1)
    (bind ($mainMod SHIFT) 2 movetoworkspace 2)
    (bind ($mainMod SHIFT) 3 movetoworkspace 3)
    (bind ($mainMod SHIFT) 4 movetoworkspace 4)
    (bind ($mainMod SHIFT) 5 movetoworkspace 5)
    (bind ($mainMod SHIFT) 6 movetoworkspace 6)
    (bind ($mainMod SHIFT) 7 movetoworkspace 7)
    (bind ($mainMod SHIFT) 8 movetoworkspace 8)
    (bind ($mainMod SHIFT) 9 movetoworkspace 9)
    (bind ($mainMod SHIFT) 0 movetoworkspace 10)
    (bind $mainMod S togglespecialworkspace magic)
    (bind ($mainMod SHIFT) S movetoworkspace special:magic)
    (bind $mainMod mouse_down workspace e+1)
    (bind $mainMod mouse_up workspace e-1)
    (bindm $mainMod mouse:272 movewindow)
    (bindm $mainMod mouse:273 resizewindow)
    (bindel () XF86AudioRaiseVolume exec (wpctl set-volume -l 1 @DEFAULT_AUDIO_SINK@ 5%+))
    (bindel () XF86AudioLowerVolume exec (wpctl set-volume @DEFAULT_AUDIO_SINK@ 5%-))
    (bindel () XF86AudioMute exec (wpctl set-mute @DEFAULT_AUDIO_SINK@ toggle))
    (bindel () XF86AudioMicMute exec (wpctl set-mute @DEFAULT_AUDIO_SOURCE@ toggle))
    (bindel () XF86MonBrightnessUp exec (brightnessctl s 10%+))
    (bindel () XF86MonBrightnessDown exec (brightnessctl s 10%-))
    (bindl () XF86AudioNext exec (playerctl next))
    (bindl () XF86AudioPause exec (playerctl play-pause))
    (bindl () XF86AudioPlay exec (playerctl play-pause))
    (bindl () XF86AudioPrev exec (playerctl previous))
    ;; windowrules
    (windowrulev2 (suppressevent maximize) class:.*)
    (windowrulev2 nofocus class:^$ title:^$ xwayland:1 floating:1 fullscreen:0 pinned:0)))

(define-configuration/no-serialization home-hyprland-configuration
  (plugins
   (list-of-packages '())
   "Additional plugins to load with Hyprland.")
  (config
   (hypr-config %default-hyprland-config)
   "Hyprland configuration")
  (tries
   (number 15)
   "Polls Hyprland up to TRIES."))

(define (hyprland-configuration->file config)
  `(("hypr/hyprland.conf"
     ,(apply
       mixed-text-file "hyprland-config"
       `(,@(append-map
            (lambda (plugin)
              `("plugin = " ,plugin "/lib/lib" ,(package-name plugin) ".so\n"))
            (home-hyprland-configuration-plugins config))
         ,@(serialize-hypr-config
            (home-hyprland-configuration-config config)))))))

(define hyprctl-reload-gexp
  #~(begin
      (system* (string-append #+hyprland "/bin/hyprctl") "reload")))

(define (hyprland-shepherd-service config)
  (list (shepherd-service
         (provision '(hyprland
                      wayland-display))
         (modules '((ice-9 ftw)
                    (ice-9 regex)
                    (ice-9 match)
                    (srfi srfi-1)
                    (shepherd support)))
         (respawn? #t)
         (respawn-limit (home-hyprland-configuration-tries config))
         (respawn-delay 1)
         (start
          #~(lambda* (#:optional
                      (env-hyprland-instance (getenv "HYPRLAND_INSTANCE_SIGNATURE"))
                      (env-wayland-display (getenv "WAYLAND_DISPLAY")))

              (define hypr-directory
                (string-append %user-runtime-dir "/hypr"))

              (define (socket? directory regex)
                (find (match-lambda
                        ((or "." "..") #f)
                        (name
                         (let ((name (in-vicinity directory
                                                  name)))
                           (and (string-match regex name)
                                (access? name O_RDWR)))))
                      (or (scandir directory) '())))

              (define hyprland-instance
                (or env-hyprland-instance
                    (socket? hypr-directory "_[0-9]+_[0-9]+")))

              (define wayland-display
                (or env-wayland-display
                    (socket? %user-runtime-dir "wayland-[0-9]+")))

              (let ((found? (and wayland-display hyprland-instance)))
                (when found?
                  (format #t "Hyprland instance found at ~s \
with wayland display ~s.~%" hyprland-instance wayland-display)
                  ;; Note: 'make-forkexec-constructor' calls take their
                  ;; default #:environment-variables value before this service
                  ;; is started and are thus unaffected by the 'setenv' call
                  ;; below.  Users of this service have to explicitly query
                  ;; its value.
                  (setenv "HYPRLAND_INSTANCE_SIGNATURE" hyprland-instance)
                  (setenv "WAYLAND_DISPLAY" wayland-display))
                found?)))
         (stop #~(lambda (_)
                   (unsetenv "HYPRLAND_INSTANCE_SIGNATURE")
                   (unsetenv "WAYLAND_DISPLAY")
                   #f)))))


(define home-hyprland-service-type
  (service-type
   (name 'home-hyprland)
   (extensions
    (list (service-extension
           home-xdg-configuration-files-service-type
           hyprland-configuration->file)
          (service-extension
           home-activation-service-type
           (const hyprctl-reload-gexp))
          (service-extension
           home-shepherd-service-type
           hyprland-shepherd-service)))
   (compose identity)
   (default-value (home-hyprland-configuration))
   (description "Configure Hyprland by providing @file{~/.config/hypr/hyprland.conf}")))

;;; Hyprpaper

(define-configuration/no-serialization home-hyprpaper-configuration
  (hyprpaper
   (file-like hyprpaper)
   "The hyprpaper package to use.")
  (config
   (hypr-config '())
   "Hyprpaper configuration"))

(define (hyprpaper-configuration->file config)
  `(("hypr/hyprpaper.conf"
     ,(apply mixed-text-file
             "hyprpaper-config"
             (serialize-hypr-config
              (home-hyprpaper-configuration-config config))))))

(define home-hyprpaper-service-type
  (service-type
   (name 'home-hyprpaper)
   (extensions
    (list (service-extension
           home-xdg-configuration-files-service-type
           hyprpaper-configuration->file)
          (service-extension
           home-profile-service-type
           (lambda (config)
             (list (home-hyprpaper-configuration-hyprpaper config))))))
   (compose identity)
   (default-value (home-hyprpaper-configuration))
   (description "Configure Hyprpaper by providing @file{~/.config/hypr/hyprpaper.conf}.")))

;;; Hyprlock

(define-configuration/no-serialization home-hyprlock-configuration
  (hyprlock
   (file-like hyprlock)
   "The hyprlock package to use.")
  (config
   (hypr-config '())
   "Hyprlock configuration"))

(define (hyprlock-configuration->file config)
  `(("hypr/hyprlock.conf"
     ,(apply mixed-text-file
             "hyprlock-config"
             (serialize-hypr-config
              (home-hyprlock-configuration-config config))))))

(define home-hyprlock-service-type
  (service-type
   (name 'home-hyprlock)
   (extensions
    (list (service-extension
           home-xdg-configuration-files-service-type
           hyprlock-configuration->file)
          (service-extension
           home-profile-service-type
           (lambda (config)
             (list (home-hyprlock-configuration-hyprlock config))))))
   (compose identity)
   (default-value (home-hyprlock-configuration))
   (description "Configure Hyprlock by providing @file{~/.config/hypr/hyprlock.conf}.")))

;;; Hypridle

(define-configuration/no-serialization home-hypridle-configuration
  (hypridle
   (file-like hypridle)
   "The hypridle package to use.")
  (config
   (hypr-config '())
   "Hypridle configuration"))

(define (hypridle-configuration->file config)
  `(("hypr/hypridle.conf"
     ,(apply mixed-text-file
             "hypridle-config"
             (serialize-hypr-config
              (home-hypridle-configuration-config config))))))

(define (home-hypridle-shepherd-service config)
  (shepherd-service
   (documentation "Hypridle daemon")
   (provision '(hypridle))
   (requirement '(dbus))
   (start #~(make-forkexec-constructor
             (list #$(file-append
                      (home-hypridle-configuration-hypridle config)
                      "/bin/hypridle"))))
   (stop #~(make-kill-destructor))))

(define home-hypridle-service-type
  (service-type
   (name 'home-hypridle)
   (extensions
    (list (service-extension
           home-xdg-configuration-files-service-type
           hypridle-configuration->file)
          ;; (service-extension
          ;;  home-shepherd-service-type
          ;;  (lambda (config)
          ;;    (list (home-hypridle-shepherd-service config))))
          (service-extension
           home-profile-service-type
           (lambda (config)
             (list (home-hypridle-configuration-hypridle config))))))
   (compose identity)
   (default-value (home-hypridle-configuration))
   (description "Configure Hypridle by providing @file{~/.config/hypr/hypridle.conf} and start the service.")))