guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#54293] [WIP] home: Add home-git-service-type


From: 宋文武
Subject: [bug#54293] [WIP] home: Add home-git-service-type
Date: Mon, 07 Mar 2022 22:51:03 +0800

Hello, with:
--8<---------------cut here---------------start------------->8---
(service home-git-service-type
 (home-git-configuration
  (options '((user (name "foo")
                   (email "foo@bar.com"))))))
--8<---------------cut here---------------end--------------->8---

We'll have git in the home profile, and GIT_CONFIG_SYSTEM pointing to a
file contains:
--8<---------------cut here---------------start------------->8---
[user]
        name = "foo"
        email = "foo@bar.com"
--8<---------------cut here---------------end--------------->8---

Which set the system-level options for git.


>From d161786c675a12f9cb2bce2bdb965d65eb5281ac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= <iyzsong@member.fsf.org>
Date: Mon, 7 Mar 2022 22:14:09 +0800
Subject: [PATCH] home: Add home-git-service-type.

* gnu/home/services/git.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
 gnu/home/services/git.scm | 95 +++++++++++++++++++++++++++++++++++++++
 gnu/local.mk              |  1 +
 2 files changed, 96 insertions(+)
 create mode 100644 gnu/home/services/git.scm

diff --git a/gnu/home/services/git.scm b/gnu/home/services/git.scm
new file mode 100644
index 0000000000..2c3f87fbab
--- /dev/null
+++ b/gnu/home/services/git.scm
@@ -0,0 +1,95 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 宋文武 <iyzsong@member.fsf.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu home services git)
+  #:use-module (gnu home services)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu packages version-control)
+  #:use-module (guix packages)
+  #:use-module (guix gexp)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:export (home-git-service-type
+            home-git-configuration))
+
+(define (git-options? options)
+  "Return #t if OPTIONS is a well-formed sexp for git options."
+  (define git-variable?
+    (match-lambda
+      ((key value) (and (symbol? key) (string? value)))
+      (_ #f)))
+  (every
+   (match-lambda
+     (((section subsection) variables ..1)
+      (and (symbol? section)
+           (string? subsection)
+           (every git-variable? variables)))
+     ((section variables ..1)
+      (and (symbol? section)
+           (every git-variable? variables)))
+     (_ #f))
+   options))
+
+(define (serialize-git-options options)
+  (define serialize-section
+    (match-lambda
+      ((section variables ..1)
+       (with-output-to-string
+         (lambda ()
+           (match section
+             ((section subsection)
+              (simple-format #t "[~a ~s]~%" section subsection))
+             (_
+              (simple-format #t "[~a]~%" section)))
+           (for-each
+            (match-lambda
+              ((key value)
+               (simple-format #t "\t~a = ~s~%" key value)))
+            variables))))))
+  (string-concatenate (map serialize-section options)))
+
+(define-configuration home-git-configuration
+  (package
+   (package git)
+   "The Git package to use.")
+  (options
+   (git-options '())
+   "System configuration options for Git."))
+
+
+(define (home-git-environment-variables config)
+  (let ((gitconfig (serialize-git-options
+                    (home-git-configuration-options config))))
+   `(("GIT_CONFIG_SYSTEM" . ,(plain-file "gitconfig" gitconfig)))))
+
+(define (home-git-profile config)
+  (list (home-git-configuration-package config)))
+
+(define home-git-service-type
+  (service-type (name 'home-git)
+                (extensions
+                 (list (service-extension
+                        home-environment-variables-service-type
+                        home-git-environment-variables)
+                       (service-extension
+                        home-profile-service-type
+                        home-git-profile)))
+                (default-value (home-git-configuration))
+                (description
+                 "Install and configure the Git distributed revision control
+system.")))
diff --git a/gnu/local.mk b/gnu/local.mk
index 9bfeede60f..a5ea94b3a1 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -80,6 +80,7 @@ GNU_SYSTEM_MODULES =                          \
   %D%/home.scm                                 \
   %D%/home/services.scm                        \
   %D%/home/services/desktop.scm                        \
+  %D%/home/services/git.scm                    \
   %D%/home/services/symlink-manager.scm                \
   %D%/home/services/fontutils.scm              \
   %D%/home/services/shells.scm                 \
-- 
2.34.0


I made 'options' an sexp value since there are so many git options (see
'man git-config').  When `options' is invalid, `guix home' will reports:
'guix home: error: Invalid value for field options: ......', is this
acceptable or how to make a better validation error report?

I can also symlink the generated gitconfig into ~/.gitconfig, but with
'GIT_CONFIG_SYSTEM' it can be used together with hand maintained
~/.gitconfig.

Documentation is lacking, I'm still bad at them...

Any interest or review feedback?  Thanks!

I'd like to write more home services for msmtp, emacs, foot, etc. to
configure my whole user session :)

reply via email to

[Prev in Thread] Current Thread [Next in Thread]