[PATCH] emacs: add notmuch-expr, sexp-style queries

[Tom Fitzhenry <tom@tom-fitzhenry.me.uk>]

From: Tom Fitzhenry <tomfitzhenry@google.com>

notmuch-expr allows you to write notmuch search queries in sexp style like:

(notmuch-expr
  '(and
    (to "emacs-devel")
    "info manual"
    (or
      (not (is "spam"))
      (is "important"))))

which will generate the textual query:

"to:emacs-devel AND (NOT is:spam OR is:important) AND \"info manual\""
---
 emacs/Makefile.local       |   1 +
 emacs/notmuch-expr-test.el |  75 ++++++++++++++++++++++++
 emacs/notmuch-expr.el      | 117 +++++++++++++++++++++++++++++++++++++
 emacs/notmuch.el           |   1 +
 4 files changed, 194 insertions(+)
 create mode 100644 emacs/notmuch-expr-test.el
 create mode 100644 emacs/notmuch-expr.el

diff --git a/emacs/Makefile.local b/emacs/Makefile.local
index 141f5868..32f55388 100644
--- a/emacs/Makefile.local
+++ b/emacs/Makefile.local
@@ -22,6 +22,7 @@ emacs_sources := \
 	$(dir)/notmuch-version.el \
 	$(dir)/notmuch-jump.el \
 	$(dir)/notmuch-company.el \
+	$(dir)/notmuch-expr.el \
 	$(dir)/notmuch-draft.el
 
 elpa_sources := ${emacs_sources} $(dir)/notmuch-pkg.el
diff --git a/emacs/notmuch-expr-test.el b/emacs/notmuch-expr-test.el
new file mode 100644
index 00000000..3e13f545
--- /dev/null
+++ b/emacs/notmuch-expr-test.el
@@ -0,0 +1,75 @@
+(require 'ert)
+(require 'notmuch-expr)
+
+(ert-deftest and ()
+  (should
+    (equal
+      "(\"valued\" AND is:unread AND from:spam@example.com)"
+      (notmuch-expr
+       '(and
+         "valued"
+         (is "unread")
+         (from "spam@example.com"))))))
+
+(ert-deftest body ()
+  (should
+   (equal
+    "(body:wallace AND from:gromit)"
+    (notmuch-expr
+     '(and
+       (body "wallace")
+       (from "gromit"))))))
+
+(ert-deftest regex ()
+  (should
+   (equal
+    "(subject:\"/Ca+sh/\" AND NOT is:important)"
+    (notmuch-expr
+     '(and
+       (subject "/Ca+sh/")
+       (not (is "important")))))))
+
+(ert-deftest precedence ()
+  (should
+   (equal
+    "(to:emacs-devel AND (NOT is:spam OR is:important))"
+    (notmuch-expr
+     '(and
+       (to "emacs-devel")
+       (or
+         (not (is "spam"))
+         (is "important")))))))
+
+(ert-deftest xor ()
+  (should
+   (equal
+    "is:inbox XOR is:sent"
+    (notmuch-expr
+     '(xor
+       (is "inbox")
+       (is "sent"))))))
+
+(ert-deftest literal ()
+  (should
+   (equal
+    "(is:inbox OR from:foo)"
+    (notmuch-expr
+     '(or
+       (is "inbox")
+       (literal "from:foo"))))))
+
+(ert-deftest string ()
+  (should
+   (equal
+    "(is:inbox OR \"from:foo\")"
+    (notmuch-expr
+     '(or
+       (is "inbox")
+       "from:foo")))))
+
+(ert-deftest tag-with-spaces ()
+  (should
+   (equal
+    "is:\"a tag\""
+    (notmuch-expr
+     '(tag "a tag")))))
diff --git a/emacs/notmuch-expr.el b/emacs/notmuch-expr.el
new file mode 100644
index 00000000..b6ba442a
--- /dev/null
+++ b/emacs/notmuch-expr.el
@@ -0,0 +1,117 @@
+;;; notmuch-expr.el --- An S-exp library for building notmuch search queries -*- lexical-binding: t; -*-
+
+;; Author: Tom Fitzhenry <tomfitzhenry@google.com>
+;; Package-Requires: ((emacs "24.1"))
+;; URL: https://notmuchmail.org
+
+;;; Commentary:
+
+;; This package provides a way to build notmuch search queries via s-expressions.
+;;
+;; For example, rather than write:
+
+;;     "to:emacs-devel AND (NOT is:spam OR is:important) AND \"info manual\""
+;;
+;; this package allows you to generate the same query via s-expressions:
+;;
+;; (notmuch-expr
+;;  '(and
+;;    (to "emacs-devel")
+;;    "info manual"
+;;    (or
+;;      (not (is "spam"))
+;;      (is "important"))))
+;;
+;; See notmuch-expr-test.el for more examples.
+;;
+;; Some search terms are unsupported. To use those, use the `literal' atom.
+;; For example: (literal "folder:spam")
+;;
+;; man page: notmuch-search-terms(7).
+;; The generated search query may change across different versions.
+
+;;; Code:
+
+(defmacro notmuch-expr (query)
+  "Compile an sexp QUERY into a textual notmuch query."
+  `(notmuch-expr--eval ,query))
+
+(defun notmuch-expr--eval (expr)
+  (pcase expr
+    (`(tag ,s)     (notmuch-expr--is s))
+    (`(is ,s)      (notmuch-expr--is s))
+    (`(from ,s)    (notmuch-expr--from s))
+    (`(to ,s)      (notmuch-expr--to s))
+    (`(body ,s)    (notmuch-expr--body s))
+    (`(subject ,s) (notmuch-expr--subject s))
+
+    ;; Boolean operators.
+    (`(and . ,clauses) (notmuch-expr--and clauses))
+    (`(or . ,clauses)  (notmuch-expr--or clauses))
+    (`(not ,clause)    (notmuch-expr--not clause))
+    (`(xor ,c1 ,c2)    (notmuch-expr--xor c1 c2))
+
+    ;; Provide an escape-hatch.
+    (`(literal ,s) (notmuch-expr--literal s))
+
+    ;; Otherwise, quote.
+    (s (notmuch-expr--quote s))))
+
+(defun notmuch-expr--and (clauses)
+  (concat
+   "("
+   (mapconcat 'notmuch-expr--eval clauses " AND ")
+   ")"))
+
+(defun notmuch-expr--or (clauses)
+  (concat
+   "("
+   (mapconcat 'notmuch-expr--eval clauses " OR ")
+   ")"))
+
+(defun notmuch-expr--not (clauses)
+  (concat "NOT " (notmuch-expr--eval clauses)))
+
+(defun notmuch-expr--xor (c1 c2)
+  (concat
+   (notmuch-expr--eval c1)
+   " XOR "
+   (notmuch-expr--eval c2)))
+
+(defun notmuch-expr--body (s)
+  (concat "body:"
+          (notmuch-expr--leaf s)))
+
+(defun notmuch-expr--subject (s)
+  (concat "subject:"
+          (notmuch-expr--leaf s)))
+
+(defun notmuch-expr--from (f)
+  (concat "from:"
+          (notmuch-expr--leaf f)))
+
+(defun notmuch-expr--to (f)
+  (concat "to:"
+          (notmuch-expr--leaf f)))
+
+(defun notmuch-expr--is (expr)
+  (concat "is:"
+          (notmuch-expr--leaf expr)))
+
+(defun notmuch-expr--leaf (s)
+  (if (string-match-p "^[a-zA-Z0-9.@-]+$" s)
+      ;; Avoid ugly quoting.
+      ;; This is safe because the string is bound to a prefix
+      ;; and thus it won't be misinterpreted by notmuch.
+      s
+    (notmuch-expr--quote s)))
+
+(defun notmuch-expr--literal (s)
+  s)
+
+(defun notmuch-expr--quote (s)
+  ;; FIXME Escape s.
+  (concat "\"" s "\""))
+
+(provide 'notmuch-expr)
+;;; notmuch-expr.el ends here
diff --git a/emacs/notmuch.el b/emacs/notmuch.el
index a980c7a2..d25a28ea 100644
--- a/emacs/notmuch.el
+++ b/emacs/notmuch.el
@@ -79,6 +79,7 @@
 (require 'notmuch-maildir-fcc)
 (require 'notmuch-message)
 (require 'notmuch-parser)
+(require 'notmuch-expr)
 
 (defcustom notmuch-search-result-format
   `(("date" . "%12s ")
-- 
2.23.1