1 ;;; mumi -- Mediocre, uh, mail interface
2 ;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
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.
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.
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/>.
18 (define-module (mumi web view html
)
20 #:use-module
(mumi messages
)
21 #:use-module
(mumi web view utils
)
22 #:use-module
(srfi srfi-1
)
28 (define* (layout #:key
(head '()) (body '()))
32 (title "Guix patches")
33 (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8")))
34 (meta (@ (http-equiv "Content-Language") (content "en")))
35 (meta (@ (name "author") (content "Ricardo Wurmus")))
36 (meta (@ (name "viewport")
37 (content "width=device-width, initial-scale=1")))
42 (href "/css/reset.css")))
47 (href "/css/bootstrap.css")))
53 (href "/css/screen.css"))))
57 '(div (@ (id "header"))
58 (div (@ (class "container"))
59 (div (@ (class "row"))
67 (div (@ (class "container"))
70 (p "This is a web frontend to the Guix patch submission tracker. Send email to "
71 (a (@ (href "mailto:guix-packages@gnu.org"))
72 "guix-packages@gnu.org")
73 " to submit your patches.")
74 (p "This frontend is powered by "
75 (a (@ (href "http://www.djcbsoftware.nl/code/mu"))
78 (form (@ (id "search-patches")
81 (div (@ (class "form-group"))
82 (input (@ (type "text")
85 (placeholder "input search query"))))
86 (button (@ (type "submit")
87 (class "btn btn-lg btn-primary btn-block"))
94 (div (@ (class "container"))
95 (h1 "Patch not found")
96 (p "There is no patch with id " (strong ,id
))
97 (p (a (@ (href "/")) "Try another one?"))))))
99 (define (patch-page id messages
)
100 (define parts
(participants messages
))
101 (define (show-message message
)
102 `((div (@ (class "row"))
103 (div (@ (class "avatar col-md-1")
104 (style ,(string-append "background-color:"
105 (avatar-color (sender message
) parts
))))
106 ,(string-upcase (string-take (sender message
) 1)))
107 (div (@ (class "message col-md-11"))
108 (div (@ (class "panel panel-default"))
109 (div (@ (class "panel-heading"))
110 (div (@ (class "from"))
111 (span (@ (class "address"))
114 (span (@ (class "date"))
115 ,(strftime "%B %d, %Y" (localtime (mu:timestamp message
)))))
116 (div (@ (class "details"))
117 (div (@ (class "recipients"))
118 (label "Recipients:")
119 ,(map (lambda (address)
120 `(span (@ (class "address")) ,address
))
121 (recipients message
)))
122 (div (@ (class "message-id"))
123 (label "Message-ID:")
124 ,(mu:message-id message
))))
125 (div (@ (class "body panel-body"))
126 ,(prettify (mu:body-txt message
))))))
127 ,(if (closing? message
)
128 '(div (@ (class "row event"))
129 (div (@ (class "col-md-offset-1 col-md-11 text-center"))
130 (div (@ (class "label label-primary closed"))
136 (div (@ (class "container"))
137 (div (@ (class "row"))
138 (h1 ,(mu:subject
(car messages
))))
139 (div (@ (class "row"))
140 (div (@ (class "conversation col-md-9"))
141 ,(map show-message
(filter mu
:body-txt messages
)))
142 (div (@ (class "info col-md-3"))
143 (div (@ (class "stat"))
144 ,@(let ((num (length parts
)))
145 `((label ,(if (= num
1)
147 (string-append (number->string num
)
149 (ul ,(map (lambda (address)
150 `(li (span (@ (class "address")))
153 (div (@ (class "stat"))
155 ,(or (owner messages
) "unassigned"))
156 (div (@ (class "stat"))
158 ,(status messages
))))
159 (div (@ (class "row"))
160 (p "To comment on this conversation "
161 (a (@ (href ,(string-append "mailto:" id
"@debbugs.gnu.org?subject="
162 (mu:subject
(last messages
)))))
163 ,(string-append "send email to "
164 id
"@debbugs.gnu.org"))))))))
166 (define (patch-list query messages
)
170 (div (@ (class "container"))
171 (h1 "Patches matching " (code ,query
))
172 ,(if (null? messages
)
173 `(p (a (@ (href "/"))
174 "There are no patches matching your query, but we have many more!"))
175 `(table (@ (class "table-condensed"))
179 (th "Date submitted")))
182 (let ((id (patch-id msg
)))
186 `(a (@ (href ,(string-append "/patch/" id
)))
189 (td ,(strftime "%B %d, %Y" (localtime (mu:timestamp msg
)))))))