[bug#53466] [PATCH v2] home: Add redshift service.

[Andrew Tropin]

On 2022-01-30 16:11, Ludovic Courtès wrote:

> * gnu/home/services/desktop.scm: New file.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
> * doc/guix.texi (Desktop Home Services): New node.
> ---
>  doc/guix.texi                 |  70 +++++++++++++++
>  gnu/home/services/desktop.scm | 158 ++++++++++++++++++++++++++++++++++
>  gnu/local.mk                  |   1 +
>  3 files changed, 229 insertions(+)
>  create mode 100644 gnu/home/services/desktop.scm
>
> Hello!
>
> Changes compared to v1 account for Andrew’s suggestions:
>
>   • add ‘redshift’ field to specify the package to use;
>
>   • add ‘extra-content’ field as an escape hatch.
>
> We could debate about the latter; from a pragmatic standpoint,
> I think it gives all the flexibility one would need in practice.
>
> Thoughts?

Probably, I already mentioned, but combining renamed option names from
the configuration record and option names in the escape hatch is
inconsistent, confusing and error-prone.

>
> Ludo’.
>
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 94f8e5e481..67a5517911 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -37461,6 +37461,7 @@ services)}.
>  * Shells: Shells Home Services.          POSIX shells, Bash, Zsh.
>  * Mcron: Mcron Home Service.             Scheduled User's Job Execution.
>  * Shepherd: Shepherd Home Service.       Managing User's Daemons.
> +* Desktop: Desktop Home Services.        Services for graphical environments.
>  @end menu
>  @c In addition to that Home Services can provide
>  
> @@ -37848,6 +37849,75 @@ mechanism instead (@pxref{Shepherd Services}).
>  @end table
>  @end deftp
>  
> +@node Desktop Home Services
> +@subsection Desktop Home Services
> +
> +The @code{(gnu home services desktop)} module provides services that you
> +may find useful on ``desktop'' systems running a graphical user
> +environment such as Xorg.
> +
> +@defvr {Scheme Variable} home-redshift-service-type
> +This is the service type for @uref{https://github.com/jonls/redshift,
> +Redshift}, a program that adjusts the display color temperature
> +according to the time of day.  Its associated value must be a
> +@code{home-redshift-configuration} record, as shown below.
> +
> +A typical configuration, where we manually specify the latitude and
> +longitude, might look like this:
> +
> +@lisp
> +(service home-redshift-service-type
> +         (home-redshift-configuration
> +          (location-provider 'manual)
> +          (latitude 35.81)    ;northern hemisphere
> +          (longitude -0.80))) ;west of Greenwich
> +@end lisp
> +@end defvr
> +
> +@deftp {Data Type} home-redshift-configuration
> +Available @code{home-redshift-configuration} fields are:
> +
> +@table @asis
> +@item @code{redshift} (default: @code{redshift}) (type: file-like)
> +Redshift package to use.
> +
> +@item @code{location-provider} (default: @code{geoclue2}) (type: symbol)
> +Geolocation provider---@code{'manual} or @code{'geoclue2}.  In the
> +former case, you must also specify the @code{latitude} and
> +@code{longitude} fields so Redshift can determine daytime at your place.
> +In the latter case, the Geoclue system service must be running; it will
> +be queried for location information.
> +
> +@item @code{adjustment-method} (default: @code{randr}) (type: symbol)
> +Color adjustment method.
> +
> +@item @code{daytime-temperature} (default: @code{6500}) (type: integer)
> +Daytime color temperature (kelvins).
> +
> +@item @code{nighttime-temperature} (default: @code{4500}) (type: integer)
> +Nighttime color temperature (kelvins).
> +
> +@item @code{daytime-brightness} (default: @code{disabled}) (type: 
> maybe-inexact-number)
> +Daytime screen brightness, between 0.1 and 1.0.
> +
> +@item @code{nighttime-brightness} (default: @code{disabled}) (type: 
> maybe-inexact-number)
> +Nighttime screen brightness, between 0.1 and 1.0.
> +
> +@item @code{latitude} (default: @code{disabled}) (type: maybe-inexact-number)
> +Latitude, when @code{location-provider} is @code{'manual}.
> +
> +@item @code{longitude} (default: @code{disabled}) (type: 
> maybe-inexact-number)
> +Longitude, when @code{location-provider} is @code{'manual}.
> +
> +@item @code{extra-content} (default: @code{""}) (type: 
> raw-configuration-string)
> +Extra content appended as-is to the Redshift configuration file.  Run
> +@command{man redshift} for more information about the configuration file
> +format.
> +
> +@end table
> +
> +@end deftp
> +
>  @node Invoking guix home
>  @section Invoking @code{guix home}
>  
> diff --git a/gnu/home/services/desktop.scm b/gnu/home/services/desktop.scm
> new file mode 100644
> index 0000000000..010668550a
> --- /dev/null
> +++ b/gnu/home/services/desktop.scm
> @@ -0,0 +1,158 @@
> +;;; GNU Guix --- Functional package management for GNU
> +;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
> +;;;
> +;;; 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 desktop)
> +  #:use-module (gnu home services)
> +  #:use-module (gnu home services shepherd)
> +  #:use-module (gnu services configuration)
> +  #:autoload   (gnu packages xdisorg) (redshift)
> +  #:use-module (guix records)
> +  #:use-module (guix gexp)
> +  #:use-module (srfi srfi-1)
> +  #:use-module (ice-9 match)
> +  #:export (home-redshift-configuration
> +            home-redshift-configuration?
> +
> +            home-redshift-service-type))
> +
> +
> +;;;
> +;;; Redshift.
> +;;;
> +
> +(define (serialize-integer field value)
> +  (string-append (match field
> +                   ('daytime-temperature "temp-day")
> +                   ('nighttime-temperature "temp-night")
> +                   ('daytime-brightness "brightness-day")
> +                   ('nighttime-brightness "brightness-night")
> +                   ('latitude "lat")
> +                   ('longitude "lon")
> +                   (_ (symbol->string field)))
> +                 "=" (number->string value) "\n"))
> +
> +(define (serialize-symbol field value)
> +  (string-append (symbol->string field)
> +                 "=" (symbol->string value) "\n"))
> +
> +(define serialize-inexact-number serialize-integer)
> +
> +(define (inexact-number? n)
> +  (and (number? n) (inexact? n)))
> +(define-maybe inexact-number)
> +
> +(define (serialize-raw-configuration-string field value)
> +  value)
> +(define raw-configuration-string? string?)
> +
> +(define-configuration home-redshift-configuration
> +  (redshift
> +   (file-like redshift)
> +   "Redshift package to use.")
> +
> +  (location-provider
> +   (symbol 'geoclue2)
> +   "Geolocation provider---@code{'manual} or @code{'geoclue2}.
> +
> +In the former case, you must also specify the @code{latitude} and
> +@code{longitude} fields so Redshift can determine daytime at your place.  In
> +the latter case, the Geoclue system service must be running; it will be
> +queried for location information.")
> +  (adjustment-method
> +   (symbol 'randr)
> +   "Color adjustment method.")
> +
> +  ;; Default values from redshift(1).
> +  (daytime-temperature
> +   (integer 6500)
> +   "Daytime color temperature (kelvins).")
> +  (nighttime-temperature
> +   (integer 4500)
> +   "Nighttime color temperature (kelvins).")
> +
> +  (daytime-brightness
> +   (maybe-inexact-number 'disabled)
> +   "Daytime screen brightness, between 0.1 and 1.0.")
> +  (nighttime-brightness
> +   (maybe-inexact-number 'disabled)
> +   "Nighttime screen brightness, between 0.1 and 1.0.")
> +
> +  (latitude
> +   (maybe-inexact-number 'disabled)
> +   "Latitude, when @code{location-provider} is @code{'manual}.")
> +  (longitude
> +   (maybe-inexact-number 'disabled)
> +   "Longitude, when @code{location-provider} is @code{'manual}.")
> +
> +  (extra-content
> +   (raw-configuration-string "")
> +   "Extra content appended as-is to the Redshift configuration file.  Run
> +@command{man redshift} for more information about the configuration file
> +format."))
> +
> +(define (serialize-redshift-configuration config)
> +  (define location-fields
> +    '(latitude longitude))
> +
> +  (define (location-field? field)
> +    (memq (configuration-field-name field) location-fields))
> +
> +  (define (secondary-field? field)
> +    (or (location-field? field)
> +        (memq (configuration-field-name field)
> +              '(redshift extra-content))))
> +
> +  #~(string-append
> +     "[redshift]\n"
> +     #$(serialize-configuration config
> +                                (remove secondary-field?
> +                                        home-redshift-configuration-fields))
> +     "\n[manual]\n"
> +     #$(serialize-configuration config
> +                                (filter location-field?
> +                                        home-redshift-configuration-fields))
> +

It's very unclear where this extra-content goes and user can't know it
until he check out the implementation or build the config (currently
it's also almost impossible to find it on file system after build).
Using such type of escape hatch is no joy at all.

Seems this one is missplaced and should be go before [manual] section,
otherwise it won't be possible to set values of redshift section.  And
doing so will lead to very ugly:

(extra-content "\
dawn-time=5:30
dusk-time=18:30
[geoclue2]
some-other-option=value
# Do I know that I'm in the middle of config file?")

It will be especially ugly or even erroneous, when the target config has
a format, which uses identation.

I didn't try it for redshift, but in many ini parser it's forbidden to
repeat sections with the same name.
> 
> +     #$(home-redshift-configuration-extra-content config)))

A little offtopic:

I know a number of system services, where the extra-content goes in
unexpected locations and overall behavior of escape hatch is unexpected
and incosistent with other escape hatches.  Some of the services has a
number of escape hatches in almost every nested record with different
names and behaviors.

I'm relatively fresh Guix user and this part really confused me at first
even having experience with NixOS module system before and it's very
likely that many people just don't report it, because it really hard to
get the roots of it.

> +
> +(define (redshift-shepherd-service config)
> +  (define config-file
> +    (computed-file "redshift.conf"
> +                   #~(call-with-output-file #$output
> +                       (lambda (port)
> +                         (display #$(serialize-redshift-configuration config)
> +                                  port)))))
> +
> +  (list (shepherd-service
> +         (documentation "Redshift program.")
> +         (provision '(redshift))
> +         ;; FIXME: This fails to start if Home is first activated from a
> +         ;; non-X11 session.
> +         (start #~(make-forkexec-constructor
> +                   (list #$(file-append redshift "/bin/redshift")
> +                         "-c" #$config-file)))
> +         (stop #~(make-kill-destructor)))))
> +
> +(define home-redshift-service-type
> +  (service-type
> +   (name 'home-redshift)
> +   (extensions (list (service-extension home-shepherd-service-type
> +                                        redshift-shepherd-service)))
> +   (default-value (home-redshift-configuration))
> +   (description
> +    "Run Redshift, a program that adjusts the color temperature of display
> +according to time of day.")))
> diff --git a/gnu/local.mk b/gnu/local.mk
> index 27e7877361..80cb760132 100644
> --- a/gnu/local.mk
> +++ b/gnu/local.mk
> @@ -79,6 +79,7 @@ GNU_SYSTEM_MODULES =                                \
>    %D%/ci.scm                                 \
>    %D%/home.scm                                       \
>    %D%/home/services.scm                      \
> +  %D%/home/services/desktop.scm                      \
>    %D%/home/services/symlink-manager.scm              \
>    %D%/home/services/fontutils.scm            \
>    %D%/home/services/shells.scm                       \
>
> base-commit: 27c1d58d901dcf48929bcb6f76d861fc21575dbf

-- 
Best regards,
Andrew Tropin

signature.asc
Description: PGP signature