[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/14: home: services: Support mapping of System services to Home servic
From: |
guix-commits |
Subject: |
05/14: home: services: Support mapping of System services to Home services. |
Date: |
Sun, 20 Aug 2023 17:22:25 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 161d010d40aa31f59b2ad3ecca12efda7c70366d
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Aug 6 18:25:22 2023 +0200
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.
---
gnu/home/services.scm | 69 +++++++++++++++++++++++++++++++++++++++++-
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:
;;;
@@ -514,6 +520,67 @@ 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.
;;;
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)
- 02/14: services: dicod: Pre-build the GCIDE index., (continued)
- 02/14: services: dicod: Pre-build the GCIDE index., guix-commits, 2023/08/20
- 04/14: services: Define 'for-home'., guix-commits, 2023/08/20
- 01/14: services: dicod: Remove Shepherd < 0.9.0 compatibility layer., guix-commits, 2023/08/20
- 06/14: home: services: mcron: Define as a mapping of the system service., guix-commits, 2023/08/20
- 08/14: home: services: Add Syncthing., guix-commits, 2023/08/20
- 09/14: home: services: ssh: Fix compilation warning with 'serialize-match-criteria'., guix-commits, 2023/08/20
- 11/14: gnu: Add python-ffmpeg-python., guix-commits, 2023/08/20
- 13/14: gnu: lttng-ust: Update to 2.13.6., guix-commits, 2023/08/20
- 14/14: doc: Fix module for "Essential Home Services"., guix-commits, 2023/08/20
- 03/14: services: syncthing: Use 'match-record'., guix-commits, 2023/08/20
- 05/14: home: services: Support mapping of System services to Home services.,
guix-commits <=
- 07/14: home: services: Add dicod., guix-commits, 2023/08/20
- 10/14: gnu: Add bfs., guix-commits, 2023/08/20
- 12/14: gnu: Add r128gain., guix-commits, 2023/08/20