;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2022 宋文武 ;;; ;;; 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 . (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.")))