Initial commit.
[software/mumi.git] / mumi / messages.scm
1 ;;; mumi -- Mediocre, uh, mail interface
2 ;;; Copyright © 2017 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 (mumi messages)
19 #:use-module (mu)
20 #:use-module (srfi srfi-1)
21 #:use-module (srfi srfi-26)
22 #:use-module (ice-9 optargs)
23 #:use-module (ice-9 regex)
24 #:use-module (ice-9 match)
25 #:use-module (mumi queries))
26
27 (define-public (extract-address str)
28 "Extract an email address from an address string."
29 (let ((m (string-match ".*<([^@]+@[^>]+)>" str)))
30 (if m (match:substring m 1) str)))
31
32 (define-public (recipients message)
33 "Return a list of recipient email addresses for the given MESSAGE."
34 (append-map (lambda (address-string)
35 (map (compose extract-address string-trim)
36 (string-split address-string #\,)))
37 (filter identity (list (mu:to message)
38 (mu:cc message)
39 (mu:bcc message)))))
40
41 (define-public sender (compose extract-address mu:from))
42
43 (define-public (participants messages)
44 "Return a list of unique email addresses in the conversion."
45 (apply lset-adjoin string= '()
46 (map sender messages)))
47
48 ;; TODO: build a different version of "mu index" to also index
49 ;; X-GNU-PR-* headers?
50
51 (define-public (action message)
52 "Return the debbugs action MESSAGE."
53 (mu:header message "X-GNU-PR-Message"))
54
55 (define-public (report? message)
56 (let ((action (action message)))
57 (and action (string-prefix? "report " action))))
58
59 ;; We cannot rely on the action header alone.
60 (define-public (closing? message)
61 (let ((action (action message)))
62 (or (and action (string-prefix? "cc-closed " action))
63 (find (cut string-suffix? "-done@debbugs.gnu.org" <>)
64 (recipients message)))))
65
66 (define-public (owner? message)
67 (let ((action (action message)))
68 (and action (string-prefix? "owner " action))))
69
70 (define-public (owner messages)
71 "Return the owner of this patch or #F if unassigned."
72 (and=> (find owner? messages)
73 sender))
74
75 (define-public (patch-messages id)
76 "Return list of messages relating to the patch ID."
77 (let ((address (string-append id "@debbugs.gnu.org"))
78 (done (string-append id "-done@debbugs.gnu.org")))
79 (sort-list (mu:message-list (query-or (string-append "recip:" address)
80 (string-append "recip:" done)))
81 (lambda (a b) (< (mu:date a) (mu:date b))))))
82
83 (define-public (patch-report id)
84 "Return the original report for the MESSAGE associated with the
85 given patch ID, or return #F."
86 (let* ((address (string-append id "@debbugs.gnu.org"))
87 (reports (filter report? (mu:message-list
88 (string-append "to:" address)))))
89 (if (null? reports) #f (car reports))))
90
91 (define-public (unique-reports messages)
92 "Return a list of original reports for all given MESSAGES."
93 (let ((unique-ids (apply lset-adjoin string= '()
94 (map patch-id messages))))
95 (sort-list (filter-map patch-report unique-ids)
96 ;; Newest first
97 (lambda (a b) (> (mu:date a) (mu:date b))))))
98
99 (define-public (patch-id message)
100 "Return the patch number from the given MESSAGE."
101 (or (and=> (action message)
102 (compose number->string string->number last string-tokenize))
103 (let ((address (find (cut string-suffix? "@debbugs.gnu.org" <>)
104 (recipients message))))
105 (and=> address
106 (lambda (address)
107 (first (string-split (first (string-split address #\@)) #\-)))))
108 "UNKNOWN"))
109
110 (define*-public (patch-actions messages)
111 "Return a list of actions for the given patch ID or the set of
112 MESSAGES. Ignore follow events."
113 (filter (cut string-prefix? "followup " <>)
114 (filter-map action messages)))
115
116 ;; TODO: can a bug be reopened again?
117 (define-public (status messages)
118 (if (find closing? messages) "closed" "open"))
119
120 (define*-public (all-patches #:optional messages)
121 "Return all messages that are of the report action type."
122 (filter report? (or messages (mu:message-list))))