[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Automatically mapping services from System to Home
From: |
Ludovic Courtès |
Subject: |
Automatically mapping services from System to Home |
Date: |
Tue, 28 Mar 2023 18:18:20 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/28.2 (gnu/linux) |
One idea I toyed with is automatic translation of service types from
System to Home. The service itself would look like this:
--8<---------------cut here---------------start------------->8---
(define-module (gnu home services syncthing)
#:use-module (gnu home services)
#:use-module (gnu services syncthing)
#:export (home-syncthing-service-type)
#:re-export (syncthing-configuration
syncthing-configuration?))
(define home-syncthing-service-type
(system-service-type->home-service-type syncthing-service-type))
--8<---------------cut here---------------end--------------->8---
The code to do that is attached below. The key here is that we’d define
mappings, like:
(define-service-type-mapping
shepherd-root-service-type => home-shepherd-service-type)
The rest of the service type graph would be automatically constructed
from this.
I feel like it would be worth pursuing this path so that there’s as
little duplication as possible between Home and System.
OTOH, it doesn’t take care of things like #:user in
‘make-forkexec-constructor’ calls and the like.
Thoughts?
Ludo’.
diff --git a/gnu/home/services.scm b/gnu/home/services.scm
index b7ea6f08dd..b32e7395b1 100644
--- a/gnu/home/services.scm
+++ b/gnu/home/services.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,8 +32,10 @@ (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 (ice-9 match)
+ #:use-module (ice-9 vlist)
#:export (home-service-type
home-profile-service-type
@@ -46,6 +49,9 @@ (define-module (gnu home services)
fold-home-service-types
home-provenance
+ define-service-type-mapping
+ system-service-type->home-service-type
+
%initialize-gettext)
#:re-export (service
@@ -396,6 +402,77 @@ (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)
+ (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)
+ (location (service-type-location type))
+ (extensions (filter-map rewrite (service-type-extensions type))))))
+
+ replace)
+
+;; (define (service-type-extensions-rewriting replacements)
+;; (define replace
+;; (let ((replacements (alist->vhash replacements hashq)))
+;; (lambda (type)
+;; (match (vhash-assq type replacements)
+;; (#f type)
+;; ((_ . replacement) replacement)))))
+
+;; (service-type-mapping replace))
+
+(define system-service-type->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 %system/home-service-type-mapping
+ (make-hash-table))
+
+(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))
+
+;; (define system->home-service-type
+;; (service-type-extensions-rewriting
+;; `((,system-service-type . ,home-service-type)
+;; (,activation-service-type . ,home-activation-service-type)
+;; (,shepherd-root-service-type . ,home-shepherd-service-type))))
+
;;;
;;; On-change.
diff --git a/gnu/home/services/shepherd.scm b/gnu/home/services/shepherd.scm
index 7a9cc064bb..21b73d8cdf 100644
--- a/gnu/home/services/shepherd.scm
+++ b/gnu/home/services/shepherd.scm
@@ -131,4 +131,5 @@ (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)
diff --git a/gnu/services/syncthing.scm b/gnu/services/syncthing.scm
index 7c3d5b027d..130a87705e 100644
--- a/gnu/services/syncthing.scm
+++ b/gnu/services/syncthing.scm
@@ -57,7 +57,7 @@ (define syncthing-shepherd-service
(shepherd-service
(provision (list (string->symbol (string-append "syncthing-" user))))
(documentation "Run syncthing.")
- (requirement '(loopback))
+ ;; (requirement '(loopback))
(start #~(make-forkexec-constructor
(append (list (string-append #$syncthing "/bin/syncthing")
"-no-browser"
- Automatically mapping services from System to Home,
Ludovic Courtès <=