path: root/mumi/web/view/html.scm

;;; mumi -- Mediocre, uh, mail interface
;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (mumi web view html)
  #:use-module (email email)
  #:use-module (mumi config)
  #:use-module (mumi debbugs)
  #:use-module (mumi messages)
  #:use-module (mumi web view utils)
  #:use-module (mumi web util)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-19)
  #:use-module (web uri)
  #:export (index
            help
            unknown
            error-page
            issue-page
            list-of-matching-bugs
            list-of-recent-issues
            list-of-forgotten-issues))

(define (bug-subject* bug)
  (or (bug-subject bug) "(no subject)"))

(define (status-tag bug)
  "Return a colored tag indicating the BUG status."
  (let ((status (if (bug-done bug) "Done" "Open")))
    `(span (@ (class ,(string-append "status-tag "
                                     (string-downcase status))))
           ,status)))

(define* (layout #:key
                 (head '())
                 (body '())
                 (title "Guix issue tracker"))
  `((doctype "html")
    (html (@ (data-theme "light") (lang "en"))
     (head
      (title ,title)
      (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8")))
      (meta (@ (name "author") (content "Ricardo Wurmus")))
      (meta (@ (name "viewport")
               (content "width=device-width, initial-scale=1")))
      (link
       (@ (rel "stylesheet")
          (media "screen")
          (type "text/css")
          (href "/css/mumi.css?20221220000000")))
      ,@head)
     (body ,@body
           (footer (@ (class "text-center"))
                   (p "Copyright © 2016—2022 by the GNU Guix community."
                      (br)
                      "Now with even more " (span (@ (class "lambda")) "λ") "! ")
                   (p "This is free software.  Download the "
                      (a (@ (href "https://git.elephly.net/software/mumi.git"))
                         "source code here") "."))
           (script
            (@ (src "/js/sort-table.js")))))))

(define* (search-form #:key (standalone? #f) (text ""))
  `(form (@ (id "search")
            ,(if standalone?
                 '(class "")
                 '(class "form-inline"))
            (action "/search"))
         (div
          (@ (class "input-group"))
          (input (@ (type "search")
                    (id   "query")
                    (name "query")
                    (value ,text)
                    (placeholder "Input your search query...")))
          (div
           (@ (id "search-hints"))
           (p "You can improve the search results by making use of the
simple query language.  Here is a list of supported query terms:")
           (table
            (tbody
             ,@(map (match-lambda
                      ((term description)
                       `(tr (td (span (@ (class "filter")) ,term))
                            (td ,description))))
                    '(("is:open" "open issues")
                      ("is:done" "closed issues")
                      ("submitter:<who>" "search issue submitter")
                      ("author:<who>" "search by message author")
                      ("date:yesterday..now" "search by issue date")
                      ("mdate:3m..2d" "search by message date")))))))))

(define* (search-widget #:key (text ""))
  `(div
    ,(search-form #:standalone? #t #:text text)
    (details
     (summary (strong "Hint"))
     (p
      "Refine your search with filters like "
      (span (@ (class "filter"))
            "is:open")
      ", "
      (span (@ (class "filter"))
            "author:me")
      ", "
      (span (@ (class "filter"))
            "submitter:me")
      ", "
      (span (@ (class "filter"))
            "severity:serious")
      ", "
      (span (@ (class "filter"))
            "tag:easy")
      ", "
      (span (@ (class "filter"))
            "date:2d..now")
      ", "
      (span (@ (class "filter"))
            "date:2012-04-18..2022-04-18")
      ", "
      (span (@ (class "filter"))
            "date:1m..today")
      ", and "
      (a (@ (href "help#search"))
         "many more!")))))

(define logo
  '(svg
    (@ (width "97.896")
       (height "34.396")
       (viewBox"0 0 97.896 34.396")
       (xmlns "http://www.w3.org/2000/svg")
       (xmlns:xlink "http://www.w3.org/1999/xlink"))
    (defs
      (linearGradient
       (@ (id "lg1")
          (x1 "142.97")
          (x2 "176.6")
          (y1 "63.656")
          (y2 "70.667")
          (gradientTransform "matrix(.23496 0 0 .23496 65.67 125.11)")
          (gradientUnits "userSpaceOnUse")
          (xlink:href "#lg2")) "")
      (linearGradient
       (@ (id "lg2"))
       (stop
        (@ (stop-color "#f00")
           (stop-opacity "0.58431")
           (offset "0")))
       (stop
        (@ (stop-color "#fc0")
           (offset "1"))))
      (linearGradient
       (@ (id "lg3")
          (x1 "113.51")
          (x2 "78")
          (y1 "1004.8")
          (y2 "922.07")
          (gradientTransform "matrix(.23496 0 0 .23496 65.662 -75.155)")
          (gradientUnits "userSpaceOnUse")
          (xlink:href "#lg2")) "")
      (linearGradient
       (@ (id "lg4")
          (x1 "108.09")
          (x2 "80.655")
          (y1 "1025.7")
          (y2 "1043.7")
          (gradientTransform "matrix(-.13157 0 0 .13157 102.74 23.454)")
          (gradientUnits "userSpaceOnUse"))
       (stop (@ (stop-color "#ffb638")
                (offset "0")))
       (stop (@ (stop-color "#f0ae26")
                (offset "1"))))
      (linearGradient
       (@ (id "lg5")
          (x1 "142.97")
          (x2 "177.04")
          (y1 "63.656")
          (y2 "69.791")
          (gradientTransform "matrix(-.23496 0 0 .23496 113.39 125.11)")
          (gradientUnits "userSpaceOnUse")
          (xlink:href "#lg2")) ""))
    (g
     (@ (transform "translate(-56.102 -131.49)"))
     (path
      (@ (d "m108.81 136.28c-0.42374 0.77444-0.85393 1.4049-1.2923 1.9017-0.42373 0.48221-0.891 0.86789-1.4024 1.1601-0.4968 0.27763-1.0605 0.47787-1.6888 0.59473-0.61369 0.10229-1.3183 0.15423-2.122 0.1542-0.59281 0-1.1256-0.0304-1.5933-0.0881h-7e-3c-0.0593-4e-3 -0.18178-0.0241-0.30839-0.0441-0.13335-0.0209-0.26966-0.041-0.4846-0.0808-3.9399-0.72898-5.2466 2.0062-5.5289 2.7608-0.04419 0.11811-0.06608 0.1909-0.06608 0.1909l-4.7873 13.349-2.937 4.9929h5.8666c2.4095-5.3648 4.726-16.566 7.203-17.556 0.53688 0.0751 1.2024 0.11012 2.0045 0.11012 1.052 0 1.994-0.12613 2.8268-0.38915 0.83285-0.26302 1.582-0.67095 2.2541-1.2262 0.67213-0.56983 1.2803-1.2966 1.8209-2.1734 0.55523-0.87667 1.0818-1.9299 1.5786-3.1572l-1.3363-0.4993z")
         (fill "#ffbf2d")) "")
     (path
      (@ (d "m108.81 136.28c-0.42374 0.77443-0.8539 1.404-1.2922 1.9008-0.42373 0.4822-0.89119 0.86807-1.4026 1.1603-0.12303 0.0687-0.24987 0.13192-0.38107 0.19111-1e-3 0-2e-3 3e-3 -3e-3 3e-3 -0.16514 0.11615-0.37756 0.21584-0.66546 0.28437-3.3205 0.7906-5.5822 3.7498-5.7946 4.036 0.09632-0.0792 0.19328-0.14386 0.29007-0.19339 0.01455-8e-3 0.02866-0.0148 0.04323-0.0217 0.0024 0 0.0045-3e-3 0.0068-3e-3 0.01688-8e-3 0.0343-0.0148 0.05119-0.0217 0.53688 0.0751 1.2022 0.11033 2.0043 0.11033 1.052 0 1.9939-0.12716 2.8268-0.39015 0.83286-0.26302 1.5813-0.6699 2.2535-1.2252 0.67213-0.56984 1.2806-1.2971 1.8212-2.1738 0.55524-0.8767 1.0821-1.9304 1.5789-3.1578l-1.3366-0.49824z")
         (fill "url(#lg1)")) "")
     (path
      (@ (d "m70.244 136.28c0.42374 0.77444 0.85393 1.4049 1.2923 1.9017 0.42374 0.48221 0.89101 0.86789 1.4024 1.1601 0.4968 0.27763 1.0605 0.47787 1.6888 0.59473 0.61369 0.10232 1.3183 0.15423 2.122 0.1542 0.59281 0 1.1256-0.0304 1.5933-0.0881h0.0074c0.0593-4e-3 0.18177-0.0241 0.30838-0.0441 0.13335-0.0209 0.26966-0.041 0.4846-0.0808 3.9399-0.72898 5.2466 2.0062 5.5289 2.7608 0.04419 0.11811 0.06608 0.1909 0.06608 0.1909l4.7873 13.349 2.937 4.9929h-5.8666c-2.4095-5.3648-4.726-16.566-7.203-17.556-0.53688 0.0751-1.2024 0.11012-2.0045 0.11012-1.052 0-1.994-0.12613-2.8268-0.38915-0.83286-0.26302-1.582-0.67095-2.2541-1.2262-0.67213-0.56983-1.2803-1.2966-1.8209-2.1734-0.55524-0.87667-1.0818-1.9299-1.5786-3.1572l1.3363-0.4993z")
         (fill "#ffbf2d")) "")
     (path
      (@ (d "m70.244 136.28c0.42374 0.77443 0.85393 1.4049 1.2923 1.9017 0.42374 0.4822 0.89101 0.86789 1.4024 1.1601 0.4968 0.27763 1.0605 0.47784 1.6888 0.59473 0.61369 0.10231 1.3183 0.15422 2.122 0.15417 0.59281 0 1.1256-0.0303 1.5933-0.0881h0.0074c0.0593-4e-3 0.18177-0.0243 0.30838-0.044 0.13335-0.0209 0.26967-0.041 0.4846-0.0808 3.9399-0.72898 5.2466 2.0062 5.5289 2.7608 0.04418 0.11811 0.06608 0.1909 0.06608 0.1909l4.7873 13.349 2.4671 4.9929h-5.3967c-2.4095-5.3648-4.726-16.566-7.203-17.556-0.53688 0.0751-1.2024 0.11012-2.0045 0.11012-1.052 0-1.994-0.12613-2.8268-0.38912-0.83286-0.26303-1.582-0.67096-2.2541-1.2262-0.67213-0.56984-1.2803-1.2967-1.8209-2.1734-0.55524-0.87667-1.0818-1.9299-1.5786-3.1572l1.3363-0.49929z")
         (fill "url(#lg3)")) "")
     (path
      (@ (d "m89.524 156.17-2.9255 4.995h5.8637")
         (fill "url(#lg4)")) "")
     (path
      (@ (d "m70.245 136.28-1.3366 0.49823c0.15525 0.38357 0.31332 0.75055 0.47436 1.1 0.0322 0.0699 0.06425 0.13851 0.09669 0.20704 1.27e-4 2.3e-4 -1.24e-4 0 0 0 0.03229 0.0682 0.06531 0.13562 0.09783 0.20246 0.01085 0.0222 0.02212 0.0439 0.03299 0.066 0.05454 0.11113 0.10863 0.22143 0.1638 0.32875h0.0011c0.03289 0.064 0.06585 0.12737 0.09897 0.18997 0.13355 0.25252 0.26892 0.49416 0.4061 0.72461 0.03425 0.0576 0.0679 0.11332 0.10238 0.16949 0.01336 0.0217 0.0264 0.0433 0.03981 0.0649 0.02133 0.0344 0.04342 0.0686 0.06484 0.10237 0.03379 0.0548 0.06692 0.10906 0.10124 0.16267 0.05468 0.0854 0.11121 0.16896 0.16722 0.2514 0.01413 0.0209 0.02786 0.0419 0.04209 0.0626 0.03554 0.0515 0.07086 0.10207 0.10693 0.15242 0.07177 0.10015 0.14456 0.19807 0.21841 0.29348 0.03693 0.0477 0.07404 0.0945 0.11148 0.14105 0.07488 0.093 0.15057 0.18365 0.22751 0.27189 0.05833 0.0669 0.11795 0.13266 0.17746 0.19679 0.01881 0.0204 0.03796 0.0403 0.05688 0.0603 0.07916 0.0836 0.15882 0.16471 0.24002 0.24345 0.0405 0.0393 0.08071 0.078 0.12172 0.11602 0.0412 0.0383 0.08228 0.0756 0.124 0.11263 0.04151 0.0368 0.08312 0.0724 0.12513 0.10806 0.12603 0.10411 0.25528 0.20312 0.38676 0.29689 0.35062 0.25005 0.72078 0.46355 1.1114 0.64045 0.04882 0.0222 0.09728 0.0439 0.14674 0.0648 0.09924 0.0421 0.19962 0.0819 0.30145 0.11946 0.05075 0.0188 0.10103 0.0359 0.15243 0.0535 0.0514 0.0175 0.10379 0.0347 0.15584 0.0512 0.05205 0.0164 0.10407 0.0324 0.15698 0.0478 0.10581 0.0307 0.21383 0.06 0.32306 0.0864 0.05461 0.0132 0.10948 0.0254 0.16494 0.0376 0.05547 0.0122 0.1109 0.0241 0.16722 0.0353 0.05668 0.0114 0.11309 0.0217 0.17063 0.0318 0.11435 0.0204 0.23031 0.0385 0.34808 0.0546 0.17666 0.0241 0.3571 0.0442 0.54147 0.0591 0.12292 0.0101 0.2479 0.018 0.37425 0.0238 0.12635 6e-3 0.2547 0.01 0.38449 0.0114h0.19566c0.10026 0 0.19861-3e-5 0.29462 0 0.19202-3e-3 0.37538-7e-3 0.55057-0.0138 0.08721-3e-3 0.17286-7e-3 0.25595-0.0114 0.08344-5e-3 0.16526-0.0101 0.24457-0.0159 0.23793-0.0172 0.45731-0.0389 0.65864-0.0671 0.01688 7e-3 0.03432 0.0138 0.05119 0.0217 0.0024 0 0.0045 3e-3 0.0068 3e-3 0.01458 7e-3 0.02867 0.014 0.04323 0.0217 0.09685 0.0496 0.19369 0.11414 0.29007 0.19338-0.21199-0.28567-2.4738-3.2453-5.7946-4.036-0.28789-0.0685-0.50031-0.16825-0.66546-0.2844-0.0013 0-0.0021-3e-3 -0.0034-3e-3 -0.1309-0.059-0.2583-0.12253-0.38108-0.19111-2.51e-4 -1.1e-4 -7.94e-4 1.3e-4 -0.0011 0-0.03168-0.018-0.06308-0.0369-0.09442-0.0557-2.48e-4 -1.4e-4 -7.93e-4 1e-4 -0.0011 0-0.03162-0.0191-0.062-0.0383-0.09328-0.058-0.0628-0.0396-0.12514-0.0803-0.18656-0.12284-0.03058-0.0212-0.06076-0.0429-0.091-0.0649-0.06091-0.0442-0.12021-0.0893-0.17973-0.1365-0.02956-0.0236-0.05838-0.0464-0.08759-0.0705-0.02943-0.0243-0.05851-0.0488-0.08759-0.0739-0.02887-0.0249-0.05679-0.0506-0.08532-0.0762-0.14265-0.12819-0.28108-0.26487-0.4152-0.4118-0.02682-0.0294-0.05428-0.0597-0.08077-0.0899-0.09747-0.11046-0.19453-0.2277-0.29121-0.3515-0.01204-0.0153-0.02326-0.031-0.03526-0.0466-0.02715-0.0353-0.05482-0.0706-0.0819-0.10692-0.13544-0.18169-0.26982-0.37711-0.40383-0.58584-0.0536-0.0835-0.10701-0.1692-0.16039-0.2571-0.02669-0.0439-0.05299-0.088-0.07963-0.13308-0.07966-0.13473-0.15968-0.27504-0.23888-0.41977z")
         (fill "url(#lg5)")) "")
     ;; "Guix"
     (g
      (path
       (@ (d "m112.5 159.96c-0.82977 0.40336-1.6912 0.70588-2.5844 0.90757-0.89316 0.20167-1.8151 0.3025-2.7659 0.3025-2.1493 0-3.8521-0.59928-5.1082-1.7978-1.2562-1.2043-1.8843-2.835-1.8843-4.8922 0-2.0802 0.63961-3.7167 1.9188-4.9094s3.0309-1.7892 5.2552-1.7892c0.85857 2e-5 1.6797 0.0807 2.4634 0.24201 0.78942 0.16137 1.5328 0.4005 2.23 0.71742v2.6708c-0.7203-0.4091-1.4377-0.7145-2.1522-0.91617-0.70876-0.20166-1.4204-0.30252-2.1349-0.30252-1.3253 0-2.3481 0.37166-3.0684 1.115-0.71452 0.73758-1.0718 1.7949-1.0718 3.1721 0 1.3656 0.34574 2.4201 1.0372 3.1635 0.69147 0.74335 1.6739 1.115 2.9474 1.115 0.34572 0 0.66553-0.0201 0.95941-0.0605 0.29963-0.0461 0.56757-0.11523 0.80383-0.20743v-2.5066h-2.0312v-2.23h5.186v6.2059")) "")
      (path
       (@ (d "m113.95 157.15v-5.9121h3.1116v0.96806c0 0.52438-3e-3 1.1842-9e-3 1.9793-6e-3 0.78946-9e-3 1.3167-9e-3 1.5818-1e-5 0.7779 0.0202 1.3397 0.0605 1.6854 0.0403 0.33999 0.10948 0.58774 0.20744 0.74332 0.12677 0.20169 0.29099 0.35726 0.49268 0.46675 0.20743 0.10951 0.44368 0.16423 0.70875 0.16423 0.64537 0 1.1524-0.24776 1.5212-0.74332 0.36877-0.49554 0.55317-1.1842 0.55318-2.0658v-4.7798h3.0943v9.6806h-3.0943v-1.4002c-0.46676 0.56471-0.96231 0.98246-1.4867 1.2533-0.51861 0.26506-1.092 0.39759-1.72 0.39759-1.1179 0-1.9707-0.34284-2.5584-1.0285-0.58199-0.68572-0.87298-1.6826-0.87298-2.9906")) "")
      (path
       (@ (d "m125.44 151.24h3.0943v9.6806h-3.0943v-9.6806m0-3.7685h3.0943v2.5239h-3.0943v-2.5239")) "")
      (path
       (@ (d "m133.98 155.97-3.4919-4.7279h3.2758l1.9793 2.8696 2.0053-2.8696h3.2758l-3.4919 4.7106 3.6648 4.97h-3.2758l-2.1781-3.0598-2.1522 3.0598h-3.2758l3.6648-4.9527")) "")))))

(define* (header #:key (search-bar? #t) title)
  `(nav
    (@ (class "container-fluid"))
    (ul
     (li
      (a (@ (href "/")) ,logo))
     ,@(if title
           `((li (span (@ (class "navbar-text")) ,title)))
           '()))
    ,@(if search-bar?
          `((ul (li ,(search-form))))
          '())))

(define (index)
  (layout
   #:body
   `(,(header #:search-bar? #f)
     (main
      (@ (class "container"))
      (h1 "Guix issue tracker")
      (p (@ (class "lead"))
         "This is a web frontend to the Guix patch and bug trackers.  Send email to "
         (a (@ (href ,(string-append "mailto:" (%config 'submission-email-address))))
            ,(%config 'submission-email-address))
         " to submit a patch, or email "
         (a (@ (href ,(string-append "mailto:" (%config 'submission-bug-email-address))))
            ,(%config 'submission-bug-email-address))
         " to submit a bug report.")
      ,(search-widget)

      (article
       (h4 "Recent activity "
           (small (a (@ (href "recent")) "(More)")))
       (table
        (@ (class "js-sort-table"))
        (thead
         (tr (@ (class "heading"))
             (th (@ (class "js-sort-number")) "ID")
             (th "Subject")
             (th "Date submitted")
             (th "Status")))
        (tbody
         ,@(list-of-bugs (recent-bugs 10)))))

      (article
       (h4 "Forgotten issues "
           (small (a (@ (href "forgotten")) "(More)")))
       (table
        (@ (class "js-sort-table"))
        (thead
         (tr (@ (class "heading"))
             (th (@ (class "js-sort-number")) "ID")
             (th "Subject")
             (th "Date submitted")
             (th "Status")))
        (tbody
         ,@(list-of-bugs (forgotten-issues 10)))))

      (article
       (h4 "Priority bugs")
       (table
        (@ (class "js-sort-table"))
        (thead
         (tr (@ (class "heading"))
             (th (@ (class "js-sort-number")) "ID")
             (th "Subject")
             (th "Date submitted")
             (th "Status")))
        (tbody
         ,@(priority-bugs))))))))

(define (help)
  (layout
   #:body
   `(,(header #:search-bar? #f)
     (main
      (@ (class "container"))
      (h1 "Help")
      (a (@ (href "search")))
      (p "You can improve the search results by making use of the
simple query language.  Here is a list of supported query terms with
some examples.")
      (table
       (thead
        (tr
         (th "Filter")
         (th "Description")))
       (tbody
        (tr
         (td (span (@ (class "filter")) "is:open") ", "
             (span (@ (class "filter")) "is:pending"))
         (td "Open issues."))
        (tr
         (td (span (@ (class "filter")) "is:closed") ", "
             (span (@ (class "filter")) "is:done"))
         (td "Issues marked as done."))
        (tr
         (td (span (@ (class "filter")) "submitter:<who>"))
         (td "Issues submitted by a person named " (strong "who")
             ", e.g. "
             (span (@ (class "filter")) "submitter:ludo")
             " for all issues submitted by ludo. "
             "The filter matches both the email address and the name."))
        (tr
         (td (span (@ (class "filter")) "author:<who>"))
         (td "Issues where a person named " (strong "who")
             " has commented, e.g. "
             (span (@ (class "filter")) "author:rekado")
             " for all messages where rekado has commented. "
             "The filter matches both the email address and the name."))
        (tr
         (td (span (@ (class "filter")) "severity:<type>"))
         (td "Issues that have been marked with the given severity, e.g. "
             (span (@ (class "filter")) "severity:serious")
             " for all issues that have been labelled as serious bugs. "
             "The following severities are recognized: "
             (strong "critical") ", "
             (strong "grave") ", "
             (strong "serious") ", "
             (strong "important") ", "
             (strong "normal") ", "
             (strong "minor") ", and "
             (strong "wishlist") "."))
        (tr
         (td (span (@ (class "filter")) "tag:<type>"))
         (td "Issues that have been tagged with the given tag, e.g. "
             (span (@ (class "filter")) "tag:easy")
             " for all easy issues that are suitable for newcomers. "
             "The following tags are recognized: "
             (strong "patch") ", "
             (strong "wontfix") ", "
             (strong "moreinfo") ", "
             (strong "unreproducible") ", "
             (strong "fixed") ", "
             (strong "notabug") ", "
             (strong "pending") ", "
             (strong "help") ", "
             (strong "security") ", "
             (strong "confirmed") ", and "
             (strong "easy") "."))
        (tr
         (td (span (@ (class "filter")) "date:<start>..<end>"))
         (td "Issues submitted within the provided range.  "
             (strong "start") " and " (strong "end") " can be one of "
             (strong "now") ", " (strong "today")
             ", a date in the formats "
             (strong "YYYY-MM-DD") " or " (strong "YYYYMMDD")
             ", or an amount and a unit for a point in the past, such as "
             (strong "12d..") " for 12 days ago. "
             "Supported units are: "
             (strong "h") " (hours), "
             (strong "d") " (days), "
             (strong "w") " (weeks), "
             (strong "m") " (months), and "
             (strong "y") " (years)."))
        (tr
         (td (span (@ (class "filter")) "mdate:<start>..<end>"))
         (td "This is just like " (span (@ (class "filter")) "date")
             " except that it also includes comments."))
        (tr
         (td (span (@ (class "filter")) "msgid:<message id>"))
         (td "Find issues containing a message with the given message id."))))))))

(define (unknown id)
  (layout
   #:body
   `(,(header)
     (main (@ (class "container"))
          (h1 "Issue not found")
          (p "There is no submission with id " (strong ,id) ", or we
failed to process associated messages.")
          (p (a (@ (href "/")) "Try another one?"))))))

(define (error-page message)
  (layout
   #:body
   `(,(header)
     (main (@ (class "container"))
          (h1 "Error")
          (p "An error occurred.  Sorry about that!")
          ,message
          (p (a (@ (href "/")) "Try something else?"))))))

(define (build-uri-path . parts)
  "Encode PARTS and join them together into an absolute URI path."
  (string-append "/" (encode-and-join-uri-path parts)))

(define* (issue-page bug #:optional flash-message)
  "Render the conversation for the given BUG."
  (define id (bug-num bug))
  (define all-messages-with-numbers
    (let ((msgs (issue-messages id)))
      (zip (iota (length msgs)) msgs)))
  (define messages-with-numbers
    (filter (match-lambda
              ((number msg)
               ;; Ignore messages without body, and internal messages.
               (and msg
                    (email-body msg)
                    (not (internal-message? msg)))))
            all-messages-with-numbers))
  (define messages (map second messages-with-numbers))
  (define parties (sort (filter (compose (negate bot?) extract-email)
                                (participants (filter identity messages)))
                        (lambda (a b)
                          (string< (extract-email a)
                                   (extract-email b)))))
  (define sidebar
    `(ul (@ (id "sidebar")
            (class "sticky-top flex-column"))
         ,(map (match-lambda
                 ((message-number message)
                  `(li
                    (div
                     (@ (class "avatar")
                        (style ,(string-append "background-color:"
                                               (avatar-color (sender-email message)
                                                             (map extract-email parties)))))
                     ,(string-upcase (string-take (sender-name message) 1)))
                    (span (@ (class "date"))
                          (a (@ (href ,(string-append "#" (number->string
                                                           message-number))))
                             ,(time->string (date message)))))))
               messages-with-numbers)))
  (define issue-details
    `(div
      (@ (class "issue-details"))
      (ul
       (li ,(status-tag bug))
       (li
        (a (@ (href ,(uri->string
                      (build-uri (%config 'qa-scheme)
                                 #:host (%config 'qa-host)
                                 #:path (build-uri-path "issue"
                                                        (number->string id))))))
           (img (@ (src ,(uri->string
                          (build-uri (%config 'qa-scheme)
                                     #:host (%config 'qa-host)
                                     #:path (build-uri-path "issue"
                                                            (number->string id)
                                                            "status-badge-medium.svg")))))))))
      (details
       (@ (class "info"))
       (summary "Details")
       (dl
        (@ (class "stat"))
        ,@(let ((num (length parties)))
            `((dt ,(if (= num 1)
                       "One participant"
                       (string-append (number->string num)
                                      " participants")))
              (dd
               (ul ,(map (lambda (name)
                           `(li (span (@ (class "name")))
                                ,name))
                         (map extract-name parties)))))))
       (dl
        (@ (class "stat"))
        (dt "Owner")
        (dd
         ,(or (and=> (bug-owner bug) extract-name) "unassigned")))
       (dl
        (@ (class "stat"))
        (dt "Submitted by")
        ;; We don't use bug-originator here
        ;; because it includes the email address.
        ;; We cannot use extract-name on the
        ;; return value, because it swallows
        ;; non-ASCII characters.
        (dd ,(sender-name (first messages))))
       (dl
        (@ (class "stat"))
        (dt "Severity")
        (dd ,(bug-severity bug)))
       ,@(if (bug-mergedwith bug)
             `((dl
                (@ (class "stat"))
                (dt "Merged with")
                (dd (ul ,(map (lambda (id)
                                `(li (a (@ (href ,(string-append "/" id)))
                                        ,id)))
                              ;; XXX: This field can either hold a
                              ;; string of multiple ids, or a single
                              ;; number.  Deal with this mess.
                              (match (bug-mergedwith bug)
                                ((? string? str)
                                 (string-split str #\space))
                                ((? number? n)
                                 (list (number->string n)))))))))
             '())
       ,@(if (bug-blocks bug)
             `((dl
                (@ (class "stat"))
                (dt "Blocks")
                (dd (ul ,(map (lambda (id)
                                `(li (a (@ (href ,(string-append "/" id)))
                                        ,id)))
                              ;; XXX: This field can either hold a
                              ;; string of multiple ids, or a single
                              ;; number.  Deal with this mess.
                              (match (bug-blocks bug)
                                ((? string? str)
                                 (string-split str #\space))
                                ((? number? n)
                                 (list (number->string n)))))))))
             '())
       ,@(if (bug-blockedby bug)
             `((dl
                (@ (class "stat"))
                (dt "Blocked by")
                (dd (ul ,(map (lambda (id)
                                `(li (a (@ (href ,(string-append "/" id)))
                                        ,id)))
                              ;; XXX: This field can either hold a
                              ;; string of multiple ids, or a single
                              ;; number.  Deal with this mess.
                              (match (bug-blockedby bug)
                                ((? string? str)
                                 (string-split str #\space))
                                ((? number? n)
                                 (list (number->string n)))))))))
             '()))))
  (define mailer-form
    `((form
        (@ (action ,(format #f "/issue/~a/comment"
                            (number->string id)))
           (enctype "multipart/form-data")
           (method "POST"))
        (input (@ (style "display:none")
                  (name "validation")
                  (placeholder "Please leave this empty.")) "")
        (input (@ (type "hidden")
                  (name "timestamp")
                  (value ,(timestamp!))) "")
        (div
         (@ (class "avatar")
            (style "background-color:#bc80bd")) "?")
        (article
         (@ (class "message"))
         (header
          (div (@ (class "from"))
               (input (@ (class "address form-control")
                         (name "from")
                         (required "required")
                         (placeholder "Your name")) "")))
         (textarea (@ (name "text")
                      (required "required")
                      (class "form-control")
                      (placeholder "Please input your comment..."))
                   "")
         (footer
          (button (@ (type "submit")) "Send")
          (span
           (@ (class "ml-3"))
           "You may also "
           (a (@ (href ,(string-append "mailto:"
                                       (number->string id) "@" (%config 'debbugs-domain)
                                       "?subject=" (bug-subject* bug))))
              ,(string-append "send email to "
                              (number->string id) "@" (%config 'debbugs-domain)))
           " to comment."))))))
  (define disabled-mailer
    `((div
       (@ (class "avatar")
          (style "background-color:#bc80bd")) "?")
      (article
       (@ (class "message"))
       (header
        (div (@ (class "from"))
             (span (@ (class "address")) "Your comment")))
       ,(if (bug-archived bug)
            '(p "This issue is archived.")
            '(p "Commenting via the web interface is
currently disabled."))
       (p "To comment on this conversation "
          (a (@ (href ,(string-append "mailto:"
                                      (number->string id) "@" (%config 'debbugs-domain)
                                      "?subject=" (bug-subject* bug))))
             ,(string-append "send email to "
                             (number->string id) "@" (%config 'debbugs-domain)))))))
  (define comment-box
    `(div
      (@ (class "comment-box"))
      (a (@ (id "comment")))
      ,@(if (and (mailer-enabled?)
                 (not (bug-archived bug)))
            mailer-form
            disabled-mailer)))
  (define (show-message message-number message previous-subject)
    `((div
       (a (@ (class "message-anchor")
             (id ,(number->string message-number))))
       (a (@ (class "message-anchor")
             (id ,(format #false "msgid-~a" (msgid-hash (message-id message))))))
       (div
        (@ (class "avatar")
           (style ,(string-append "background-color:"
                                  (avatar-color (sender-email message)
                                                (map extract-email parties)))))
        ,(string-upcase (string-take (sender-name message) 1)))
       (article
        (@ (class "message"))
        (header
         (div
          (@ (class "from"))
          (div
           (@ (class "avatar")
              (style ,(string-append "background-color:"
                                     (avatar-color (sender-email message)
                                                   (map extract-email parties)))))
           ,(string-upcase (string-take (sender-name message) 1)))
          (span (@ (class "address")) ,(sender-name message))
          " wrote "
          (span (@ (class "date"))
                (a (@ (href ,(string-append "#" (number->string
                                                 message-number)))
                      (title ,(date->string (date message))))
                   ,(time->string (date message)))))
         (div (@ (class "download-message"))
              (a (@ (href ,(format #f "/issue/~a/raw/~a"
                                   id message-number)))
                 ,download-icon))
         ,@(if (string-suffix? previous-subject (subject message))
               '()
               `((div (@ (class "subject")) ,(subject message))))
         (div
          (@ (class "details"))
          (div
           (@ (class "recipients"))
           (label "Recipients:")
           ,(map (lambda (address)
                   `(span (@ (class "address")) ,address))
                 (recipients message)))
          (div
           (@ (class "message-id"))
           (label "Message-ID:")
           ,(message-id message))))
        ,(display-message-body id message-number message)))
      ,@(if (closing? message id)
            '((div
               (@ (class "event"))
               (div (@ (class "badge badge-primary closed")) "Closed")))
            '())))

  (if (null? messages) #f
      (layout
       #:title (bug-subject* bug)
       #:body
       `(,(header #:title (bug-subject* bug))
         (main
          (@ (class "container"))
          ,@(match flash-message
              (('error . text)
               `((div (@ (class "alert alert-danger")
                         (role "alert"))
                      ,text)))
              (('info . text)
               `((div (@ (class "alert alert-info")
                         (role "alert"))
                      ,text)))
              (_ '()))
          ,sidebar
          (div
           (@ (class "title"))
           (h1 (@ (class "issue-title")) ,(bug-subject* bug))
           ,issue-details)
          (div
           (@ (class "conversation"))
           ,(map show-message
                 (map car messages-with-numbers)
                 messages
                 (cons (bug-subject* bug)
                       (map subject messages)))
           ,comment-box))))))

(define (list-of-bugs bugs)
  "Return table rows for all BUGS."
  (map (lambda (bug)
         (let ((id (number->string (bug-num bug))))
           `(tr (@ (class ,(bug-severity bug)))
                (td ,(or id "-"))
                (td
                 ,@(if (member (bug-severity bug) '("serious" "important"))
                       `((svg (@ (xmlns"http://www.w3.org/2000/svg")
                                 (xmlns:xlink "http://www.w3.org/1999/xlink")
                                 (viewBox "0 0 14 16")
                                 (version "1.1")
                                 (height "1rem")
                                 (width "1rem")
                                 (aria-hidden "true"))
                              (title ,(bug-severity bug))
                              (path (@ (fill-rule "evenodd")
                                       (d "\
M7 2.3c3.14 0 5.7 2.56 5.7 5.7\
s-2.56 5.7-5.7 5.7A5.71 5.71 0 011.3 8\
c0-3.14 2.56-5.7 5.7-5.7z\
M7 1C3.14 1 0 4.14 0 8\
s3.14 7 7 7 7-3.14 7-7-3.14-7-7-7z\
m1 3H6v5h2V4zm0 6H6v2h2v-2z")))))
                       '())
                 ,@(or (and=> (bug-tags bug)
                              (lambda (tags)
                                (map (lambda (tag)
                                       `(a (@ (href ,(string-append "search?query=tag:" tag)))
                                           (span
                                            (@ (class ,(string-append "badge badge-info " tag)))
                                            ,tag)))
                                     (string-split tags #\space))))
                       '())
                 ,(if id
                         `(a (@ (href ,(string-append "/" id)))
                             ,(bug-subject* bug))
                         (bug-subject* bug)))
                (td ,(date->string (bug-date bug)))
                (td ,(status-tag bug)))))
       bugs))

(define (priority-bugs)
  (list-of-bugs (sort
                 (append
                  (bugs-by-severity "serious" "open")
                  (bugs-by-severity "important" "open"))
                 (lambda (a b) (< (bug-num a) (bug-num b))))))

(define* (list-of-recent-issues #:optional (max 100))
  (layout
   #:body
   `(,(header #:search-bar? #f)
     (main
      (@ (class "container"))
      (h1 "Recent issues")
      (table
       (@ (class "js-sort-table"))
       (thead
        (tr (@ (class "heading"))
            (th (@ (class "js-sort-number")) "ID")
            (th "Subject")
            (th "Date submitted")
            (th "Status")))
       (tbody
        ,@(list-of-bugs (recent-bugs max))))))))

(define* (list-of-forgotten-issues #:optional (max 100))
  (layout
   #:body
   `(,(header #:search-bar? #f)
     (main
      (@ (class "container"))
      (h1 "Forgotten issues")
      (table
       (@ (class "js-sort-table"))
       (thead
        (tr (@ (class "heading"))
            (th (@ (class "js-sort-number")) "ID")
            (th "Subject")
            (th "Date submitted")
            (th "Status")))
       (tbody
        ,@(list-of-bugs (forgotten-issues max))))))))

(define (list-of-matching-bugs query bugs)
  (layout
   #:body
   `(,(header #:search-bar? #f)
     (main
      (@ (class "container"))
      (h1 "Your search for " (code ,query))
      ,(search-widget #:text query)
      ,(if (null? bugs)
           `(div
             (@ (class "alert alert-warning")
                (role "alert"))
             (h4
              (@ (class "alert-heading"))
              "Nothing found!")
             (p "We could not find any issues matching your query "
                (code ,query) ". "
                (a (@ (href "/"))
                   "Try searching for something else?")))
           `(table
             (@ (class "js-sort-table"))
             (thead
              (tr (@ (class "heading"))
                  (th (@ (class "js-sort-number")) "ID")
                  (th "Subject")
                  (th "Date submitted")
                  (th "Status")))
             (tbody
              ,@(list-of-bugs bugs))))))))