Clean up checking prefixes in notmuch configuration

oni/home/config/rincewind.scm

@@ -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")))))))

oni/home/services/notmuch.scm

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