Add notmuch configuration to guix-home

1 files changed, 136 insertions, 0 deletions

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