[bug#54293] [PATCH v2] home: Add home-git-service-type.

[iyzsong@outlook.com]

* 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@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