From patchwork Sun Jan 30 15:11:39 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 36896 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id D174F27BBEA; Sun, 30 Jan 2022 15:12:21 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 1245927BBE9 for ; Sun, 30 Jan 2022 15:12:21 +0000 (GMT) Received: from localhost ([::1]:59590 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nEBsK-0003DH-6u for patchwork@mira.cbaines.net; Sun, 30 Jan 2022 10:12:20 -0500 Received: from eggs.gnu.org ([209.51.188.92]:35806) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nEBs2-0003Cm-Ar for guix-patches@gnu.org; Sun, 30 Jan 2022 10:12:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:44430) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nEBs1-0001dT-Vk for guix-patches@gnu.org; Sun, 30 Jan 2022 10:12:01 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nEBs1-0006zC-PO; Sun, 30 Jan 2022 10:12:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53466] [PATCH v2] home: Add redshift service. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: andrew@trop.in, guix-patches@gnu.org Resent-Date: Sun, 30 Jan 2022 15:12:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 53466 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 53466@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= , Andrew Tropin X-Debbugs-Original-Xcc: Andrew Tropin Received: via spool by 53466-submit@debbugs.gnu.org id=B53466.164355552026845 (code B ref 53466); Sun, 30 Jan 2022 15:12:01 +0000 Received: (at 53466) by debbugs.gnu.org; 30 Jan 2022 15:12:00 +0000 Received: from localhost ([127.0.0.1]:37333 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nEBrz-0006yv-Vw for submit@debbugs.gnu.org; Sun, 30 Jan 2022 10:12:00 -0500 Received: from eggs.gnu.org ([209.51.188.92]:57354) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nEBrx-0006yh-TS for 53466@debbugs.gnu.org; Sun, 30 Jan 2022 10:11:58 -0500 Received: from [2001:470:142:3::e] (port=48328 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nEBrs-0001dC-JR; Sun, 30 Jan 2022 10:11:52 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=JZtxloQLyAwbaWffjV/wInNAnTFb9R0byl/Zpx6EgBY=; b=Bmc2UNrb3eKKu+E6lSUQ vBDQBxWK+dWf2p7mSrzjVjrgedZprk8xouARa8gObuLng+XB7AdaId0UWZ70jZ3LW1PkgthMO1xq+ +JMi2Wytnj1pStBtw/s92ujUuOBHE0jeDT7M6v6p5hna2YHcA5ot14RQX2RdkFC9vrzbsBFWVGtjQ qGD8Q/Uag4wzUj0UzLNpjA03B8tnwfaZPaBieijs2Kfp5MmhBQR8LpPnxRgJZOXXGctckyeBX/aIx ebGloHDznk4Dok1ODX8InbxjAyHusMyQKMPySbHhsTcUobct5VlO72SRnFwGCQKuDf2oc4FjyFSmp +iK36G8gXQ92GA==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:60174 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nEBrs-0000rO-3m; Sun, 30 Jan 2022 10:11:52 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 30 Jan 2022 16:11:39 +0100 Message-Id: <20220130151139.3857-1-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 In-Reply-To: <87sft8tah0.fsf@trop.in> References: <87sft8tah0.fsf@trop.in> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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? Ludo’. base-commit: 27c1d58d901dcf48929bcb6f76d861fc21575dbf 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 +;;; +;;; 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 . + +(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)) + + #$(home-redshift-configuration-extra-content config))) + +(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 \