Add tests.
[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 (srfi srfi-19)
21 #:use-module (srfi srfi-64))
22
23 (define-syntax-rule (mock (module proc replacement) body ...)
24 "Within BODY, replace the definition of PROC from MODULE with the definition
25 given by REPLACEMENT."
26 (let* ((m (resolve-module 'module))
27 (original (module-ref m 'proc)))
28 (dynamic-wind
29 (lambda () (module-set! m 'proc replacement))
30 (lambda () body ...)
31 (lambda () (module-set! m 'proc original)))))
32
33 (test-begin "xapian")
34
35 (define (time->datestamp time)
36 (date->string (time-utc->date time) "~Y~m~d"))
37
38 (define sanitize
39 (@@ (mumi xapian) sanitize-date-range))
40
41 (test-equal "sanitize-date-range: turns \"today\" into datestamp"
42 (sanitize "date:today..today")
43 (let ((today (time->datestamp (current-time))))
44 (format #f "date:~a..~a" today today)))
45
46 (test-equal "sanitize-date-range: turns \"now\" into datestamp"
47 (sanitize "date:today..now")
48 (let ((today (time->datestamp (current-time))))
49 (format #f "date:~a..~a" today today)))
50
51 (test-equal "sanitize-date-range: turns \"yesterday\" into datestamp"
52 (sanitize "date:yesterday..today")
53 (let* ((today (current-time))
54 (yesterday (subtract-duration today (make-time time-duration 0 (* 60 60 24)))))
55 (format #f "date:~a..~a"
56 (time->datestamp yesterday)
57 (time->datestamp today))))
58
59 (test-equal "sanitize-date-range: pads short dates"
60 (sanitize "date:20..19")
61 "date:20000000..19000000")
62
63 (test-equal "sanitize-date-range: turns 1m into datestamp one month ago"
64 (sanitize "date:1m..now")
65 (let* ((today (current-time))
66 (1m (subtract-duration today (make-time time-duration 0 (* 60 60 24 30)))))
67 (format #f "date:~a..~a"
68 (time->datestamp 1m)
69 (time->datestamp today))))
70
71 (test-end "xapian")