tests/xapian: Add phrase search test.
[software/mumi.git] / tests / xapian.scm
1 ;;; mumi -- Mediocre, uh, mail interface
2 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
3 ;;;
4 ;;; This program is free software: you can redistribute it and/or
5 ;;; modify it under the terms of the GNU Affero General Public License
6 ;;; as published by the Free Software Foundation, either version 3 of
7 ;;; the License, or (at your option) any later version.
8 ;;;
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;;; Affero General Public License for more details.
13 ;;;
14 ;;; You should have received a copy of the GNU Affero General Public
15 ;;; License along with this program. If not, see
16 ;;; <http://www.gnu.org/licenses/>.
17
18 (define-module (test-xapian)
19 #:use-module (mumi xapian)
20 #:use-module (mumi test-utils)
21 #:use-module (srfi srfi-19)
22 #:use-module (srfi srfi-64)
23 #:use-module (ice-9 match))
24
25 (test-begin "xapian")
26
27 (define (time->datestamp time)
28 (date->string (time-utc->date time) "~Y~m~d"))
29
30 (define sanitize
31 (@@ (mumi xapian) sanitize-date-range))
32
33 (test-equal "sanitize-date-range: turns \"today\" into datestamp"
34 (sanitize "date:today..today")
35 (let ((today (time->datestamp (current-time))))
36 (format #f "date:~a..~a" today today)))
37
38 (test-equal "sanitize-date-range: turns \"now\" into datestamp"
39 (sanitize "date:today..now")
40 (let ((today (time->datestamp (current-time))))
41 (format #f "date:~a..~a" today today)))
42
43 (test-equal "sanitize-date-range: turns \"yesterday\" into datestamp"
44 (sanitize "date:yesterday..today")
45 (let* ((today (current-time))
46 (yesterday (subtract-duration today (make-time time-duration 0 (* 60 60 24)))))
47 (format #f "date:~a..~a"
48 (time->datestamp yesterday)
49 (time->datestamp today))))
50
51 (test-equal "sanitize-date-range: pads short dates"
52 (sanitize "date:20..19")
53 "date:20000000..19000000")
54
55 (test-equal "sanitize-date-range: turns 1m into datestamp one month ago"
56 (sanitize "date:1m..now")
57 (let* ((today (current-time))
58 (1m (subtract-duration today (make-time time-duration 0 (* 60 60 24 30)))))
59 (format #f "date:~a..~a"
60 (time->datestamp 1m)
61 (time->datestamp today))))
62
63 (define tokenize
64 (@@ (mumi xapian) tokenize))
65
66 (test-equal "tokenize: keeps phrases intact 1"
67 (tokenize "subject:\"hello world\" how are you")
68 '("subject:\"hello world\"" "how" "are" "you"))
69
70 (test-equal "tokenize: keeps phrases intact 2"
71 (tokenize "subject:\"hello world\" how \"are\" you")
72 '("subject:\"hello world\"" "how" "\"are\"" "you"))
73
74 (define data-dir
75 (string-append (getenv "abs_top_srcdir") "/tests/data"))
76 (define db-dir (tmpnam))
77 (mkdir db-dir)
78
79 (mock ((mumi config) %config
80 (match-lambda
81 ('cache-ttl 10)
82 ('db-dir db-dir)
83 ('data-dir data-dir)
84 ('packages '("guix"))))
85 (index! #:full? #t)
86 (dynamic-wind
87 (lambda () #t)
88 (lambda ()
89 (test-equal "search: finds simple strings"
90 '("33299")
91 (search "hello" #:pagesize 2))
92 (test-equal "search: supports submitter prefix with partial name"
93 '("26095")
94 (search "submitter:Ricardo" #:pagesize 2))
95 (test-equal "search: supports submitter prefix with partial email address"
96 '("26095")
97 (search "submitter:rekado" #:pagesize 2))
98 (test-equal "search: supports submitter prefix with phrase"
99 '("26095")
100 (search "submitter:\"Ricardo Wurmus\"" #:pagesize 2))
101 (test-equal "search: supports author prefix with email address"
102 '("26095" "33299")
103 (search "author:ludo" #:pagesize 2)))
104 (lambda ()
105 (delete-file-recursively db-dir))))
106
107 (test-end "xapian")