mumi/web/view/html.scm

   1 ;;; mumi -- Mediocre, uh, mail interface
   2 ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
   3 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
   4 ;;;
   5 ;;; This program is free software: you can redistribute it and/or
   6 ;;; modify it under the terms of the GNU Affero General Public License
   7 ;;; as published by the Free Software Foundation, either version 3 of
   8 ;;; the License, or (at your option) any later version.
   9 ;;;
  10 ;;; This program is distributed in the hope that it will be useful,
  11 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;; Affero General Public License for more details.
  14 ;;;
  15 ;;; You should have received a copy of the GNU Affero General Public
  16 ;;; License along with this program.  If not, see
  17 ;;; <http://www.gnu.org/licenses/>.
  18
  19 (define-module (mumi web view html)
  20   #:use-module (email email)
  21   #:use-module (mumi config)
  22   #:use-module (mumi debbugs)
  23   #:use-module (mumi messages)
  24   #:use-module (mumi web view utils)
  25   #:use-module (mumi web util)
  26   #:use-module (ice-9 match)
  27   #:use-module (srfi srfi-1)
  28   #:use-module (srfi srfi-19)
  29   #:export (index
  30             help
  31             unknown
  32             error-page
  33             issue-page
  34             list-of-matching-bugs
  35             list-of-recent-issues
  36             list-of-forgotten-issues))
  37
  38 (define (bug-subject* bug)
  39   (or (bug-subject bug) "(no subject)"))
  40
  41 (define (status-tag bug)
  42   "Return a colored tag indicating the BUG status."
  43   (let ((status (if (bug-done bug) "Done" "Open")))
  44     `(span (@ (class ,(string-append "status-tag "
  45                                      (string-downcase status))))
  46            ,status)))
  47
  48 (define* (layout #:key
  49                  (head '())
  50                  (body '())
  51                  (title "Guix issue tracker"))
  52   `((doctype "html")
  53     (html (@ (lang "en"))
  54      (head
  55       (title ,title)
  56       (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8")))
  57       (meta (@ (name "author") (content "Ricardo Wurmus")))
  58       (meta (@ (name "viewport")
  59                (content "width=device-width, initial-scale=1")))
  60       (link
  61        (@ (rel "stylesheet")
  62           (media "screen")
  63           (type "text/css")
  64           (href "/css/reset.css")))
  65       (link
  66        (@ (rel "stylesheet")
  67           (media "screen")
  68           (type "text/css")
  69           (href "/css/bootstrap.css")))
  70       ,@head
  71       (link
  72        (@ (rel "stylesheet")
  73           (media "screen")
  74           (type "text/css")
  75           (href "/css/screen.css?202005130000"))))
  76      (body ,@body
  77            (footer (@ (class "text-center"))
  78                    (p "Copyright © 2016—2020 by the GNU Guix community."
  79                       (br)
  80                       "Now with even more " (span (@ (class "lambda")) "λ") "! ")
  81                    (p "This is free software.  Download the "
  82                       (a (@ (href "https://git.elephly.net/software/mumi.git"))
  83                          "source code here") "."))
  84            (script
  85             (@ (src "/js/sort-table.js")))))))
  86
  87 (define* (search-form #:key (standalone? #f) (text ""))
  88   `(form (@ (id "search")
  89             ,(if standalone?
  90                  '(class "")
  91                  '(class "form-inline"))
  92             (action "/search"))
  93          (div
  94           (@ (class ,(if standalone?
  95                          "input-group input-group-lg"
  96                          "input-group")))
  97           (input (@ (type "text")
  98                     (class "form-control")
  99                     (id   "query")
 100                     (name "query")
 101                     (value ,text)
 102                     (placeholder "Input your search query...")))
 103           (span (@ (class "input-group-append"))
 104                     (button
 105                      (@ (type "submit")
 106                         (class ,(string-append (if standalone? "btn-lg " "")
 107                                                "btn btn-primary")))
 108                      ;; This SVG is part of Bootstrap and is available
 109                      ;; under the Expat license.
 110                      (svg
 111                       (@ (class "bi bi-search")
 112                          (width "1em")
 113                          (height "1em")
 114                          (viewBox "0 0 16 16")
 115                          (fill "currentColor")
 116                          (xmlns "http://www.w3.org/2000/svg"))
 117                       (title "Search")
 118                       (path (@ (fill-rule "evenodd")
 119                                (d "M10.442 10.442a1 1 0 011.415 0l3.85 3.85a1 1 0 01-1.414 1.415l-3.85-3.85a1 1 0 010-1.415z")
 120                                (clip-rule "evenodd")) "")
 121                       (path (@ (fill-rule "evenodd")
 122                                (d "M6.5 12a5.5 5.5 0 100-11 5.5 5.5 0 000 11zM13 6.5a6.5 6.5 0 11-13 0 6.5 6.5 0 0113 0z")
 123                                (clip-rule "evenodd")) ""))))
 124           (div
 125            (@ (id "search-hints"))
 126            (p "You can improve the search results by making use of the
 127 simple query language.  Here is a list of supported query terms:")
 128            (table
 129             (@ (class "table table-sm table-borderless"))
 130             (tbody
 131              ,@(map (match-lambda
 132                       ((term description)
 133                        `(tr (td (span (@ (class "filter")) ,term))
 134                             (td ,description))))
 135                     '(("is:open" "open issues")
 136                       ("is:done" "closed issues")
 137                       ("submitter:<who>" "search issue submitter")
 138                       ("author:<who>" "search by message author")
 139                       ("date:yesterday..now" "search by issue date")
 140                       ("mdate:3m..2d" "search by message date")))))))))
 141
 142 (define* (search-widget #:key (text ""))
 143   `(div
 144     (@ (class "card mb-3"))
 145     (div (@ (class "card-body bg-light"))
 146          ,(search-form #:standalone? #t #:text text)
 147          (details
 148           (summary (strong "Hint"))
 149           (p
 150            "Refine your search with filters like "
 151            (span (@ (class "filter"))
 152                  "is:open")
 153            ", "
 154            (span (@ (class "filter"))
 155                  "author:me")
 156            ", "
 157            (span (@ (class "filter"))
 158                  "submitter:me")
 159            ", "
 160            (span (@ (class "filter"))
 161                  "severity:serious")
 162            ", "
 163            (span (@ (class "filter"))
 164                  "tag:easy")
 165            ", "
 166            (span (@ (class "filter"))
 167                  "date:2d..now")
 168            ", "
 169            (span (@ (class "filter"))
 170                  "date:2018-04-01..2018-04-02")
 171            ", "
 172            (span (@ (class "filter"))
 173                  "date:1m..today")
 174            ", and "
 175            (a (@ (href "help#search"))
 176               "many more!"))))))
 177
 178 (define* (header #:key (search-bar? #t) title)
 179   `(nav
 180     (@ (class "sticky-top navbar navbar-expand navbar-light bg-light"))
 181     (a (@ (href "/") (class "navbar-brand pt-0 logo navbar-collapse"))
 182        (img (@ (src "/img/logo.png") (alt "logo") (height "25"))))
 183     ,@(if title
 184           `((span (@ (class "navbar-text")) ,title))
 185           '())
 186     ,@(if search-bar?
 187           `(,(search-form))
 188           '())))
 189
 190 (define (index)
 191   (layout
 192    #:body
 193    `(,(header #:search-bar? #f)
 194      (main
 195       (@ (class "container"))
 196       (h1 "Guix issue tracker")
 197       (p (@ (class "lead"))
 198          "This is a web frontend to the Guix patch and bug trackers.  Send email to "
 199          (a (@ (href ,(string-append "mailto:" (%config 'submission-email-address))))
 200             ,(%config 'submission-email-address))
 201          " to submit a patch, or email "
 202          (a (@ (href ,(string-append "mailto:" (%config 'submission-bug-email-address))))
 203             ,(%config 'submission-bug-email-address))
 204          " to submit a bug report.")
 205       ,(search-widget)
 206
 207       (div (@ (class "mt-4 h4")) "Recent activity "
 208            (small (a (@ (href "recent")) "(More)")))
 209       (table
 210        (@ (class "table table-borderless table-hover js-sort-table"))
 211        (thead
 212         (tr (@ (class "heading"))
 213             (th (@ (class "js-sort-number")) "ID")
 214             (th "Subject")
 215             (th "Date submitted")
 216             (th "Status")))
 217        (tbody
 218         ,@(list-of-bugs (recent-bugs 10))))
 219
 220       (div (@ (class "mt-4 h4")) "Forgotten issues "
 221            (small (a (@ (href "forgotten")) "(More)")))
 222       (table
 223        (@ (class "table table-borderless table-hover js-sort-table"))
 224        (thead
 225         (tr (@ (class "heading"))
 226             (th (@ (class "js-sort-number")) "ID")
 227             (th "Subject")
 228             (th "Date submitted")
 229             (th "Status")))
 230        (tbody
 231         ,@(list-of-bugs (forgotten-issues 10))))
 232
 233       (div (@ (class "mt-4 h4")) "Priority bugs")
 234       (table
 235        (@ (class "table table-borderless table-hover js-sort-table"))
 236        (thead
 237         (tr (@ (class "heading"))
 238             (th (@ (class "js-sort-number")) "ID")
 239             (th "Subject")
 240             (th "Date submitted")
 241             (th "Status")))
 242        (tbody
 243         ,@(priority-bugs)))))))
 244
 245 (define (help)
 246   (layout
 247    #:body
 248    `(,(header #:search-bar? #f)
 249      (div
 250       (@ (class "container"))
 251       (h1 "Help")
 252       (a (@ (href "search")))
 253       (p "You can improve the search results by making use of the
 254 simple query language.  Here is a list of supported query terms with
 255 some examples.")
 256       (table
 257        (@ (class "table"))
 258        (thead
 259         (tr
 260          (th (@ (class "col-md-3")) "Filter")
 261          (th (@ (class "col-md-9")) "Description")))
 262        (tbody
 263         (tr
 264          (td (span (@ (class "filter")) "is:open") ", "
 265              (span (@ (class "filter")) "is:pending"))
 266          (td "Open issues."))
 267         (tr
 268          (td (span (@ (class "filter")) "is:closed") ", "
 269              (span (@ (class "filter")) "is:done"))
 270          (td "Issues marked as done."))
 271         (tr
 272          (td (span (@ (class "filter")) "submitter:<who>"))
 273          (td "Issues submitted by a person named " (strong "who")
 274              ", e.g. "
 275              (span (@ (class "filter")) "submitter:ludo")
 276              " for all issues submitted by ludo. "
 277              "The filter matches both the email address and the name."))
 278         (tr
 279          (td (span (@ (class "filter")) "author:<who>"))
 280          (td "Issues where a person named " (strong "who")
 281              " has commented, e.g. "
 282              (span (@ (class "filter")) "author:rekado")
 283              " for all messages where rekado has commented. "
 284              "The filter matches both the email address and the name."))
 285         (tr
 286          (td (span (@ (class "filter")) "severity:<type>"))
 287          (td "Issues that have been marked with the given severity, e.g. "
 288              (span (@ (class "filter")) "severity:serious")
 289              " for all issues that have been labelled as serious bugs. "
 290              "The following severities are recognized: "
 291              (strong "critical") ", "
 292              (strong "grave") ", "
 293              (strong "serious") ", "
 294              (strong "important") ", "
 295              (strong "normal") ", "
 296              (strong "minor") ", and "
 297              (strong "wishlist") "."))
 298         (tr
 299          (td (span (@ (class "filter")) "tag:<type>"))
 300          (td "Issues that have been tagged with the given tag, e.g. "
 301              (span (@ (class "filter")) "tag:easy")
 302              " for all easy issues that are suitable for newcomers. "
 303              "The following tags are recognized: "
 304              (strong "patch") ", "
 305              (strong "wontfix") ", "
 306              (strong "moreinfo") ", "
 307              (strong "unreproducible") ", "
 308              (strong "fixed") ", "
 309              (strong "notabug") ", "
 310              (strong "pending") ", "
 311              (strong "help") ", "
 312              (strong "security") ", "
 313              (strong "confirmed") ", and "
 314              (strong "easy") "."))
 315         (tr
 316          (td (span (@ (class "filter")) "date:<start>..<end>"))
 317          (td "Issues submitted within the provided range.  "
 318              (strong "start") " and " (strong "end") " can be one of "
 319              (strong "now") ", " (strong "today")
 320              ", a date in the formats "
 321              (strong "YYYY-MM-DD") " or " (strong "YYYYMMDD")
 322              ", or an amount and a unit for a point in the past, such as "
 323              (strong "12d..") " for 12 days ago. "
 324              "Supported units are: "
 325              (strong "h") " (hours), "
 326              (strong "d") " (days), "
 327              (strong "w") " (weeks), "
 328              (strong "m") " (months), and "
 329              (strong "y") " (years)."))
 330         (tr
 331          (td (span (@ (class "filter")) "mdate:<start>..<end>"))
 332          (td "This is just like " (span (@ (class "filter")) "date")
 333              " except that it also includes comments."))))))))
 334
 335 (define (unknown id)
 336   (layout
 337    #:body
 338    `(,(header)
 339      (div (@ (class "container"))
 340           (h1 "Issue not found")
 341           (p "There is no submission with id " (strong ,id) ", or we
 342 failed to process associated messages.")
 343           (p (a (@ (href "/")) "Try another one?"))))))
 344
 345 (define (error-page message)
 346   (layout
 347    #:body
 348    `(,(header)
 349      (div (@ (class "container"))
 350           (h1 "Error")
 351           (p "An error occurred.  Sorry about that!")
 352           ,message
 353           (p (a (@ (href "/")) "Try something else?"))))))
 354
 355 (define* (issue-page bug #:optional flash-message)
 356   "Render the conversation for the given BUG."
 357   (define id (bug-num bug))
 358   (define messages
 359     (filter (lambda (msg)
 360               ;; Ignore messages without body, and internal messages.
 361               (and msg
 362                    (email-body msg)
 363                    (not (internal-message? msg))))
 364             (issue-messages id)))
 365   (define parties (sort (filter (compose (negate bot?) extract-email)
 366                                 (participants (filter identity messages)))
 367                         (lambda (a b)
 368                           (string< (extract-email a)
 369                                    (extract-email b)))))
 370   (define sidebar
 371     `(ul (@ (id "sidebar")
 372              (class "sticky-top flex-column"))
 373          ,(map (lambda (message message-number)
 374                  `(li
 375                    (div
 376                     (@ (class "avatar")
 377                        (style ,(string-append "background-color:"
 378                                               (avatar-color (sender-email message)
 379                                                             (map extract-email parties)))))
 380                     ,(string-upcase (string-take (sender-name message) 1)))
 381                    (span (@ (class "date"))
 382                          (a (@ (href ,(string-append "#" (number->string
 383                                                           message-number))))
 384                             ,(time->string (date message))))))
 385                messages
 386                (iota (length messages)))))
 387   (define issue-details
 388     `(span (@ (class "details"))
 389            ,(status-tag bug)
 390            ,(string-append "Submitted by "
 391                            ;; We don't use bug-originator here
 392                            ;; because it includes the email address.
 393                            ;; We cannot use extract-name on the
 394                            ;; return value, because it swallows
 395                            ;; non-ASCII characters.
 396                            (sender-name (first messages))
 397                            ".")
 398            (details
 399             (@ (class "info"))
 400             (summary "Details")
 401             (dl
 402              (@ (class "stat"))
 403              ,@(let ((num (length parties)))
 404                  `((dt ,(if (= num 1)
 405                             "One participant"
 406                             (string-append (number->string num)
 407                                            " participants")))
 408                    (dd
 409                     (ul ,(map (lambda (name)
 410                                 `(li (span (@ (class "name")))
 411                                      ,name))
 412                               (map extract-name parties)))))))
 413             (dl
 414              (@ (class "stat"))
 415              (dt "Owner")
 416              (dd
 417               ,(or (and=> (bug-owner bug) extract-name) "unassigned")))
 418             (dl
 419              (@ (class "stat"))
 420              (dt "Severity")
 421              (dd ,(bug-severity bug)))
 422             ,@(if (bug-mergedwith bug)
 423                   `((dl
 424                      (@ (class "stat"))
 425                      (dt "Merged with")
 426                      (dd (ul ,(map (lambda (id)
 427                                      `(li (a (@ (href ,(string-append "/" id)))
 428                                              ,id)))
 429                                    ;; XXX: This field can either hold a
 430                                    ;; string of multiple ids, or a single
 431                                    ;; number.  Deal with this mess.
 432                                    (match (bug-mergedwith bug)
 433                                      ((? string? str)
 434                                       (string-split str #\space))
 435                                      ((? number? n)
 436                                       (list (number->string n)))))))))
 437                   '())
 438             ,@(if (bug-blocks bug)
 439                   `((dl
 440                      (@ (class "stat"))
 441                      (dt "Blocks")
 442                      (dd (ul ,(map (lambda (id)
 443                                      `(li (a (@ (href ,(string-append "/" id)))
 444                                              ,id)))
 445                                    ;; XXX: This field can either hold a
 446                                    ;; string of multiple ids, or a single
 447                                    ;; number.  Deal with this mess.
 448                                    (match (bug-blocks bug)
 449                                      ((? string? str)
 450                                       (string-split str #\space))
 451                                      ((? number? n)
 452                                       (list (number->string n)))))))))
 453                   '())
 454             ,@(if (bug-blockedby bug)
 455                   `((dl
 456                      (@ (class "stat"))
 457                      (dt "Blocked by")
 458                      (dd (ul ,(map (lambda (id)
 459                                      `(li (a (@ (href ,(string-append "/" id)))
 460                                              ,id)))
 461                                    ;; XXX: This field can either hold a
 462                                    ;; string of multiple ids, or a single
 463                                    ;; number.  Deal with this mess.
 464                                    (match (bug-blockedby bug)
 465                                      ((? string? str)
 466                                       (string-split str #\space))
 467                                      ((? number? n)
 468                                       (list (number->string n)))))))))
 469                   '()))))
 470   (define comment-box
 471     `(div
 472       (@ (class "comment-box"))
 473       (a (@ (id "comment")))
 474       (div
 475        (@ (class "avatar")
 476           (style "background-color:#bc80bd")) "?")
 477       (div
 478        (@ (class "message"))
 479        (div
 480         (@ (class "card"))
 481         ,@(if (and (mailer-enabled?)
 482                    (not (bug-archived bug)))
 483               `((form
 484                  (@ (action ,(format #f "/issue/~a/comment"
 485                                      (number->string id)))
 486                     (enctype "multipart/form-data")
 487                     (method "POST"))
 488                  (input (@ (style "display:none")
 489                            (name "validation")
 490                            (placeholder "Please leave this empty.")) "")
 491                  (input (@ (type "hidden")
 492                            (name "timestamp")
 493                            (value ,(timestamp!))) "")
 494                  (div
 495                   (@ (class "card-header"))
 496                   (div (@ (class "from"))
 497                        (input (@ (class "address form-control")
 498                                  (name "from")
 499                                  (required "required")
 500                                  (placeholder "Your name")) "")))
 501                  (div
 502                   (@ (class "body card-body"))
 503                   (textarea (@ (name "text")
 504                                (required "required")
 505                                (class "form-control")
 506                                (placeholder "Please input your comment..."))
 507                             ""))
 508                  (div
 509                   (@ (class "card-footer"))
 510                   (button (@ (class "btn btn-primary")
 511                              (type "submit"))
 512                           "Send")
 513                   (span (@ (class "ml-3"))
 514                    "Your may also "
 515                    (a (@ (href ,(string-append "mailto:"
 516                                                (number->string id) "@" (%config 'debbugs-domain)
 517                                                "?subject=" (bug-subject* bug))))
 518                       ,(string-append "send email to "
 519                                       (number->string id) "@" (%config 'debbugs-domain)))
 520                    " to comment."))))
 521               `((div
 522                  (@ (class "card-header"))
 523                  (div (@ (class "from"))
 524                       (span (@ (class "address")) "Your comment")))
 525                 (div
 526                  (@ (class "body card-body"))
 527                  ,(if (bug-archived bug)
 528                       '(p "This issue is archived.")
 529                       '(p "Commenting via the web interface is
 530 currently disabled."))
 531                  (p "To comment on this conversation "
 532                     (a (@ (href ,(string-append "mailto:"
 533                                                 (number->string id) "@" (%config 'debbugs-domain)
 534                                                 "?subject=" (bug-subject* bug))))
 535                        ,(string-append "send email to "
 536                                        (number->string id) "@" (%config 'debbugs-domain)))))))))))
 537   (define (show-message message-number message previous-subject)
 538     `((div (@ (class "mb-5"))
 539            (a (@ (class "message-anchor")
 540                  (id ,(number->string message-number))))
 541            (div
 542             (@ (class "avatar")
 543                (style ,(string-append "background-color:"
 544                                       (avatar-color (sender-email message)
 545                                                     (map extract-email parties)))))
 546             ,(string-upcase (string-take (sender-name message) 1)))
 547            (div
 548             (@ (class "message"))
 549             (div
 550              (@ (class "card"))
 551              (div
 552               (@ (class "card-header"))
 553               (div
 554                (@ (class "from"))
 555                (div
 556                 (@ (class "avatar")
 557                    (style ,(string-append "background-color:"
 558                                           (avatar-color (sender-email message)
 559                                                         (map extract-email parties)))))
 560                 ,(string-upcase (string-take (sender-name message) 1)))
 561                (span (@ (class "address")) ,(sender-name message))
 562                " wrote "
 563                (span (@ (class "date"))
 564                      (a (@ (href ,(string-append "#" (number->string
 565                                                       message-number)))
 566                            (title ,(date->string (date message))))
 567                         ,(time->string (date message)))))
 568               (div (@ (class "download-message"))
 569                    (a (@ (href ,(format #f "issue/~a/raw/~a"
 570                                         id message-number)))
 571                       ,download-icon))
 572               ,@(if (string-suffix? previous-subject (subject message))
 573                     '()
 574                     `((div (@ (class "subject")) ,(subject message))))
 575               (div
 576                (@ (class "details"))
 577                (div
 578                 (@ (class "recipients"))
 579                 (label "Recipients:")
 580                 ,(map (lambda (address)
 581                         `(span (@ (class "address")) ,address))
 582                       (recipients message)))
 583                (div
 584                 (@ (class "message-id"))
 585                 (label "Message-ID:")
 586                 ,(message-id message))))
 587              (div
 588               (@ (class "body card-body"))
 589               ,(display-message-body id message-number message)))))
 590       ,@(if (closing? message id)
 591             '((div
 592                (@ (class "row event"))
 593                (div
 594                 (@ (class "col-11 offset-1 text-center"))
 595                 (div (@ (class "badge badge-primary closed")) "Closed"))))
 596             '())))
 597
 598   (if (null? messages) #f
 599       (layout
 600        #:title (bug-subject* bug)
 601        #:body
 602        `(,(header #:title (bug-subject* bug))
 603          (div
 604           (@ (class "container"))
 605           ,@(match flash-message
 606               (('error . text)
 607                `((div (@ (class "alert alert-danger")
 608                          (role "alert"))
 609                       ,text)))
 610               (('info . text)
 611                `((div (@ (class "alert alert-info")
 612                          (role "alert"))
 613                       ,text)))
 614               (_ '()))
 615           ,sidebar
 616           (div
 617            (@ (class "title col-12"))
 618            (h1 (@ (class "h3")) ,(bug-subject* bug))
 619            ,issue-details)
 620           (div (@ (class "row"))
 621                (div
 622                 (@ (class "conversation col-12"))
 623                 ,(map show-message
 624                       (iota (length messages))
 625                       messages
 626                       (cons (bug-subject* bug)
 627                             (map subject messages)))
 628                 ,comment-box)))))))
 629
 630 (define (list-of-bugs bugs)
 631   "Return table rows for all BUGS."
 632   (map (lambda (bug)
 633          (let ((id (number->string (bug-num bug))))
 634            `(tr (@ (class ,(bug-severity bug)))
 635                 (td ,(or id "-"))
 636                 (td
 637                  ,@(if (member (bug-severity bug) '("serious" "important"))
 638                        `((svg (@ (xmlns"http://www.w3.org/2000/svg")
 639                                  (xmlns:xlink "http://www.w3.org/1999/xlink")
 640                                  (viewBox "0 0 14 16")
 641                                  (version "1.1")
 642                                  (height "1rem")
 643                                  (width "1rem")
 644                                  (aria-hidden "true"))
 645                               (title ,(bug-severity bug))
 646                               (path (@ (fill-rule "evenodd")
 647                                        (d "\
 648 M7 2.3c3.14 0 5.7 2.56 5.7 5.7\
 649 s-2.56 5.7-5.7 5.7A5.71 5.71 0 011.3 8\
 650 c0-3.14 2.56-5.7 5.7-5.7z\
 651 M7 1C3.14 1 0 4.14 0 8\
 652 s3.14 7 7 7 7-3.14 7-7-3.14-7-7-7z\
 653 m1 3H6v5h2V4zm0 6H6v2h2v-2z")))))
 654                        '())
 655                  ,@(or (and=> (bug-tags bug)
 656                               (lambda (tags)
 657                                 (map (lambda (tag)
 658                                        `(a (@ (href ,(string-append "search?query=tag:" tag)))
 659                                            (span
 660                                             (@ (class ,(string-append "badge badge-info mr-1 "
 661                                                                       tag)))
 662                                             ,tag)))
 663                                      (string-split tags #\space))))
 664                        '())
 665                  ,(if id
 666                          `(a (@ (href ,(string-append "/" id)))
 667                              ,(bug-subject* bug))
 668                          (bug-subject* bug)))
 669                 (td ,(date->string (bug-date bug)))
 670                 (td ,(status-tag bug)))))
 671        bugs))
 672
 673 (define (priority-bugs)
 674   (list-of-bugs (sort
 675                  (append
 676                   (bugs-by-severity "serious" "open")
 677                   (bugs-by-severity "important" "open"))
 678                  (lambda (a b) (< (bug-num a) (bug-num b))))))
 679
 680 (define* (list-of-recent-issues #:optional (max 100))
 681   (layout
 682    #:body
 683    `(,(header #:search-bar? #f)
 684      (div
 685       (@ (class "container"))
 686       (h1 "Recent issues")
 687       (table
 688        (@ (class "table table-borderless table-hover js-sort-table"))
 689        (thead
 690         (tr (@ (class "heading"))
 691             (th (@ (class "js-sort-number")) "ID")
 692             (th "Subject")
 693             (th "Date submitted")
 694             (th "Status")))
 695        (tbody
 696         ,@(list-of-bugs (recent-bugs max))))))))
 697
 698 (define* (list-of-forgotten-issues #:optional (max 100))
 699   (layout
 700    #:body
 701    `(,(header #:search-bar? #f)
 702      (div
 703       (@ (class "container"))
 704       (h1 "Forgotten issues")
 705       (table
 706        (@ (class "table table-borderless table-hover js-sort-table"))
 707        (thead
 708         (tr (@ (class "heading"))
 709             (th (@ (class "js-sort-number")) "ID")
 710             (th "Subject")
 711             (th "Date submitted")
 712             (th "Status")))
 713        (tbody
 714         ,@(list-of-bugs (forgotten-issues max))))))))
 715
 716 (define (list-of-matching-bugs query bugs)
 717   (layout
 718    #:body
 719    `(,(header #:search-bar? #f)
 720      (div
 721       (@ (class "container"))
 722       (h1 "Your search for " (code ,query))
 723       ,(search-widget #:text query)
 724       ,(if (null? bugs)
 725            `(div
 726              (@ (class "alert alert-warning")
 727                 (role "alert"))
 728              (h4
 729               (@ (class "alert-heading"))
 730               "Nothing found!")
 731              (p "We could not find any issues matching your query "
 732                 (code ,query) ". "
 733                 (a (@ (href "/"))
 734                    "Try searching for something else?")))
 735            `(table
 736              (@ (class "table table-borderless table-hover js-sort-table"))
 737              (thead
 738               (tr (@ (class "heading"))
 739                   (th (@ (class "js-sort-number")) "ID")
 740                   (th "Subject")
 741                   (th "Date submitted")
 742                   (th "Status")))
 743              (tbody
 744               ,@(list-of-bugs bugs))))))))