136 lines
5 KiB
Scheme
136 lines
5 KiB
Scheme
(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)
|
|
`((".notmuch-config"
|
|
,(mixed-text-file
|
|
"notmuch-config"
|
|
"[database]\n"
|
|
(serialize-configuration config
|
|
(filter (λ (f) (string-prefix? "database-" (symbol->string (configuration-field-name f))))
|
|
home-notmuch-configuration-fields))
|
|
"\n"
|
|
"[user]\n"
|
|
(serialize-configuration config
|
|
(filter (λ (f) (string-prefix? "user-" (symbol->string (configuration-field-name f))))
|
|
home-notmuch-configuration-fields))
|
|
"\n"
|
|
"[new]\n"
|
|
(serialize-configuration config
|
|
(filter (λ (f) (string-prefix? "new-" (symbol->string (configuration-field-name f))))
|
|
home-notmuch-configuration-fields))
|
|
"\n"
|
|
"[search]\n"
|
|
(serialize-configuration config
|
|
(filter (λ (f) (string-prefix? "search-" (symbol->string (configuration-field-name f))))
|
|
home-notmuch-configuration-fields))
|
|
"\n"
|
|
"[maildir]\n"
|
|
(serialize-configuration config
|
|
(filter (λ (f) (string-prefix? "maildir-" (symbol->string (configuration-field-name f))))
|
|
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.")))
|