Package: guix-patches;
Reported by: Carmine Margiotta <email <at> cmargiotta.net>
Date: Sat, 29 Mar 2025 06:22:01 UTC
Severity: normal
Tags: patch
Done: Carmine Margiotta <email <at> cmargiotta.net>
Bug is archived. No further changes may be made.
Message #10 received at 77351-done <at> debbugs.gnu.org (full text, mbox):
From: Carmine Margiotta <email <at> cmargiotta.net> To: 77351-done <at> debbugs.gnu.org Cc: Carmine Margiotta <email <at> cmargiotta.net> Subject: Re: [PATCH] home: services: define hyprland home service Date: Sun, 30 Mar 2025 21:20:27 +0200
> ---
> 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 block 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)))
> --
> 2.49.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.