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?202005120000"))))
  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                  "date:2d..now")
 162            ", "
 163            (span (@ (class "filter"))
 164                  "date:2018-04-01..2018-04-02")
 165            ", "
 166            (span (@ (class "filter"))
 167                  "date:1m..today")
 168            ", and "
 169            (a (@ (href "help#search"))
 170               "many more!"))))))
 171
 172 (define* (header #:key (search-bar? #t) title)
 173   `(nav
 174     (@ (class "sticky-top navbar navbar-expand navbar-light bg-light"))
 175     (a (@ (href "/") (class "navbar-brand pt-0 logo navbar-collapse"))
 176        (img (@ (src "/img/logo.png") (alt "logo") (height "25"))))
 177     ,@(if title
 178           `((span (@ (class "navbar-text")) ,title))
 179           '())
 180     ,@(if search-bar?
 181           `(,(search-form))
 182           '())))
 183
 184 (define (index)
 185   (layout
 186    #:body
 187    `(,(header #:search-bar? #f)
 188      (main
 189       (@ (class "container"))
 190       (h1 "Guix issue tracker")
 191       (p (@ (class "lead"))
 192          "This is a web frontend to the Guix patch and bug trackers.  Send email to "
 193          (a (@ (href ,(string-append "mailto:" (%config 'submission-email-address))))
 194             ,(%config 'submission-email-address))
 195          " to submit a patch, or email "
 196          (a (@ (href ,(string-append "mailto:" (%config 'submission-bug-email-address))))
 197             ,(%config 'submission-bug-email-address))
 198          " to submit a bug report.")
 199       ,(search-widget)
 200
 201       (div (@ (class "mt-4 h4")) "Recent activity "
 202            (small (a (@ (href "recent")) "(More)")))
 203       (table
 204        (@ (class "table table-borderless table-hover js-sort-table"))
 205        (thead
 206         (tr (@ (class "heading"))
 207             (th (@ (class "js-sort-number")) "ID")
 208             (th "Subject")
 209             (th "Date submitted")
 210             (th "Status")))
 211        (tbody
 212         ,@(list-of-bugs (recent-bugs 10))))
 213
 214       (div (@ (class "mt-4 h4")) "Forgotten issues "
 215            (small (a (@ (href "forgotten")) "(More)")))
 216       (table
 217        (@ (class "table table-borderless table-hover js-sort-table"))
 218        (thead
 219         (tr (@ (class "heading"))
 220             (th (@ (class "js-sort-number")) "ID")
 221             (th "Subject")
 222             (th "Date submitted")
 223             (th "Status")))
 224        (tbody
 225         ,@(list-of-bugs (forgotten-issues 10))))
 226
 227       (div (@ (class "mt-4 h4")) "Priority bugs")
 228       (table
 229        (@ (class "table table-borderless table-hover js-sort-table"))
 230        (thead
 231         (tr (@ (class "heading"))
 232             (th (@ (class "js-sort-number")) "ID")
 233             (th "Subject")
 234             (th "Date submitted")
 235             (th "Status")))
 236        (tbody
 237         ,@(priority-bugs)))))))
 238
 239 (define (help)
 240   (layout
 241    #:body
 242    `(,(header #:search-bar? #f)
 243      (div
 244       (@ (class "container"))
 245       (h1 "Help")
 246       (a (@ (href "search")))
 247       (p "You can improve the search results by making use of the
 248 simple query language.  Here is a list of supported query terms with
 249 some examples.")
 250       (table
 251        (@ (class "table"))
 252        (thead
 253         (tr
 254          (th (@ (class "col-md-3")) "Filter")
 255          (th (@ (class "col-md-9")) "Description")))
 256        (tbody
 257         (tr
 258          (td (span (@ (class "filter")) "is:open") ", "
 259              (span (@ (class "filter")) "is:pending"))
 260          (td "Open issues."))
 261         (tr
 262          (td (span (@ (class "filter")) "is:closed") ", "
 263              (span (@ (class "filter")) "is:done"))
 264          (td "Issues marked as done."))
 265         (tr
 266          (td (span (@ (class "filter")) "submitter:<who>"))
 267          (td "Issues submitted by a person named " (strong "who")
 268              ", e.g. "
 269              (span (@ (class "filter")) "submitter:ludo")
 270              " for all issues submitted by ludo. "
 271              "The filter matches both the email address and the name."))
 272         (tr
 273          (td (span (@ (class "filter")) "author:<who>"))
 274          (td "Issues where a person named " (strong "who")
 275              " has commented, e.g. "
 276              (span (@ (class "filter")) "author:rekado")
 277              " for all messages where rekado has commented. "
 278              "The filter matches both the email address and the name."))
 279         (tr
 280          (td (span (@ (class "filter")) "date:<start>..<end>"))
 281          (td "Issues submitted within the provided range.  "
 282              (strong "start") " and " (strong "end") " can be one of "
 283              (strong "now") ", " (strong "today")
 284              ", a date in the formats "
 285              (strong "YYYY-MM-DD") " or " (strong "YYYYMMDD")
 286              ", or an amount and a unit for a point in the past, such as "
 287              (strong "12d..") " for 12 days ago. "
 288              "Supported units are: "
 289              (strong "h") " (hours), "
 290              (strong "d") " (days), "
 291              (strong "w") " (weeks), "
 292              (strong "m") " (months), and "
 293              (strong "y") " (years)."))
 294         (tr
 295          (td (span (@ (class "filter")) "mdate:<start>..<end>"))
 296          (td "This is just like " (span (@ (class "filter")) "date")
 297              " except that it also includes comments."))))))))
 298
 299 (define (unknown id)
 300   (layout
 301    #:body
 302    `(,(header)
 303      (div (@ (class "container"))
 304           (h1 "Issue not found")
 305           (p "There is no submission with id " (strong ,id) ", or we
 306 failed to process associated messages.")
 307           (p (a (@ (href "/")) "Try another one?"))))))
 308
 309 (define (error-page message)
 310   (layout
 311    #:body
 312    `(,(header)
 313      (div (@ (class "container"))
 314           (h1 "Error")
 315           (p "An error occurred.  Sorry about that!")
 316           ,message
 317           (p (a (@ (href "/")) "Try something else?"))))))
 318
 319 (define* (issue-page bug #:optional flash-message)
 320   "Render the conversation for the given BUG."
 321   (define id (bug-num bug))
 322   (define messages (issue-messages id))
 323   (define parties (sort (filter (compose (negate bot?) extract-email)
 324                                 (participants (filter identity messages)))
 325                         (lambda (a b)
 326                           (string< (extract-email a)
 327                                    (extract-email b)))))
 328   (define sidebar
 329     `(ul (@ (id "sidebar")
 330              (class "sticky-top flex-column"))
 331          ,(map (lambda (message message-number)
 332                  `(li
 333                    (div
 334                     (@ (class "avatar")
 335                        (style ,(string-append "background-color:"
 336                                               (avatar-color (sender-email message)
 337                                                             (map extract-email parties)))))
 338                     ,(string-upcase (string-take (sender-name message) 1)))
 339                    (span (@ (class "date"))
 340                          (a (@ (href ,(string-append "#" (number->string
 341                                                           message-number))))
 342                             ,(time->string (date message))))))
 343                messages
 344                (iota (length messages)))))
 345   (define issue-details
 346     `(span (@ (class "details"))
 347            ,(status-tag bug)
 348            ,(string-append "Submitted by "
 349                            ;; We don't use bug-originator here
 350                            ;; because it includes the email address.
 351                            ;; We cannot use extract-name on the
 352                            ;; return value, because it swallows
 353                            ;; non-ASCII characters.
 354                            (sender-name (first messages))
 355                            ".")
 356            (details
 357             (@ (class "info"))
 358             (summary "Details")
 359             (dl
 360              (@ (class "stat"))
 361              ,@(let ((num (length parties)))
 362                  `((dt ,(if (= num 1)
 363                             "One participant"
 364                             (string-append (number->string num)
 365                                            " participants")))
 366                    (dd
 367                     (ul ,(map (lambda (name)
 368                                 `(li (span (@ (class "name")))
 369                                      ,name))
 370                               (map extract-name parties)))))))
 371             (dl
 372              (@ (class "stat"))
 373              (dt "Owner")
 374              (dd
 375               ,(or (and=> (bug-owner bug) extract-name) "unassigned")))
 376             (dl
 377              (@ (class "stat"))
 378              (dt "Severity")
 379              (dd ,(bug-severity bug)))
 380             ,@(if (bug-mergedwith bug)
 381                   `((dl
 382                      (@ (class "stat"))
 383                      (dt "Merged with")
 384                      (dd (ul ,(map (lambda (id)
 385                                      `(li (a (@ (href ,(string-append "/" id)))
 386                                              ,id)))
 387                                    ;; XXX: This field can either hold a
 388                                    ;; string of multiple ids, or a single
 389                                    ;; number.  Deal with this mess.
 390                                    (match (bug-mergedwith bug)
 391                                      ((? string? str)
 392                                       (string-split str #\space))
 393                                      ((? number? n)
 394                                       (list (number->string n)))))))))
 395                   '())
 396             ,@(if (bug-blocks bug)
 397                   `((dl
 398                      (@ (class "stat"))
 399                      (dt "Blocks")
 400                      (dd (ul ,(map (lambda (id)
 401                                      `(li (a (@ (href ,(string-append "/" id)))
 402                                              ,id)))
 403                                    ;; XXX: This field can either hold a
 404                                    ;; string of multiple ids, or a single
 405                                    ;; number.  Deal with this mess.
 406                                    (match (bug-blocks bug)
 407                                      ((? string? str)
 408                                       (string-split str #\space))
 409                                      ((? number? n)
 410                                       (list (number->string n)))))))))
 411                   '())
 412             ,@(if (bug-blockedby bug)
 413                   `((dl
 414                      (@ (class "stat"))
 415                      (dt "Blocked by")
 416                      (dd (ul ,(map (lambda (id)
 417                                      `(li (a (@ (href ,(string-append "/" id)))
 418                                              ,id)))
 419                                    ;; XXX: This field can either hold a
 420                                    ;; string of multiple ids, or a single
 421                                    ;; number.  Deal with this mess.
 422                                    (match (bug-blockedby bug)
 423                                      ((? string? str)
 424                                       (string-split str #\space))
 425                                      ((? number? n)
 426                                       (list (number->string n)))))))))
 427                   '()))))
 428   (define comment-box
 429     `(div
 430       (@ (class "comment-box"))
 431       (a (@ (id "comment")))
 432       (div
 433        (@ (class "avatar")
 434           (style "background-color:#bc80bd")) "?")
 435       (div
 436        (@ (class "message"))
 437        (div
 438         (@ (class "card"))
 439         ,@(if (and (mailer-enabled?)
 440                    (not (bug-archived bug)))
 441               `((form
 442                  (@ (action ,(format #f "/issue/~a/comment"
 443                                      (number->string id)))
 444                     (enctype "multipart/form-data")
 445                     (method "POST"))
 446                  (input (@ (style "display:none")
 447                            (name "validation")
 448                            (placeholder "Please leave this empty.")) "")
 449                  (input (@ (type "hidden")
 450                            (name "timestamp")
 451                            (value ,(timestamp!))) "")
 452                  (div
 453                   (@ (class "card-header"))
 454                   (div (@ (class "from"))
 455                        (input (@ (class "address form-control")
 456                                  (name "from")
 457                                  (required "required")
 458                                  (placeholder "Your name")) "")))
 459                  (div
 460                   (@ (class "body card-body"))
 461                   (textarea (@ (name "text")
 462                                (required "required")
 463                                (class "form-control")
 464                                (placeholder "Please input your comment..."))
 465                             ""))
 466                  (div
 467                   (@ (class "card-footer"))
 468                   (button (@ (class "btn btn-primary")
 469                              (type "submit"))
 470                           "Send")
 471                   (span (@ (class "ml-3"))
 472                    "Your may also "
 473                    (a (@ (href ,(string-append "mailto:"
 474                                                (number->string id) "@" (%config 'debbugs-domain)
 475                                                "?subject=" (bug-subject* bug))))
 476                       ,(string-append "send email to "
 477                                       (number->string id) "@" (%config 'debbugs-domain)))
 478                    " to comment."))))
 479               `((div
 480                  (@ (class "card-header"))
 481                  (div (@ (class "from"))
 482                       (span (@ (class "address")) "Your comment")))
 483                 (div
 484                  (@ (class "body card-body"))
 485                  ,(if (bug-archived bug)
 486                       '(p "This issue is archived.")
 487                       '(p "Commenting via the web interface is
 488 currently disabled."))
 489                  (p "To comment on this conversation "
 490                     (a (@ (href ,(string-append "mailto:"
 491                                                 (number->string id) "@" (%config 'debbugs-domain)
 492                                                 "?subject=" (bug-subject* bug))))
 493                        ,(string-append "send email to "
 494                                        (number->string id) "@" (%config 'debbugs-domain)))))))))))
 495   (define (show-message message-number message previous-subject)
 496     `((div (@ (class "mb-5"))
 497            (a (@ (class "message-anchor")
 498                  (id ,(number->string message-number))))
 499            (div
 500             (@ (class "avatar")
 501                (style ,(string-append "background-color:"
 502                                       (avatar-color (sender-email message)
 503                                                     (map extract-email parties)))))
 504             ,(string-upcase (string-take (sender-name message) 1)))
 505            (div
 506             (@ (class "message"))
 507             (div
 508              (@ (class "card"))
 509              (div
 510               (@ (class "card-header"))
 511               (div
 512                (@ (class "from"))
 513                (div
 514                 (@ (class "avatar")
 515                    (style ,(string-append "background-color:"
 516                                           (avatar-color (sender-email message)
 517                                                         (map extract-email parties)))))
 518                 ,(string-upcase (string-take (sender-name message) 1)))
 519                (span (@ (class "address")) ,(sender-name message))
 520                " wrote "
 521                (span (@ (class "date"))
 522                      (a (@ (href ,(string-append "#" (number->string
 523                                                       message-number)))
 524                            (title ,(date->string (date message))))
 525                         ,(time->string (date message)))))
 526               ,@(if (string-suffix? previous-subject (subject message))
 527                     '()
 528                     `((div (@ (class "subject")) ,(subject message))))
 529               (div
 530                (@ (class "details"))
 531                (div
 532                 (@ (class "recipients"))
 533                 (label "Recipients:")
 534                 ,(map (lambda (address)
 535                         `(span (@ (class "address")) ,address))
 536                       (recipients message)))
 537                (div
 538                 (@ (class "message-id"))
 539                 (label "Message-ID:")
 540                 ,(message-id message))))
 541              (div
 542               (@ (class "body card-body"))
 543               ,(display-message-body id message-number message)))))
 544       ,@(if (closing? message id)
 545             '((div
 546                (@ (class "row event"))
 547                (div
 548                 (@ (class "col-11 offset-1 text-center"))
 549                 (div (@ (class "badge badge-primary closed")) "Closed"))))
 550             '())))
 551
 552   (if (null? messages) #f
 553       (layout
 554        #:title (bug-subject* bug)
 555        #:body
 556        `(,(header #:title (bug-subject* bug))
 557          (div
 558           (@ (class "container"))
 559           ,@(match flash-message
 560               (('error . text)
 561                `((div (@ (class "alert alert-danger")
 562                          (role "alert"))
 563                       ,text)))
 564               (('info . text)
 565                `((div (@ (class "alert alert-info")
 566                          (role "alert"))
 567                       ,text)))
 568               (_ '()))
 569           ,sidebar
 570           (div
 571            (@ (class "title col-12"))
 572            (h1 (@ (class "h3")) ,(bug-subject* bug))
 573            ,issue-details)
 574           (div (@ (class "row"))
 575                (div
 576                 (@ (class "conversation col-12"))
 577                 ,(let ((msgs (filter (lambda (msg)
 578                                        ;; Ignore messages
 579                                        ;; without body, and
 580                                        ;; internal messages.
 581                                        (and msg
 582                                             (email-body msg)
 583                                             (not (internal-message? msg))))
 584                                      messages)))
 585                    (map (lambda (message-number msg previous-subject)
 586                           (show-message message-number msg previous-subject))
 587                         (iota (length msgs))
 588                         msgs
 589                         (cons (bug-subject* bug)
 590                               (map subject msgs))))
 591                 ,comment-box)))))))
 592
 593 (define (list-of-bugs bugs)
 594   "Return table rows for all BUGS."
 595   (map (lambda (bug)
 596          (let ((id (number->string (bug-num bug))))
 597            `(tr (@ (class ,(bug-severity bug)))
 598                 (td ,(or id "-"))
 599                 (td
 600                  ,@(if (member (bug-severity bug) '("serious" "important"))
 601                        `((svg (@ (xmlns"http://www.w3.org/2000/svg")
 602                                  (xmlns:xlink "http://www.w3.org/1999/xlink")
 603                                  (viewBox "0 0 14 16")
 604                                  (version "1.1")
 605                                  (height "1rem")
 606                                  (width "1rem")
 607                                  (aria-hidden "true"))
 608                               (title ,(bug-severity bug))
 609                               (path (@ (fill-rule "evenodd")
 610                                        (d "\
 611 M7 2.3c3.14 0 5.7 2.56 5.7 5.7\
 612 s-2.56 5.7-5.7 5.7A5.71 5.71 0 011.3 8\
 613 c0-3.14 2.56-5.7 5.7-5.7z\
 614 M7 1C3.14 1 0 4.14 0 8\
 615 s3.14 7 7 7 7-3.14 7-7-3.14-7-7-7z\
 616 m1 3H6v5h2V4zm0 6H6v2h2v-2z")))))
 617                        '())
 618                  ,@(or (and=> (bug-tags bug)
 619                               (lambda (tags)
 620                                 (map (lambda (tag)
 621                                        `(a (@ (href ,(string-append "search?query=tag:" tag)))
 622                                            (span
 623                                             (@ (class ,(string-append "badge badge-info mr-1 "
 624                                                                       tag)))
 625                                             ,tag)))
 626                                      (string-split tags #\space))))
 627                        '())
 628                  ,(if id
 629                          `(a (@ (href ,(string-append "/" id)))
 630                              ,(bug-subject* bug))
 631                          (bug-subject* bug)))
 632                 (td ,(date->string (bug-date bug)))
 633                 (td ,(status-tag bug)))))
 634        bugs))
 635
 636 (define (priority-bugs)
 637   (list-of-bugs (sort
 638                  (append
 639                   (bugs-by-severity "serious" "open")
 640                   (bugs-by-severity "important" "open"))
 641                  (lambda (a b) (< (bug-num a) (bug-num b))))))
 642
 643 (define* (list-of-recent-issues #:optional (max 100))
 644   (layout
 645    #:body
 646    `(,(header #:search-bar? #f)
 647      (div
 648       (@ (class "container"))
 649       (h1 "Recent issues")
 650       (table
 651        (@ (class "table table-borderless table-hover js-sort-table"))
 652        (thead
 653         (tr (@ (class "heading"))
 654             (th (@ (class "js-sort-number")) "ID")
 655             (th "Subject")
 656             (th "Date submitted")
 657             (th "Status")))
 658        (tbody
 659         ,@(list-of-bugs (recent-bugs max))))))))
 660
 661 (define* (list-of-forgotten-issues #:optional (max 100))
 662   (layout
 663    #:body
 664    `(,(header #:search-bar? #f)
 665      (div
 666       (@ (class "container"))
 667       (h1 "Forgotten issues")
 668       (table
 669        (@ (class "table table-borderless table-hover js-sort-table"))
 670        (thead
 671         (tr (@ (class "heading"))
 672             (th (@ (class "js-sort-number")) "ID")
 673             (th "Subject")
 674             (th "Date submitted")
 675             (th "Status")))
 676        (tbody
 677         ,@(list-of-bugs (forgotten-issues max))))))))
 678
 679 (define (list-of-matching-bugs query bugs)
 680   (layout
 681    #:body
 682    `(,(header #:search-bar? #f)
 683      (div
 684       (@ (class "container"))
 685       (h1 "Your search for " (code ,query))
 686       ,(search-widget #:text query)
 687       ,(if (null? bugs)
 688            `(div
 689              (@ (class "alert alert-warning")
 690                 (role "alert"))
 691              (h4
 692               (@ (class "alert-heading"))
 693               "Nothing found!")
 694              (p "We could not find any issues matching your query "
 695                 (code ,query) ". "
 696                 (a (@ (href "/"))
 697                    "Try searching for something else?")))
 698            `(table
 699              (@ (class "table table-borderless table-hover js-sort-table"))
 700              (thead
 701               (tr (@ (class "heading"))
 702                   (th (@ (class "js-sort-number")) "ID")
 703                   (th "Subject")
 704                   (th "Date submitted")
 705                   (th "Status")))
 706              (tbody
 707               ,@(list-of-bugs bugs))))))))