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
  '(($terminal kitty)
    ($fileManager dolphin)
    ($menu (wofi --show drun))
    ($mainMod SUPER)
    ;; autogenerated
    (autogenerated 0)
    ;; monitors
    (monitor () preferred auto auto)
    ;; 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)
                 (drop_shadow #t)
                 (shadow_range 4)
                 (shadow_render_power 3)
                 (col.shadow (rgba 1a1a1aee))
                 (blur ((enabled #t)
                        (size 3)
                        (passes 1)
                        (vibrancy 0.1696)))))
    ;; animations
    (animations ((enabled #t)
                 (bezier myBezier 0.05 0.9 0.1 1.05)
                 (animation windows 1 7 myBezier)
                 (animation windowsOut 1 7 default (popin 80%))
                 (animation border 1 10 default)
                 (animation borderangle 1 8 default)
                 (animation fade 1 7 default)
                 (animation workspaces 1 6 default)))
    ;; 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 @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"))

(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 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))))
   (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.")))