search: Parse boolean terms in search query.

* tissue/search.scm: Import (ice-9 match).
(make-query-parser): New function.
(%prefixes, %boolean-prefixes, query-parser): New variables.
(parse-query): Use query-parser.

1 files changed, 33 insertions, 10 deletions

diff --git a/tissue/search.scm b/tissue/search.scm
index eb325a4..08dd7f2 100644
--- a/tissue/search.scm
+++ b/tissue/search.scm
@@ -18,6 +18,7 @@
 
 (define-module (tissue search)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
   #:use-module (tissue document)
   #:use-module (tissue issue)
   #:use-module (tissue utils)
@@ -30,20 +31,42 @@
             search-fold
             search-map))
 
+(define (make-query-parser stemmer prefixes boolean-prefixes)
+  "Return a query parser with STEMMER, PREFIXES and
+BOOLEAN-PREFIXES. PREFIXES and BOOLEAN-PREFIXES are association lists
+mapping field names to prefixes."
+  (let ((query-parser (new-QueryParser)))
+    (QueryParser-set-stemmer query-parser stemmer)
+    (for-each (match-lambda
+                ((field . prefix)
+                 (QueryParser-add-prefix query-parser field prefix)))
+              prefixes)
+    (for-each (match-lambda
+                ((field . prefix)
+                 (QueryParser-add-boolean-prefix query-parser field prefix)))
+              boolean-prefixes)
+    query-parser))
+
+(define %prefixes
+  '(("title" . "S")))
+
+(define %boolean-prefixes
+  '(("type" . "XT")
+    ("creator" . "A")
+    ("lastupdater" . "XA")
+    ("assigned" . "XI")
+    ("keyword" . "K")
+    ("tag" . "K")
+    ("is" . "XS")))
+
+(define query-parser
+  (make-query-parser (make-stem "en") %prefixes %boolean-prefixes))
+
 (define (parse-query search-query)
   "Parse SEARCH-QUERY and return a xapian Query object."
   (if (string-blank? search-query)
       (Query-MatchAll)
-      (xapian:parse-query search-query
-                          #:stemmer (make-stem "en")
-                          #:prefixes '(("type" . "XT")
-                                       ("title" . "S")
-                                       ("creator" . "A")
-                                       ("lastupdater" . "XA")
-                                       ("assigned" . "XI")
-                                       ("keyword" . "K")
-                                       ("tag" . "K")
-                                       ("is" . "XS")))))
+      (QueryParser-parse-query query-parser search-query)))
 
 (define* (search-fold proc initial db search-query
                       #:key (offset 0) (maximum-items (database-document-count db)))