diff options
| -rw-r--r-- | gnu/home/services.scm | 69 | ||||
| -rw-r--r-- | gnu/home/services/shepherd.scm | 4 |
2 files changed, 71 insertions, 2 deletions
diff --git a/gnu/home/services.scm b/gnu/home/services.scm index 042eba4780..8d53f2f4d3 100644 --- a/gnu/home/services.scm +++ b/gnu/home/services.scm @@ -33,6 +33,7 @@ #: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 @@ 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: ;;; @@ -515,6 +521,67 @@ 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. ;;; diff --git a/gnu/home/services/shepherd.scm b/gnu/home/services/shepherd.scm index 5585ef61b2..bd068c37fc 100644 --- a/gnu/home/services/shepherd.scm +++ b/gnu/home/services/shepherd.scm @@ -141,7 +141,7 @@ as shepherd package." (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 @@ as shepherd package." (default-value (home-shepherd-configuration)) (description "Configure and install userland Shepherd."))) +(define-service-type-mapping + shepherd-root-service-type => home-shepherd-service-type) |