mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
home: services: Support mapping of System services to Home services.
* gnu/home/services.scm (service-type-mapping) (system->home-service-type): New procedures. (define-service-type-mapping, define-service-type-mappings): New macros. (%system/home-service-type-mapping): New variable. <top level>: Use 'define-service-type-mappings'. * gnu/home/services/shepherd.scm <top level>: Likewise.
This commit is contained in:
parent
dff7d2468f
commit
161d010d40
2 changed files with 71 additions and 2 deletions
|
@ -33,6 +33,7 @@ (define-module (gnu home services)
|
|||
#:use-module (guix diagnostics)
|
||||
#:use-module (guix i18n)
|
||||
#:use-module (guix modules)
|
||||
#:use-module (guix memoization)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (ice-9 match)
|
||||
|
@ -63,11 +64,16 @@ (define-module (gnu home services)
|
|||
lookup-home-service-types
|
||||
home-provenance
|
||||
|
||||
define-service-type-mapping
|
||||
system->home-service-type
|
||||
|
||||
%initialize-gettext)
|
||||
|
||||
#:re-export (service
|
||||
service-type
|
||||
service-extension))
|
||||
service-extension
|
||||
for-home
|
||||
for-home?))
|
||||
|
||||
;;; Comment:
|
||||
;;;
|
||||
|
@ -513,6 +519,67 @@ (define home-activation-service-type
|
|||
reconfiguration or generation switching. This service can be extended
|
||||
with one gexp, but many times, and all gexps must be idempotent.")))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Service type graph rewriting.
|
||||
;;;
|
||||
|
||||
(define (service-type-mapping proc)
|
||||
"Return a procedure that applies PROC to map a service type graph to another
|
||||
one."
|
||||
(define (rewrite extension)
|
||||
(match (proc (service-extension-target extension))
|
||||
(#f #f)
|
||||
(target
|
||||
(service-extension target
|
||||
(service-extension-compute extension)))))
|
||||
|
||||
(define replace
|
||||
(mlambdaq (type)
|
||||
(service-type
|
||||
(inherit type)
|
||||
(name (symbol-append 'home- (service-type-name type)))
|
||||
(location (service-type-location type))
|
||||
(extensions (filter-map rewrite (service-type-extensions type))))))
|
||||
|
||||
replace)
|
||||
|
||||
(define %system/home-service-type-mapping
|
||||
;; Mapping of System to Home services.
|
||||
(make-hash-table))
|
||||
|
||||
(define system->home-service-type
|
||||
;; Map the given System service type to the corresponding Home service type.
|
||||
(let ()
|
||||
(define (replace type)
|
||||
(define replacement
|
||||
(hashq-ref %system/home-service-type-mapping type
|
||||
*unspecified*))
|
||||
|
||||
(if (eq? replacement *unspecified*)
|
||||
type
|
||||
replacement))
|
||||
|
||||
(service-type-mapping replace)))
|
||||
|
||||
(define-syntax define-service-type-mapping
|
||||
(syntax-rules (=>)
|
||||
((_ system-type => home-type)
|
||||
(hashq-set! %system/home-service-type-mapping
|
||||
system-type home-type))))
|
||||
|
||||
(define-syntax define-service-type-mappings
|
||||
(syntax-rules (=>)
|
||||
((_ (system-type => home-type) ...)
|
||||
(begin
|
||||
(define-service-type-mapping system-type => home-type)
|
||||
...))))
|
||||
|
||||
(define-service-type-mappings
|
||||
(system-service-type => home-service-type)
|
||||
(activation-service-type => home-activation-service-type)
|
||||
(profile-service-type => home-profile-service-type))
|
||||
|
||||
|
||||
;;;
|
||||
;;; On-change.
|
||||
|
|
|
@ -141,7 +141,7 @@ (define (ensure-shepherd-gexp config)
|
|||
(define (shepherd-xdg-configuration-files config)
|
||||
`(("shepherd/init.scm" ,(home-shepherd-configuration-file config))))
|
||||
|
||||
(define-public home-shepherd-service-type
|
||||
(define home-shepherd-service-type
|
||||
(service-type (name 'home-shepherd)
|
||||
(extensions
|
||||
(list (service-extension
|
||||
|
@ -168,4 +168,6 @@ (define-public home-shepherd-service-type
|
|||
(default-value (home-shepherd-configuration))
|
||||
(description "Configure and install userland Shepherd.")))
|
||||
|
||||
(define-service-type-mapping
|
||||
shepherd-root-service-type => home-shepherd-service-type)
|
||||
|
||||
|
|
Loading…
Reference in a new issue