From: "Ludovic Courtès" <ludo@gnu.org>
To: Sergey Trofimov <sarg@sarg.org.ru>
Cc: 62401@debbugs.gnu.org, paren@disroot.org, andrew@trop.in,
guix-devel@gnu.org
Subject: Automatically mapping services from System to Home
Date: Tue, 28 Mar 2023 18:18:20 +0200 [thread overview]
Message-ID: <87edp8g88j.fsf@gnu.org> (raw)
In-Reply-To: <20230323081026.13850-1-sarg@sarg.org.ru> (Sergey Trofimov's message of "Thu, 23 Mar 2023 09:10:26 +0100")
[-- Attachment #1: Type: text/plain, Size: 1164 bytes --]
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’.
[-- Attachment #2: Type: text/x-patch, Size: 4599 bytes --]
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.")))
+\f
+;;;
+;;; 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))))
+
\f
;;;
;;; 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"
next prev parent reply other threads:[~2023-03-28 16:18 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-03-23 8:10 [bug#62401] [PATCH] home: Add home-syncthing-service-type Sergey Trofimov
2023-03-28 15:58 ` Ludovic Courtès
2023-03-28 19:29 ` Sergey Trofimov
2023-03-29 16:35 ` Bruno Victal
2023-03-28 16:18 ` Ludovic Courtès [this message]
2023-03-28 19:59 ` Automatically mapping services from System to Home Attila Lendvai
2023-03-29 15:21 ` Bruno Victal
2023-08-07 9:50 ` [bug#62401] [PATCH] home: Add home-syncthing-service-type Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87edp8g88j.fsf@gnu.org \
--to=ludo@gnu.org \
--cc=62401@debbugs.gnu.org \
--cc=andrew@trop.in \
--cc=guix-devel@gnu.org \
--cc=paren@disroot.org \
--cc=sarg@sarg.org.ru \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.