Package: guix-patches;
Message #32 received at 54293 <at> debbugs.gnu.org (full text, mbox):
From: iyzsong <at> outlook.com To: 54293 <at> debbugs.gnu.org Cc: 宋文武 <iyzsong <at> member.fsf.org> Subject: [PATCH v2] home: Add home-git-service-type. Date: Sat, 12 Mar 2022 10:22:32 +0800
* gnu/home/services/git.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
gnu/home/services/git.scm | 214 ++++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
2 files changed, 215 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..f39c931c38
--- /dev/null
+++ b/gnu/home/services/git.scm
@@ -0,0 +1,214 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 宋文武 <iyzsong <at> 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-option-value? value)
+ (or (unspecified? value)
+ (string? value)
+ (integer? value)
+ (boolean? value)))
+
+(define (serialize-git-option-value value)
+ (cond
+ ((string? value) (with-output-to-string (lambda () (write value))))
+ ((integer? value) (number->string value))
+ ((boolean? value) (if value "true" "false"))))
+
+(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) (git-option-value? 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)
+ "Return the @command{git-config} text form for 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 = ~a~%"
+ key (serialize-git-option-value value))))
+ variables))))))
+ (string-concatenate (map serialize-section options)))
+
+(define-configuration/no-serialization home-git-configuration
+ (package
+ (package git)
+ "The Git package to use.")
+ (enable-send-email?
+ (boolean #t)
+ "Whether to install git email tools from the package's @code{send-email}
+output.")
+ (user.name
+ (git-option-value *unspecified*)
+ "The human-readable name used in the author and committer identity when
+creating commit or tag objects, or when writing reflogs. If you need the
+author or committer to be different, the @code{author.name} or
+@code{committer.name} can be set.")
+ (user.email
+ (git-option-value *unspecified*)
+ "The email address used in the author and committer identity when creating
+commit or tag objects, or when writing reflogs. If you need the author or
+committer to be different, the @code{author.email} or @code{committer.email}
+can be set.")
+ (user.signingKey
+ (git-option-value *unspecified*)
+ "If @command{git-tag} or @command{git-commit} is not selecting the key you
+want it to automatically when creating a signed tag or commit, you can
+override the default selection with this variable. This option is passed
+unchanged to gpg’s @code{--local-user} parameter, so you may specify a key
+using any method that gpg supports.")
+ (author.name
+ (git-option-value *unspecified*)
+ "The human-readable name used in the author identity when creating commit
+or tag objects, or when writing reflogs.")
+ (author.email
+ (git-option-value *unspecified*)
+ "The email address used in the author identity when creating commit or tag
+objects, or when writing reflogs.")
+ (committer.name
+ (git-option-value *unspecified*)
+ "The human-readable name used in the committer identity when creating
+commit or tag objects, or when writing reflogs.")
+ (committer.email
+ (git-option-value *unspecified*)
+ "The email address used in the author identity when creating commit or tag
+objects, or when writing reflogs.")
+ (commit.gpgSign
+ (git-option-value *unspecified*)
+ "A boolean to specify whether all commits should be GPG signed.")
+ (sendemail.smtpServer
+ (git-option-value *unspecified*)
+ "If set, specifies the outgoing SMTP server to
+use (e.g. @code{smtp.example.com} or a raw IP address). If unspecified, and if
+@var{sendemail.sendmailcmd} is also unspecified, the default is to search for
+@command{sendmail} in $PATH if such a program is available, falling back to
+@code{localhost} otherwise.")
+ (sendemail.smtpServerPort
+ (git-option-value *unspecified*)
+ "Specifies a port different from the default port (SMTP servers typically
+listen to smtp port 25, but may also listen to submission port 587, or the
+common SSL smtp port 465); symbolic port names (e.g. @code{submission} instead
+of 587) are also accepted.")
+ (sendemail.smtpUser
+ (git-option-value *unspecified*)
+ "Username for SMTP-AUTH. If a username is not specified, then
+authentication is not attempted.")
+ (sendemail.smtpPass
+ (git-option-value *unspecified*)
+ "Password for SMTP-AUTH. If not specified, then a password is obtained
+using @command{git-credential}.")
+ (sendemail.smtpEncryption
+ (git-option-value *unspecified*)
+ "Specify the encryption to use, either @code{ssl} or @code{tls}. Any other
+value reverts to plain SMTP.")
+ (sendemail.sendmailcmd
+ (git-option-value *unspecified*)
+ "Specify a command to run to send the email. The command should be
+sendmail-like; specifically, it must support the @code{-i} option. The
+command will be executed in the shell if necessary.")
+ (extra-options
+ (git-options '())
+ "Extra configuration options for Git."))
+
+(define (home-git-configuration-final-options config)
+ (let* ((fields
+ (filter
+ (lambda (field)
+ (eq? (configuration-field-type field) 'git-option-value))
+ home-git-configuration-fields))
+ (options
+ (filter
+ (match-lambda
+ ((section (key value)) (not (unspecified? value))))
+ (map (lambda (field)
+ (let* ((name (configuration-field-name field))
+ (section+key (map string->symbol
+ (string-split (symbol->string name) #\.)))
+ (value ((configuration-field-getter field) config)))
+ `(,(car section+key) (,(cadr section+key) ,value))))
+ fields)))
+ (extra-options (home-git-configuration-extra-options config))
+ (merge-options (lambda (options) ;merge options by section
+ (fold
+ (lambda (e prev)
+ (match e
+ ((section variables ..1)
+ (begin
+ (let ((v (assv-ref prev section)))
+ (assv-set! prev section
+ (if v (append v variables)
+ variables)))))))
+ '() options))))
+ (merge-options (append options extra-options))))
+
+(define (home-git-environment-variables config)
+ (let ((gitconfig (serialize-git-options
+ (home-git-configuration-final-options config))))
+ `(("GIT_CONFIG_SYSTEM" . ,(plain-file "gitconfig" gitconfig)))))
+
+(define (home-git-profile config)
+ (let ((package (home-git-configuration-package config)))
+ (if (home-git-configuration-enable-send-email? config)
+ `(,package (,package "send-email"))
+ `(,package))))
+
+(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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.