Package: guix-patches;
Reported by: Carmine Margiotta <email <at> cmargiotta.net>
Date: Sat, 29 Mar 2025 06:22:02 UTC
Severity: normal
Tags: patch
View this message in rfc822 format
From: Carmine Margiotta <email <at> cmargiotta.net> To: 77352 <at> debbugs.gnu.org Cc: Carmine Margiotta <email <at> cmargiotta.net> Subject: [bug#77352] [PATCH] home: services: define hyprland home service Date: Sat, 29 Mar 2025 00:25:03 +0100
---
gnu/home/services/hyprland.scm | 490 +++++++++++++++++++++++++++++++++
1 file changed, 490 insertions(+)
create mode 100644 gnu/home/services/hyprland.scm
diff --git a/gnu/home/services/hyprland.scm b/gnu/home/services/hyprland.scm
new file mode 100644
index 0000000000..f024f272d7
--- /dev/null
+++ b/gnu/home/services/hyprland.scm
@@ -0,0 +1,490 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Carmine Margiotta <email <at> cmargiotta.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu home services hyprland)
+ #:use-module (gnu packages wm)
+ #:use-module (guix gexp)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu home services)
+ #:use-module (guix packages)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+
+ #:export (hyprland-extension hyprland-configuration binding monitor
+ home-hyprland-service-type))
+
+;;; Commentary:
+;;;
+;;; A Guix Home service to configure Hyprland, an highly customizabile dynamic tiling Wayland compositor
+;;;
+;;; Code:
+
+;;;
+;;; Helper functions.
+;;;
+
+;; Repeat v n times
+(define (repeat v n)
+ (if (eq? n 0)
+ '()
+ `(,v ,@(repeat v
+ (- n 1)))))
+
+;; Generate an indenter string of n tabs
+(define (indent tabs)
+ (if (<= tabs 0) ""
+ (apply string-append
+ (repeat "\t" tabs))))
+
+(define (flatten lst)
+ (let loop
+ ((lst lst)
+ (acc '()))
+ (cond
+ ((null? lst)
+ acc)
+ ((pair? lst)
+ (loop (car lst)
+ (loop (cdr lst) acc)))
+ (else (cons lst acc)))))
+
+;;;
+;;; Definition of configurations.
+;;;
+
+;; Entry inside a 'block' configuration
+;; allowed formats: (symbol string) (symbol number) (symbol boolean) (symbol block-entries)
+;; A block entry can contain a list of block entries, effectively allowing nested blocks
+(define (block-entry? data)
+ (or (null? data)
+ (match data
+ (((? symbol?)
+ (or (? string?)
+ (? number?)
+ (? boolean?)
+ (? block-entries?)))
+ #t))))
+
+;; List of block entries
+(define (block-entries? data)
+ (every block-entry? data))
+
+;; An executable (a target for the exec action) can be a string or a gexp
+(define (executable? value)
+ (or (string? value)
+ (gexp? value)))
+
+;; A list of valid executables
+(define (executable-list? values)
+ (every executable? values))
+
+;; Block sub-configuration (a container of block entries)
+(define-configuration block
+ (entries (block-entries '()) "Block entries"
+ (serializer (lambda (name value)
+ (serialize-block-entries name value 1)))))
+
+;; Monitor sub-configuration
+(define-configuration monitor
+ (name (string "") "Monitor's name"
+ (serializer (lambda (_ n)
+ (string-append "monitor = " n ", "))))
+ (resolution (string "preferred") "Monitor's resolution"
+ (serializer (lambda (_ n)
+ (string-append n ", "))))
+ (position (string "auto") "Monitor's position"
+ (serializer (lambda (_ n)
+ (string-append n ", "))))
+ (scale (string "1") "Monitor's scale"
+ (serializer (lambda (_ n)
+ n)))
+ (transform (string "") "Monitor's scale"
+ (serializer (lambda (_ n)
+ (if (string-null? n) "\n"
+ (string-append ", transform, " n "\n"))))))
+
+;; List of monitors definition
+(define (monitors? arg)
+ (every monitor? arg))
+
+;; List of strings
+(define (string-list? arg)
+ (every string? arg))
+
+;; Binding sub-configuration
+(define-configuration binding
+ (flags (string "")
+ "Bind flags (https://wiki.hyprland.org/Configuring/Binds/)"
+ (serializer (lambda (_ n)
+ (string-append "bind" n " = "))))
+ (mod (string "$mod") "Mod key"
+ (serializer (lambda (_ n)
+ n)))
+ (shift? (boolean #f) "If mod is shifted"
+ (serializer (lambda (_ n)
+ (string-append (if n " SHIFT" "") ", "))))
+ (key (string) "Binding main key"
+ (serializer (lambda (_ n)
+ (string-append n ", "))))
+ (action (string "exec") "Binding action"
+ (serializer (lambda (_ n)
+ n)))
+ (args (executable "") "Binding action's args"
+ (serializer (lambda (name value)
+ (if (string? value)
+ (if (string-null? value) "\n"
+ (string-append ", " value "\n"))
+ #~(string-append ", "
+ #$(serialize-executable name value)
+ "\n"))))))
+
+;; List of bindings
+(define (binding-list? value)
+ (every binding? value))
+
+;; Optional string
+(define-maybe/no-serialization string)
+
+;; Binding block sub-configuration
+(define-configuration bindings
+ (main-mod (maybe-string "") "Main mod bound to $mod"
+ (serializer (lambda (_ n)
+ (string-append "\n$mod = " n "\n\n"))))
+ (binds (binding-list '()) "Bindings"
+ (serializer (lambda (_ n)
+ #~(string-append #$@(map (lambda (b)
+ (serialize-configuration b
+ binding-fields)) n))))))
+
+;;;
+;;; Serialization functions.
+;;;
+
+(define (serialize-block name block)
+ #~(string-append #$(symbol->string name) " {\n"
+ #$(if (null? block) ""
+ (serialize-configuration block block-fields)) "\n}\n"))
+
+;; A block entry will be serialized as an indented hyprlang
+;; statement, nested blocks are allowed
+(define (serialize-block-entry value tabs)
+ (string-append (or (match value
+ (() "")
+ (((? symbol? name)
+ value)
+ (string-append (indent tabs)
+ (symbol->string name)
+ (match value
+ ((? string? v)
+ (string-append " = " v))
+ ((? number? v)
+ (string-append " = "
+ (number->string v)))
+ ((? boolean? v)
+ (if v " = true" " = false"))
+ ((? block-entries? v)
+ (string-append " {\n"
+ (serialize-block-entries
+ #f v
+ (+ tabs 1))
+ (indent tabs) "}")))
+ "\n"))
+ ((_)
+ #f)) "\n")))
+
+;; String lists will be serialized as name = value\n
+(define (serialize-string-list name values)
+ (apply string-append
+ (map (lambda (w)
+ (string-append (symbol->string name) " = " w "\n")) values)))
+
+;; Gexp executables will be serialized on a program-file
+(define (serialize-executable name value)
+ (if (string? value) value
+ (program-file (symbol->string name) value
+ #:module-path %load-path)))
+
+;; Lists serializers
+(define (serialize-block-entries _ entries level)
+ (apply string-append
+ (map (lambda (e)
+ (serialize-block-entry e level)) entries)))
+
+(define (serialize-monitors _ monitors)
+ #~(string-append #$@(map (lambda (m)
+ (serialize-configuration m monitor-fields))
+ monitors)))
+
+(define (serialize-executable-list name values)
+ #~(apply string-append
+ (map (lambda (w)
+ (string-append #$(symbol->string name) " = " w "\n"))
+ '#$(map (lambda (v)
+ (serialize-executable name v)) values))))
+
+;; Hyprland full configuration
+(define-configuration hyprland-configuration
+ (package
+ (package
+ hyprland) "Hyprland package to use"
+ (serializer (λ (_ n) "")))
+ (monitors (monitors (list (monitor))) "Monitors definition")
+ (exec-once (executable-list '()) "Command to exec once")
+ (exec (executable-list '()) "Command to automatically exec")
+ (general (block (block)) "General configuration variables")
+ (decoration (block (block)) "Decoration configuration variables")
+ (animations (block (block)) "Animation configuration variables")
+ (workspace (string-list '()) "Workspaces settings")
+ (windowrule (string-list '()) "Window rules (v2)")
+ (dwindle (block (block)) "Dwindle layout settings")
+ (master (block (block)) "Master layout settings")
+ (misc (block (block)) "Misc settings")
+ (input (block (block)) "Input settings")
+ (gestures (block (block)) "Gestures settings")
+ (bindings (bindings (bindings)) "Bindings configuration"
+ (serializer (λ (_ n)
+ (serialize-configuration n bindings-fields))))
+ (extra-config (string "") "Extra config"
+ (serializer (λ (_ n)
+ (string-append n "\n")))))
+
+;; Hyprland configuration extension for other services
+;; External services can add new exec entries or new bindings
+(define-configuration hyprland-extension
+ (exec-once (executable-list '())
+ "Commands to be executed with hyprland once")
+ (exec (executable-list '()) "Commands to be executed with hyprland")
+ (bindings (binding-list '()) "Extra binds")
+ (no-serialization))
+
+;;;
+;;; Default settings and useful constants.
+;;;
+(define-public %default-hyprland-general
+ (block (entries '((gaps_in 5)
+ (gaps_out 20)
+ (border_size 2)
+ (col.active_border "rgba(33ccffee) rgba(00ff99ee) 45deg")
+ (col.inactive_border "rgba(595959aa)")
+ (resize_on_border #f)
+ (allow_tearing #f)
+ (layout "dwindle")))))
+
+(define-public %default-hyprland-decoration
+ (block (entries '((rounding 10)
+ (rounding_power 2)
+ (active_opacity 1.0)
+ (inactive_opacity 0.9)
+ (dim_inactive #t)
+ (dim_strength 0.05)
+
+ (shadow ((enabled #t)
+ (range 4)
+ (render_power 3)
+ (color "rgba(1a1a1aee)")))
+ (blur ((enabled #t)
+ (size 3)
+ (passes 1)
+ (vibrancy 0.1696)))))))
+
+(define-public %default-hyprland-animations
+ (block (entries '((enabled #t)
+ (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")))))
+
+(define-public %default-hyprland-workspace
+ '("w[tv1], gapsout:0, gapsin:0" "f[1], gapsout:0, gapsin:0"))
+
+(define-public %default-hyprland-windowrule
+ '("bordersize 0, floating:0, onworkspace:w[tv1]"
+ "rounding 0, floating:0, onworkspace:w[tv1]"
+ "bordersize 0, floating:0, onworkspace:f[1]"
+ "rounding 0, floating:0, onworkspace:f[1]"))
+
+(define-public %default-hyprland-misc
+ (block (entries '((force_default_wallpaper -1)
+ (disable_hyprland_logo #f)
+ (enable_swallow #t)
+ (vrr 2)))))
+
+(define-public %default-hyprland-gestures
+ (block (entries '((workspace_swipe #t)))))
+
+(define-public %default-hyprland-bindings
+ (bindings (main-mod "SUPER")
+ (binds `(,(binding (key "Q")
+ (action "killactive")) ,(binding (shift? #t)
+ (key "F")
+ (action
+ "togglefloating"))
+ ,(binding (key "F")
+ (action "fullscreen"))
+ ,(binding (shift? #t)
+ (key "R")
+ (action "exec")
+ (args "hyprctl reload"))
+ ;; Dwindle layout
+ ,(binding (key "P")
+ (action "pseudo"))
+ ,(binding (key "J")
+ (action "togglesplit"))
+ ;; Move focus with arrow keys
+ ,(binding (key "left")
+ (action "movefocus")
+ (args "l"))
+ ,(binding (key "right")
+ (action "movefocus")
+ (args "r"))
+ ,(binding (key "up")
+ (action "movefocus")
+ (args "u"))
+ ,(binding (key "down")
+ (action "movefocus")
+ (args "d"))
+ ;; Switch workspaces
+ ,@(map (lambda (index)
+ (binding (key (number->string index))
+ (action "workspace")
+ (args (number->string index))))
+ (iota 10))
+ ;; Move active window to workspace
+ ,@(map (lambda (index)
+ (binding (shift? #t)
+ (key (number->string index))
+ (action "movetoworkspace")
+ (args (number->string index))))
+ (iota 10))
+ ;; Move/resize with mouse
+ ,(binding (flags "m")
+ (key "mouse:272")
+ (action "movewindow"))
+ ,(binding (flags "m")
+ (key "mouse:273")
+ (action "resizewindow"))
+ ,(binding (key "R")
+ (action "submap")
+ (args "resize"))))))
+
+(define-public %hyprland-resize-submap
+ "submap = resize
+binde = ,right, resizeactive, 10 0
+binde = ,left, resizeactive, -10 0
+binde = ,up, resizeactive, 0 -10
+binde = ,down, resizeactive, 0 10
+bind = ,escape, submap, reset
+submap = reset
+")
+
+(define-public %default-hyprland-configuration
+ (hyprland-configuration (general %default-hyprland-general)
+ (decoration %default-hyprland-decoration)
+ (animations %default-hyprland-animations)
+ (workspace %default-hyprland-workspace)
+ (windowrule %default-hyprland-windowrule)
+ (misc %default-hyprland-misc)
+ (gestures %default-hyprland-gestures)
+ (bindings %default-hyprland-bindings)
+ (extra-config %hyprland-resize-submap)))
+
+;;;
+;;; Useful scripts
+;;;
+
+;; Reload the first instance of hyprland, to
+;; automatically load the new configuration
+(define (hyprland-reload config)
+ #~(begin
+ (display "Reloading hyprland configuration...")
+ (system* #$(file-append (hyprland-configuration-package config)
+ "/bin/hyprctl") "--instance" "0" "reload")))
+
+;;;
+;;; Definition of the Home Service.
+;;;
+
+(define-public home-hyprland-service-type
+ (service-type (name 'home-hyprland-config)
+ (description "Configure Sway by providing a file
+@file{~/.config/hypr/hyprland.conf}.")
+ (compose (λ (extensions)
+ (hyprland-extension (exec-once (flatten (map
+ hyprland-extension-exec-once
+ extensions)))
+ (exec (flatten (map
+ hyprland-extension-exec
+ extensions)))
+ (bindings (flatten (map
+ hyprland-extension-bindings
+ extensions))))))
+ (extend (λ (config rules)
+ (hyprland-configuration (inherit config)
+ (exec-once (append (hyprland-configuration-exec-once
+ config)
+ (hyprland-extension-exec-once
+ rules)))
+ (exec (append (hyprland-configuration-exec
+ config)
+ (hyprland-extension-exec
+ rules)))
+ (bindings (bindings (inherit
+ (hyprland-configuration-bindings
+ config))
+ (binds (append
+ (bindings-binds
+ (hyprland-configuration-bindings
+ config))
+
+ (hyprland-extension-bindings
+ rules))))))))
+ (extensions (list (service-extension
+ home-activation-service-type
+ ;; Trigger hyprctl reload after a new config has been applied
+ hyprland-reload)
+ (service-extension home-profile-service-type
+ (λ (config)
+ `(,(hyprland-configuration-package
+ config))))
+ (service-extension
+ home-xdg-configuration-files-service-type
+ (λ (c)
+ `(("hypr/hyprland.conf" ,(mixed-text-file
+ "hyprland-cfg"
+ (serialize-configuration
+ c
+ hyprland-configuration-fields))))))))
+ (default-value %default-hyprland-configuration)))
base-commit: b282b5ecd90da5dc3a034e7064ac41808f7f6c24
--
2.49.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.