diff options
| -rw-r--r-- | mumi/messages.scm | 69 |
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) |