[bug#58585,2/2] gnu: home: Add home-mako-service-type.

* gnu/home/services/desktop.scm (home-mako-section,
  home-mako-configuration): New record types.
(%home-mako-default-section, %home-mako-default-grouped-section,
home-mako-service-type): New variables.

Unfortunately, there is no way to actually use this service to
run the daemon itself, as Mako tries to connect to Wayland, which
is impossible as WAYLAND_DISPLAY is almost never set in session
Shepherd's environment. So, this service simply writes the
configuration file to $XDG_CONFIG_HOME/mako/config, and leave the
actual execution of ``mako'' to the user.
---
 gnu/home/services/desktop.scm | 338 +++++++++++++++++++++++++++++++++-
 1 file changed, 336 insertions(+), 2 deletions(-)

On 2022-10-17 17:47, "\( via Guix-patches" via wrote:

> * gnu/home/services/desktop.scm (home-mako-section,
>   home-mako-configuration): New record types.
> (%home-mako-default-section, %home-mako-default-grouped-section,
> home-mako-service-type): New variables.
>
> Unfortunately, there is no way to actually use this service to
> run the daemon itself, as Mako tries to connect to Wayland, which
> is impossible as WAYLAND_DISPLAY is almost never set in session
> Shepherd's environment. So, this service simply writes the
> configuration file to $XDG_CONFIG_HOME/mako/config, and leave the
> actual execution of ``mako'' to the user.

After recent updates to shepherd service
https://git.savannah.gnu.org/cgit/guix.git/commit/?id=70d58d1556
https://git.savannah.gnu.org/cgit/guix.git/commit/?id=6cdde65bb5

it's now possible to start shepherd manually.

In rde we start shepherd by sway, so it inherits all wayland related
variables.

https://git.sr.ht/~abcdw/rde/tree/101313a691/rde/features/wm.scm#L137

It's not a perfect solution, but good enough.

> ---
>  gnu/home/services/desktop.scm | 338 +++++++++++++++++++++++++++++++++-
>  1 file changed, 336 insertions(+), 2 deletions(-)
>
> diff --git a/gnu/home/services/desktop.scm b/gnu/home/services/desktop.scm
> index a2ab2b4d07..a929a7533a 100644
> --- a/gnu/home/services/desktop.scm
> +++ b/gnu/home/services/desktop.scm
> @@ -22,17 +22,26 @@ (define-module (gnu home services desktop)
>    #:use-module (gnu home services shepherd)
>    #:use-module (gnu services configuration)
>    #:autoload   (gnu packages glib)    (dbus)
> +  #:autoload   (gnu packages wm)      (mako)
>    #:autoload   (gnu packages xdisorg) (redshift)
> -  #:use-module (guix records)
>    #:use-module (guix gexp)
> +  #:use-module (guix records)
>    #:use-module (srfi srfi-1)
> +  #:use-module (srfi srfi-26)
> +  #:use-module (ice-9 format)
>    #:use-module (ice-9 match)
>    #:export (home-redshift-configuration
>              home-redshift-configuration?
>              home-redshift-service-type
>  
>              home-dbus-configuration
> -            home-dbus-service-type))
> +            home-dbus-service-type
> +
> +            home-mako-section
> +            %home-mako-default-section
> +            %home-mako-default-grouped-section
> +            home-mako-configuration
> +            home-mako-service-type))
>  
>  
>  ;;;
> @@ -224,3 +233,328 @@ (define home-dbus-service-type
>     (default-value (home-dbus-configuration))
>     (description
>      "Run the session-specific D-Bus inter-process message bus.")))
> +
> +
> +;;;
> +;;; Mako.
> +;;;
> +
> +(define-record-type* <home-mako-section>
> +  home-mako-section make-home-mako-section
> +  home-mako-section?
> +
> +  (if-app-name home-mako-if-app-name            ;string | #f
> +               (default #f))
> +  (if-app-icon home-mako-if-app-icon             ;string | #f
> +               (default #f))
> +  (if-summary home-mako-if-summary               ;string | #f
> +              (default #f))
> +  (if-summary-regex? home-mako-if-summary-regex? ;boolean
> +                     (default #f))
> +  (if-body home-mako-if-body                     ;string | #f
> +           (default #f))
> +  (if-body-regex? home-mako-if-body-regex?       ;boolean
> +                  (default #f))
> +  (if-urgency home-mako-if-urgency               ;'low | 'normal | 'critical | #f
> +              (default #f))
> +  (if-category home-mako-if-category             ;string | #f
> +               (default #f))
> +  (if-desktop-entry home-mako-if-desktop-entry   ;string | #f
> +                    (default #f))
> +  (if-actionable? home-mako-if-actionable?       ;boolean | '()
> +                  (default '()))
> +  (if-expiring? home-mako-if-expiring?           ;boolean | '()
> +                (default '()))
> +  (if-mode home-mako-if-mode                     ;string | #f
> +           (default #f))
> +  (if-grouped? home-mako-if-grouped?             ;boolean | '()
> +               (default '()))
> +  (if-group-index home-mako-if-group-index       ;integer | #f
> +                  (default #f))
> +  (if-hidden? home-mako-if-hidden?               ;boolean | '()
> +              (default '()))
> +  (if-output home-mako-if-output                 ;string | #f
> +             (default #f))
> +  (if-anchor home-mako-if-anchor                 ;'top-right | 'top-center | 'top-left | 'bottom-right | 'bottom-center | 'bottom-left | 'center-right | 'center-left | 'center | #f
> +             (default #f))
> +
> +  (on-button-left home-mako-on-button-left       ;#f | 'default | 'dismiss | 'dismiss-all | 'dismiss-group | list of (file-like | string)
> +                  (default 'default))
> +  (on-button-middle home-mako-on-button-middle   ;#f | 'default | 'dismiss | 'dismiss-all | 'dismiss-group | string | list of (file-like | string)
> +                    (default #f))
> +  (on-button-right home-mako-on-button-right     ;#f | 'default | 'dismiss | 'dismiss-all | 'dismiss-group | list of (file-like | string)
> +                   (default 'dismiss))
> +  (on-touch home-mako-on-touch                   ;#f | 'default | 'dismiss | 'dismiss-all | 'dismiss-group | list of (file-like | string)
> +            (default 'dismiss))
> +  (on-notify home-mako-on-notify                 ;#f | 'default | 'dismiss | 'dismiss-all | 'dismiss-group | list of (file-like | string)
> +             (default #f))
> +
> +  (font home-mako-font                           ;string
> +        (default "monospace"))
> +  (font-size home-mako-font-size                 ;number
> +             (default 10))
> +
> +  (background-color home-mako-background-color   ;string
> +                    (default "285577FF"))
> +  (text-color home-mako-text-color               ;string
> +              (default "FFFFFFFF"))
> +
> +  (width home-mako-width                         ;integer
> +         (default 300))
> +  (height home-mako-height                       ;integer
> +          (default 100))
> +  (outer-margin home-mako-outer-margin           ;list of integer
> +                (default '(0)))
> +  (margin home-mako-margin                       ;list of integer
> +          (default '(10)))
> +  (padding home-mako-padding                     ;list of integer
> +           (default '(5)))
> +
> +  (border-size home-mako-border-size             ;integer
> +               (default 2))
> +  (border-color home-mako-border-color           ;string
> +                (default "4C7899FF"))
> +  (border-radius home-mako-border-radius         ;integer
> +                 (default 0))
> +
> +  (progress-color home-mako-progress-color       ;string
> +                  (default "5588AAFF"))
> +  (progress-style home-mako-progress-style       ;'over | 'source
> +                  (default 'over))
> +
> +  (icons? home-mako-icons?                       ;boolean
> +          (default #t))
> +  (max-icon-size home-mako-max-icon-size         ;integer
> +                 (default 64))
> +  (icon-path home-mako-icon-path                 ;list of string
> +             (default '()))
> +  (icon-location home-mako-icon-location         ;'left | 'right | 'top | 'bottom
> +                 (default 'left))
> +
> +  (markup? home-mako-markup?                     ;boolean
> +           (default #t))
> +  (actions? home-mako-actions?                   ;boolean
> +            (default #t))
> +  (history? home-mako-history?                   ;boolean
> +            (default #t))
> +  (invisible? home-mako-invisible?               ;boolean
> +              (default #f))
> +
> +  (format home-mako-format
> +          (default "<b>%s</b>\\n%b"))
> +  (text-alignment home-mako-text-alignment       ;'left | 'center | 'right
> +                  (default 'left))
> +
> +  (default-timeout home-mako-default-timeout     ;integer
> +                   (default 0))
> +  (ignore-timeout? home-mako-ignore-timeout?     ;boolean
> +                   (default #f))
> +
> +  (group-by home-mako-group-by                   ;list of string
> +            (default #f))
> +  (max-visible home-mako-max-visible             ;integer
> +               (default #f))
> +
> +  (output home-mako-output                       ;string
> +          (default #f))
> +  (layer home-mako-layer                         ;'background | 'bottom | 'top | 'overlay
> +         (default 'top))
> +  (anchor home-mako-anchor                       ;'top-right | 'top-center | 'top-left | 'bottom-right | 'bottom-center | 'bottom-left | 'center-right | 'center-left | 'center
> +          (default #f)))
> +
> +(define (home-mako-configuration-header-attributes section)
> +  (define (boolean-clause name field)
> +    (let ((value (field section)))
> +      (cond ((null? value) '())
> +            (value (list "!" name " "))
> +            (else (list name)))))
> +
> +  (define (string-clause name field)
> +    (let ((value (field section)))
> +      (if value
> +          (list name "=\"" value "\" ")
> +          '())))
> +
> +  (define (symbol-clause name field)
> +    (if (field section)
> +        (string-clause name (compose symbol->string field))
> +        '()))
> +
> +  (define (number-clause name field)
> +    (if (field section)
> +        (string-clause name (compose number->string field))
> +        '()))
> +
> +  (append (string-clause "app-name" home-mako-if-app-name)
> +          (string-clause "app-icon" home-mako-if-app-icon)
> +          (string-clause (if (home-mako-if-summary-regex? section)
> +                             "summary~"
> +                             "summary")
> +                         home-mako-if-summary)
> +          (string-clause (if (home-mako-if-body-regex? section)
> +                             "body~"
> +                             "body")
> +                         home-mako-if-body)
> +          (symbol-clause "urgency" home-mako-if-urgency)
> +          (string-clause "category" home-mako-if-category)
> +          (string-clause "desktop-entry" home-mako-if-desktop-entry)
> +          (boolean-clause "actionable" home-mako-if-actionable?)
> +          (boolean-clause "expiring" home-mako-if-expiring?)
> +          (string-clause "mode" home-mako-if-mode)
> +          (boolean-clause "grouped" home-mako-if-grouped?)
> +          (number-clause "group-index" home-mako-if-group-index)
> +          (boolean-clause "hidden" home-mako-if-hidden?)
> +          (string-clause "output" home-mako-if-output)
> +          (symbol-clause "anchor" home-mako-if-anchor)))
> +
> +(define (home-mako-configuration-header section)
> +  (match (home-mako-configuration-header-attributes section)
> +    (() '())
> +    ((attributes ...)
> +     (append (list "\n[ ") attributes (list "]\n")))))
> +
> +(define (home-mako-configuration-body section)
> +  (define (string-clause name field)
> +    (let ((value (field section)))
> +      (if value
> +          (list name "=" (field section) "\n")
> +          '())))
> +
> +  (define (boolean-clause name field)
> +    (list name "=" (if (field section) "1" "0") "\n"))
> +
> +  (define (number-clause name field)
> +    (if (field section)
> +        (string-clause name (compose number->string field))
> +        '()))
> +
> +  (define (symbol-clause name field)
> +    (if (field section)
> +        (string-clause name (compose symbol->string field))
> +        '()))
> +
> +  (define (colour-clause name field)
> +    (string-clause name (compose (cute string-append "#" <>)
> +                                 field)))
> +
> +  (define (directional-clause name field)
> +    (if (field section)
> +        (string-clause name (compose (cute string-join <> ",")
> +                                     (cute map number->string <>)
> +                                     field))
> +        '()))
> +
> +  (define (event-clause name field)
> +    (append (list name "=")
> +            (match (field section)
> +              ('default (list "invoke-default-action"))
> +              ('dismiss (list "dismiss"))
> +              ('dismiss-all (list "dismiss-all"))
> +              ('dismiss-group (list "dismiss-group"))
> +              ((args ...)
> +               (append (list "exec")
> +                       (append-map (cute list " \"" <> "\"")
> +                                   args)))
> +              (#f (list "none")))
> +            (list "\n")))
> +
> +  (append (event-clause "on-button-left" home-mako-on-button-left)
> +          (event-clause "on-button-middle" home-mako-on-button-middle)
> +          (event-clause "on-button-right" home-mako-on-button-right)
> +          (event-clause "on-touch" home-mako-on-touch)
> +          (event-clause "on-notify" home-mako-on-notify)
> +          (list "font=" (home-mako-font section) " "
> +                (number->string (home-mako-font-size section)) "\n")
> +          (colour-clause "background-color" home-mako-background-color)
> +          (colour-clause "text-color" home-mako-text-color)
> +          (number-clause "width" home-mako-width)
> +          (number-clause "height" home-mako-height)
> +          (directional-clause "outer-margin" home-mako-outer-margin)
> +          (directional-clause "margin" home-mako-margin)
> +          (directional-clause "padding" home-mako-padding)
> +          (number-clause "border-size" home-mako-border-size)
> +          (colour-clause "border-color" home-mako-border-color)
> +          (number-clause "border-radius" home-mako-border-radius)
> +          (list "progress-color="
> +                (symbol->string (home-mako-progress-style section))
> +                " #" (home-mako-progress-color section) "\n")
> +          (boolean-clause "icons" home-mako-icons?)
> +          (number-clause "max-icon-size" home-mako-max-icon-size)
> +          (string-clause "icon-path"
> +                         (compose (cute string-join <> ":")
> +                                  home-mako-icon-path))
> +          (symbol-clause "icon-location" home-mako-icon-location)
> +          (boolean-clause "markup" home-mako-markup?)
> +          (boolean-clause "actions" home-mako-actions?)
> +          (boolean-clause "history" home-mako-history?)
> +          (boolean-clause "invisible" home-mako-invisible?)
> +          (string-clause "format" home-mako-format)
> +          (symbol-clause "text-alignment" home-mako-text-alignment)
> +          (number-clause "default-timeout" home-mako-default-timeout)
> +          (boolean-clause "ignore-timeout" home-mako-ignore-timeout?)
> +          (boolean-clause "ignore-timeout" home-mako-ignore-timeout?)
> +          (if (home-mako-group-by section)
> +              (string-clause "group-by"
> +                             (compose (cute string-join <> ",")
> +                                      home-mako-group-by))
> +              '())
> +          (number-clause "max-visible" home-mako-max-visible)
> +          (string-clause "output" home-mako-output)
> +          (symbol-clause "layer" home-mako-layer)
> +          (symbol-clause "anchor" home-mako-anchor)))
> +
> +(define (home-mako-configuration-section section)
> +  (append (home-mako-configuration-header section)
> +          (home-mako-configuration-body section)))
> +
> +(define %home-mako-default-section (home-mako-section))
> +
> +(define %home-mako-default-grouped-section
> +  (home-mako-section
> +   (if-grouped? #t)
> +   (format "(%g) <b>%s</b>\\n%b")))
> +
> +(define-record-type* <home-mako-configuration>
> +  home-mako-configuration make-home-mako-configuration
> +  home-mako-configuration?
> +
> +  (mako home-mako-configuration-mako             ;file-like
> +        (default mako))
> +  (sections home-mako-configuration-sections     ;list of <home-mako-section>
> +            (default (list %home-mako-default-section
> +                           %home-mako-default-grouped-section)))
> +
> +  (max-history home-mako-configuration-max-history ;integer
> +               (default 5))
> +  (sort home-mako-configuration-sort             ;'time | 'priority
> +        (default 'time))
> +  (sort-order home-mako-configuration-sort-order ;'ascending | 'descending
> +              (default 'descending)))
> +
> +(define (home-mako-configuration-file config)
> +  (apply mixed-text-file "mako-config"
> +         (append (list "max-history="
> +                       (number->string
> +                        (home-mako-configuration-max-history config))
> +                       "\n"
> +                       "sort="
> +                       (match (home-mako-configuration-sort-order config)
> +                         ('ascending "+")
> +                         ('descending "-"))
> +                       (symbol->string (home-mako-configuration-sort config))
> +                       "\n")
> +                 (append-map home-mako-configuration-section
> +                             (home-mako-configuration-sections config)))))
> +
> +(define (home-mako-xdg-configuration-files config)
> +  `(("mako/config" ,(home-mako-configuration-file config))))
> +
> +(define home-mako-service-type
> +  (service-type
> +   (name 'home-mako)
> +   (extensions
> +    (list (service-extension home-xdg-configuration-files-service-type
> +                             home-mako-xdg-configuration-files)))
> +   (default-value (home-mako-configuration))
> +   (description
> +    "Install and configure the @code{mako} notification daemon.")))

In the coming days, I won't have time to try and check all the options
provided here, sorry, maybe someone else would jump in and review this
service in the meantime.

Heya,

On Thu Nov 10, 2022 at 1:16 PM GMT, Andrew Tropin wrote:
> It's not a perfect solution, but good enough.

Actually, I recently realised there's a better way: modify HOME-DBUS-SERVICE-TYPE
to support D-Bus services, like the system DBUS-SERVICE-TYPE does. I'll try to do
that at some point in the future.

    -- (