dotfiles/oni/home/services/notmuch.scm

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