home: Add redshift service.

* gnu/home/services/desktop.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (Desktop Home Services): New node.
This commit is contained in:
Ludovic Courtès 2022-01-23 01:06:17 +01:00
parent ecf527c921
commit 39e8025d3b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 255 additions and 0 deletions

@ -37598,6 +37598,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
@ -37985,6 +37986,85 @@ 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{dawn-time} (default: @code{disabled}) (type: maybe-string)
Custom time for the transition from night to day in the
morning---@code{"HH:MM"} format. When specified, solar elevation is not
used to determine the daytime/nighttime period.
@item @code{dusk-time} (default: @code{disabled}) (type: maybe-string)
Likewise, custom time for the transition from day to night in the
evening.
@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}

@ -0,0 +1,174 @@
;;; 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-string field value)
(string-append (symbol->string field)
"=" value "\n"))
(define serialize-inexact-number serialize-integer)
(define (inexact-number? n)
(and (number? n) (inexact? n)))
(define-maybe inexact-number)
(define-maybe string)
(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}.")
(dawn-time
(maybe-string 'disabled)
"Custom time for the transition from night to day in the
morning---@code{\"HH:MM\"} format. When specified, solar elevation is not
used to determine the daytime/nighttime period.")
(dusk-time
(maybe-string 'disabled)
"Likewise, custom time for the transition from day to night in the
evening.")
(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))
#$(home-redshift-configuration-extra-content config)
"\n[manual]\n"
#$(serialize-configuration config
(filter location-field?
home-redshift-configuration-fields))))
(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.")))

@ -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 \