aboutsummaryrefslogtreecommitdiffstats
path: root/oni/home/services/git.scm
blob: b1db06e7effbec91efb4db5cfa4865bc27c0a3ad (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
(define-module (oni home services git)
  #:use-module (srfi srfi-1)
  #:use-module ((gnu home services)
                #:select (service-type
                          service-extension
                          home-profile-service-type
                          home-xdg-configuration-files-service-type))
  #:use-module ((gnu packages version-control)
                #:select (git))
  #:use-module ((gnu services configuration)
                #:select (serialize-package
                          define-configuration
                          define-maybe
                          serialize-text-config
                          serialize-configuration
                          configuration-field-name))
  #:use-module ((guix packages)
                #:select (package?))
  #:use-module ((guix gexp)
                #:select (mixed-text-file))

  #:export (home-git-service-type
            home-git-configuration))

(define (pascal-case str delim)
  (let ((parts (string-split str delim)))
    (string-join (cons (car parts)
                       (map string-capitalize (cdr parts)))
                 "")))

(define-maybe string)

(define (serialize-string field value)
  (let* ((field-name (symbol->string field))
         (name (pascal-case (substring field-name (1+ (string-index field-name #\-))) #\-)))
    (format #f "~a=~a~%" name value)))

(define (serialize-boolean field value)
  (let* ((field-name (symbol->string field))
         (name (pascal-case (substring field-name (1+ (string-index field-name #\-))) #\-)))
    (format #f "~a=~a~%" name (if value "true" "false"))))

(define (list-of-strings? obj)
  (and (list? obj)
       (every string? obj)))

(define (serialize-list-of-strings field value)
  (string-append (string-join value "\n")))

(define-configuration home-git-configuration
  (package
    (package git)
    "Package to use for setting git.")
  (user-name
   (string "")
   "Name of the user to specify.")
  (user-email
   (string "")
   "Email of the user to specify.")
  (sendemail-sendmailcmd
   maybe-string
   "Command to use to send email.")
  (init-default-branchname
   maybe-string
   "Default name for new branches.")
  (init-default-branch
   maybe-string
   "Default branch.")
  (advice-detached-head
   (boolean #t)
   "Show warning about being in a detached-head state?")
  (ignore-patterns
   (list-of-strings '())
   "Ignore patterns.")
  (extra
   maybe-string
   "Any extra configuration."))

(define (add-git-packages config)
  (list (home-git-configuration-package config)))

(define (add-git-config-files config)
  (let ((filter-prefix
         (λ (p l)
           (filter (λ (f) (string-prefix? p (symbol->string (configuration-field-name f)))) l))))
    `(("git/config"
       ,(mixed-text-file
         "config"
         "[user]\n"
         (serialize-configuration config (filter-prefix "user-" home-git-configuration-fields))
         "[sendemail]\n"
         (serialize-configuration config (filter-prefix "sendemail-" home-git-configuration-fields))
         "[init]\n"
         (serialize-configuration config (filter-prefix "init-" home-git-configuration-fields))
         "[advice]\n"
         (serialize-configuration config (filter-prefix "advice-" home-git-configuration-fields))
         (home-git-configuration-extra config)))
      ("git/ignore"
       ,(mixed-text-file
         "gitignore"
         (serialize-list-of-strings #f (home-git-configuration-ignore-patterns config)))))))

(define home-git-service-type
  (service-type
   (name 'home-git)
   (extensions
    (list (service-extension
           home-profile-service-type
           add-git-packages)
          (service-extension
           home-xdg-configuration-files-service-type
           add-git-config-files)))
   (compose identity)
   (default-value (home-git-configuration))
   (description "Install and configure git.")))