188 lines
6.6 KiB
Scheme
188 lines
6.6 KiB
Scheme
(define-module (oms home services gnome)
|
|
#:use-module (gnu home services)
|
|
#:use-module (gnu home services shepherd)
|
|
#:use-module (gnu packages glib)
|
|
#:use-module (gnu packages gnome)
|
|
#:use-module (gnu services configuration)
|
|
#:use-module ((guix diagnostics) #:select (warning))
|
|
#:use-module (guix gexp)
|
|
#:use-module (guix i18n)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (ice-9 string-fun)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-9 gnu)
|
|
#:use-module (srfi srfi-11)
|
|
#:use-module (srfi srfi-26)
|
|
#:export (home-gsettings-configuration
|
|
home-gsettings-configuration?
|
|
home-gsettings-configuration-reset?
|
|
home-gsettings-configuration-schemas
|
|
|
|
gsettings-schema
|
|
gsettings-schema?
|
|
gsettings-schema-name
|
|
gsettings-schema-settings
|
|
|
|
raw-gvariant
|
|
raw-gvariant?
|
|
raw-gvariant-value
|
|
|
|
home-gsettings-service-type))
|
|
|
|
(define-immutable-record-type <raw-gvariant>
|
|
(raw-gvariant value)
|
|
raw-gvariant?
|
|
(value raw-gvariant-value))
|
|
|
|
(define (gvariant-association-list? x)
|
|
(match x
|
|
((((? string?) . (? gvariant-printable?)) ...) #t)
|
|
(_ #f)))
|
|
|
|
(define (list-of-gsettings-schemas? x)
|
|
(and (list? x)
|
|
;; TODO who does this not work???
|
|
;(every (lambda (x) ((gsettings-schema? x))) x)
|
|
))
|
|
|
|
(define-configuration/no-serialization home-gsettings-configuration
|
|
(reset?
|
|
(boolean #t)
|
|
"Whether to reset all undeclared GSettings to default values. Resetting
|
|
ensures the configuration is declarative but makes it impossible to modify
|
|
settings persistently from any application's user interface.")
|
|
(schemas
|
|
(list-of-gsettings-schemas '())
|
|
"The declared GSettings configuration values."))
|
|
|
|
(define-configuration/no-serialization gsettings-schema
|
|
(name
|
|
string
|
|
"The identifier of the GSettings schema. For example \"org.gnome.desktop.background\".")
|
|
(settings
|
|
(gvariant-association-list)
|
|
"Keys and values to set in this schema."))
|
|
|
|
(define* (group lst #:key (similar? equal?))
|
|
"Returns a list of non-empty lists such that all the values in each sublist
|
|
are SIMILAR? to it's first one."
|
|
(match lst
|
|
((head _ ...)
|
|
(let-values (((similar different)
|
|
(partition (cut similar? head <>) lst)))
|
|
(cons similar (group different #:similar? similar?))))
|
|
(() '())))
|
|
|
|
(define (equal?-under view)
|
|
(lambda (x y)
|
|
(equal? (view x)
|
|
(view y))))
|
|
|
|
(define (gvariant-printable? x)
|
|
(or (boolean? x)
|
|
(string? x)
|
|
(file-like? x)
|
|
(number? x)
|
|
(and (list? x)
|
|
(every gvariant-printable? x))
|
|
(raw-gvariant? x)))
|
|
|
|
(define (serialize-gvariant value)
|
|
"Serialize VALUE to a string in GVariant text format or to a G-expression
|
|
that expands to an expression that evaluates to such a string."
|
|
(match value
|
|
((or (? string?)
|
|
(? file-like?))
|
|
#~(begin
|
|
(use-modules (ice-9 string-fun))
|
|
(format #f "'~a'"
|
|
(string-replace-substring
|
|
(string-replace-substring #$value "\\" "\\\\")
|
|
"'" "\\'"))))
|
|
((? boolean?)
|
|
(if value "true" "false"))
|
|
((? number?)
|
|
(format #f "~a" value))
|
|
((? raw-gvariant? (= raw-gvariant-value raw-value))
|
|
raw-value)
|
|
(((? gvariant-printable? lst) ...)
|
|
#~(format #f "[~a]" (string-join (list #$@(map serialize-gvariant lst)) ", ")))))
|
|
|
|
(define (home-gsettings-configuration->setting-list config)
|
|
"Convert a home-gsettings-configuration record into a list-based format with
|
|
serialized values. If the same key is set multiple times in the same schema, a
|
|
warning is raised and the leftmost value used."
|
|
(define (serialize-keyvals keyvals)
|
|
(match keyvals
|
|
(((key . value))
|
|
#~(list #$key #$(serialize-gvariant value)))
|
|
(((key . value) (_ . ignored) ...)
|
|
(warning (G_ "Multiple values set for GSetting key '~a ~a'! \
|
|
Using '~a' and ignoring the rest ~a.")
|
|
schema-name key value ignored)
|
|
#~(list #$key #$(serialize-gvariant value)))))
|
|
(define (merge-schemas schemas)
|
|
(let ((schema-name (gsettings-schema-name (car schemas))))
|
|
#~(list #$schema-name
|
|
#$@(map serialize-keyvals
|
|
(group (append-map gsettings-schema-settings schemas)
|
|
#:similar? (equal?-under car))))))
|
|
#~(list
|
|
#$@(map merge-schemas
|
|
(group (home-gsettings-configuration-schemas config)
|
|
#:similar? (equal?-under gsettings-schema-name)))))
|
|
|
|
(define (extend-gsettings config extension-schemas)
|
|
(home-gsettings-configuration
|
|
(inherit config)
|
|
(schemas
|
|
;; Leftmost values are preferred so instantiation overrides extensions
|
|
(append (home-gsettings-configuration-schemas config)
|
|
extension-schemas))))
|
|
|
|
(define (make-gsettings-script config)
|
|
(program-file
|
|
"set-gsettings"
|
|
(with-imported-modules '((guix build utils))
|
|
#~(begin
|
|
(use-modules (guix build utils)
|
|
(ice-9 match))
|
|
;; Pass options via the environment to allow reusing this script
|
|
(when #$(home-gsettings-configuration-reset? config)
|
|
(invoke #$(file-append dconf "/bin/dconf") "reset" "-f" "/"))
|
|
(match #$(home-gsettings-configuration->setting-list config)
|
|
((((? string? schemas) keyvals ...) ...)
|
|
(map (lambda (schema keyvals)
|
|
(map (match-lambda
|
|
((key value)
|
|
(invoke #$(file-append (gexp-input glib "bin")
|
|
"/bin/gsettings")
|
|
"set" schema key value)))
|
|
keyvals))
|
|
schemas keyvals)))))))
|
|
|
|
(define (home-gsettings-shepherd-services config)
|
|
(list
|
|
(shepherd-service
|
|
(documentation "Sets declared GSettings configuration values.")
|
|
(provision '(gsettings))
|
|
(one-shot? #t)
|
|
(start #~(make-forkexec-constructor
|
|
(list #$(make-gsettings-script config)))))))
|
|
|
|
(define home-gsettings-service-type
|
|
(service-type
|
|
(name 'home-gsettings)
|
|
(extensions
|
|
(list (service-extension home-shepherd-service-type
|
|
home-gsettings-shepherd-services)))
|
|
(compose concatenate)
|
|
(extend extend-gsettings)
|
|
(default-value
|
|
(home-gsettings-configuration
|
|
;; If the user has not added the service to their home configuration
|
|
;; themselves, they probably don't want it to reset their settings when
|
|
;; another service extends it.
|
|
(reset? #f)))
|
|
(description "Declare values for GSettings configuration settings used by GNOME.")))
|