blob: 27cc3548225856885f828b64df7da50d74b0a214 (
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
(define-module (oni home services notmuch)
#:use-module ((ice-9 string-fun)
#:select (string-replace-substring))
#:use-module ((gnu home services)
#:select (service-type
service-extension
home-profile-service-type
home-files-service-type))
#:use-module ((gnu packages mail)
#:select (notmuch))
#:use-module ((gnu services configuration)
#:select (serialize-package
define-configuration
define-maybe
configuration-field-name
serialize-configuration))
#:use-module ((guix gexp)
#:select (mixed-text-file))
#:use-module ((guix packages)
#:select (package?))
#:use-module ((srfi srfi-1) #:select (every))
#:export (home-notmuch-configuration
home-notmuch-service-type))
(define (remove-config-prefixes field-name)
(cond
((string-prefix? "database-" field-name)
(string-replace-substring field-name "database-" ""))
((string-prefix? "user-" field-name)
(string-replace-substring field-name "user-" ""))
((string-prefix? "new-" field-name)
(string-replace-substring field-name "new-" ""))
((string-prefix? "search-" field-name)
(string-replace-substring field-name "search-" ""))
((string-prefix? "maildir-" field-name)
(string-replace-substring field-name "maildir-" ""))
(#t
field-name)))
(define (kebab-case->snake-case field-name)
(string-replace-substring field-name "-" "_"))
(define field->setting-name
(compose kebab-case->snake-case
remove-config-prefixes
symbol->string))
(define (list-of-strings? obj)
(and (list? obj)
(every string? obj)))
(define (serialize-string field value)
(format #f "~a=~a~%" (field->setting-name field) value))
(define (serialize-list-of-strings field value)
(format #f "~a=~a~%" (field->setting-name field) (string-join value ";")))
(define-maybe string)
(define-maybe list-of-strings)
(define-maybe boolean)
(define-configuration home-notmuch-configuration
(package
(package notmuch)
"Package to use for setting Notmuch")
(database-path
maybe-string
"The top-level directory where your mail currently exists and to where mail will
be delivered in the future.")
(user-primary-email
maybe-string
"Your primary email address.")
(user-other-email
maybe-list-of-strings
"A list of other email addresses at which you receive email.")
(new-ignore
maybe-list-of-strings
"A list of file and directory names that will not be searched for messages by
\"notmuch new\".")
(new-tags
maybe-list-of-strings
"A list of the tags that will be added to all messages incorporated by \"notmuch
new\".")
(search-exclude-tags
maybe-list-of-strings
"A list of tags that will be excluded from search results by default.")
(maildir-synchronize-flags
maybe-boolean
"Synchronize supported maildir flags with corresponding notmuch tags."))
(define (add-notmuch-packages config)
(list (home-notmuch-configuration-package config)))
(define (home-notmuch-configuration-files config)
(let ((make-prefix-checker
(λ (p)
(λ (f) (string-prefix? p (symbol->string (configuration-field-name f)))))))
`((".notmuch-config"
,(mixed-text-file
"notmuch-config"
"[database]\n"
(serialize-configuration config
(filter (make-prefix-checker "database-")
home-notmuch-configuration-fields))
"\n"
"[user]\n"
(serialize-configuration config
(filter (make-prefix-checker "user-")
home-notmuch-configuration-fields))
"\n"
"[new]\n"
(serialize-configuration config
(filter (make-prefix-checker "new-")
home-notmuch-configuration-fields))
"\n"
"[search]\n"
(serialize-configuration config
(filter (make-prefix-checker "search-")
home-notmuch-configuration-fields))
"\n"
"[maildir]\n"
(serialize-configuration config
(filter (make-prefix-checker "maildir-")
home-notmuch-configuration-fields)))))))
(define home-notmuch-service-type
(service-type
(name 'home-notmuch)
(extensions
(list (service-extension
home-profile-service-type
add-notmuch-packages)
(service-extension
home-files-service-type
home-notmuch-configuration-files)))
(compose identity)
(default-value (home-notmuch-configuration))
(description "Install and configure notmuch.")))
|
