Add notmuch configuration to guix-home

This commit is contained in:
Tom Willemse 2023-07-12 15:46:05 -07:00
parent cf32eb426b
commit 6445a90dfd
2 changed files with 146 additions and 1 deletions

View file

@ -71,6 +71,9 @@
<home-mpd-audio-output>
home-mpc-update-service-type
home-mpd-notify-service-type))
#:use-module ((oni home services notmuch)
#:select (home-notmuch-service-type
home-notmuch-configuration))
#:use-module ((oni home services picom)
#:select (home-picom-service-type
home-picom-configuration))
@ -303,4 +306,10 @@
(home-stumpwm-configuration
(package stumpwm+swank)))
(service home-inkplate-display-service-type))))
(service home-inkplate-display-service-type)
(service home-notmuch-service-type
(home-notmuch-configuration
(database-path "/home/chelys/documents/mail")
(user-primary-email "tom@ryuslash.org")
(user-other-email '("ryuslash@gmail.com" "tom@iactor.nl"))
(new-ignore '(".nnmaildir" ".mbsyncstate" ".uidvalidity")))))))

View file

@ -0,0 +1,136 @@
(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.")))