;;; 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.")))