From 6445a90dfd23ccb875451a23ba4027ef9cf6b1d6 Mon Sep 17 00:00:00 2001 From: Tom Willemse Date: Wed, 12 Jul 2023 15:46:05 -0700 Subject: [PATCH] Add notmuch configuration to guix-home --- oni/home/config/rincewind.scm | 11 ++- oni/home/services/notmuch.scm | 136 ++++++++++++++++++++++++++++++++++ 2 files changed, 146 insertions(+), 1 deletion(-) create mode 100644 oni/home/services/notmuch.scm diff --git a/oni/home/config/rincewind.scm b/oni/home/config/rincewind.scm index ade01fc..d095fb1 100644 --- a/oni/home/config/rincewind.scm +++ b/oni/home/config/rincewind.scm @@ -71,6 +71,9 @@ 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"))))))) diff --git a/oni/home/services/notmuch.scm b/oni/home/services/notmuch.scm new file mode 100644 index 0000000..f4a6232 --- /dev/null +++ b/oni/home/services/notmuch.scm @@ -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.")))