summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--mumi/messages.scm69
1 files changed, 69 insertions, 0 deletions
diff --git a/mumi/messages.scm b/mumi/messages.scm
index 00f80fd..5110de9 100644
--- a/mumi/messages.scm
+++ b/mumi/messages.scm
@@ -331,6 +331,48 @@ of message parts."
matches)) amount)))
(soap-invoke* (%config 'debbugs) get-status ids)))
+(define (ago unit amount)
+ "Return the point in time that lies AMOUNT UNITs in the past."
+ (let ((amount* (match unit
+ ('hours amount)
+ ('days (* 24 amount))
+ ('weeks (* 24 7 amount))
+ ('months (* 24 30 amount))
+ ('years (* 24 365 amount)))))
+ (subtract-duration (date->time-utc (current-date))
+ (make-time time-duration 0 (* 60 60 amount*)))))
+
+(define (date-term->epoch-seconds term)
+ "Convert a date search term string into seconds since the epoch, or
+return #F if the term is invalid."
+ (match term
+ ("now" 'now)
+ ("today" (time-second (ago 'days 1)))
+ ("yesterday" (time-second (ago 'days 2)))
+ (_
+ (cond
+ ;; TODO: support more date template strings
+ ((or (false-if-exception (string->date term "~Y~m~d"))
+ (false-if-exception (string->date term "~Y-~m-~d")))
+ => (lambda (date)
+ (time-second (date->time-utc date))))
+ ;; e.g. "12h" meaning "12 hours ago"
+ ((string->number (string-drop-right term 1))
+ => (lambda (amount)
+ (match (string-take-right term 1)
+ ("h"
+ (time-second (ago 'hours amount)))
+ ("d"
+ (time-second (ago 'days amount)))
+ ("w"
+ (time-second (ago 'weeks amount)))
+ ("m"
+ (time-second (ago 'months amount)))
+ ("y"
+ (time-second (ago 'years amount)))
+ (_ #f))))
+ (else #f)))))
+
(define-public (process-query query)
"Process the QUERY string and return two values: the remaining
unprocessed query string and an alist of search attributes."
@@ -352,6 +394,33 @@ unprocessed query string and an alist of search attributes."
#:attributes ,attrs
#:filters
,(cons (negate bug-done) fs)))
+ ;; "date" for submission date, "mdate" for message date.
+ (((and (or "date" "mdate") type) when)
+ (let ((date-attribute (match type
+ ("date" 'date)
+ ("mdate" '@cdate)))
+ (pat "(yesterday|today|now|[1-9][0-9]*(h|d|w|m|y)|[0-9]+)"))
+ (or (match (map (compose date-term->epoch-seconds
+ match:substring)
+ (list-matches pat when))
+ ((and ((? number? start)
+ (? number? end))
+ range)
+ (match (sort range <)
+ ((start end)
+ `(#:terms ,terms
+ #:attributes ,(cons `(,date-attribute >< ,start ,end) attrs)
+ #:filters ,fs))))
+ ((or ('now (? number? since))
+ ((? number? since) 'now))
+ `(#:terms ,terms
+ #:attributes ,(cons `(,date-attribute > ,since) attrs)
+ #:filters ,fs))
+ (_ #f))
+ ;; Invalid, don't do anything.
+ `(#:terms ,terms
+ #:attributes ,attrs
+ #:filters ,fs))))
(("title" title)
`(#:terms ,terms
#:attributes ,(cons `(subject string-contains ,title) attrs)