Move all header modifications to the controller.

3 files changed, 75 insertions, 74 deletions

diff --git a/mumi/web/controller.scm b/mumi/web/controller.scm
index 56b8eaf..4849a9e 100644
--- a/mumi/web/controller.scm
+++ b/mumi/web/controller.scm
@@ -20,6 +20,7 @@
   #:use-module (ice-9 pretty-print)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module ((debbugs bug) #:select (bug-archived bug-done))
   #:use-module (web request)
   #:use-module (web uri)
   #:use-module (webutils sessions)
@@ -48,9 +49,11 @@
 (define (controller request body)
   (match-lambda
     (('GET)
-     (apply render-html (index)))
+     (render-html (index)
+                  #:extra-headers
+                  '((cache-control . ((max-age . 60))))))
     (('GET "easy")
-     (apply render-html (list-of-matching-bugs "tag:easy" (easy-bugs))))
+     (render-html (list-of-matching-bugs "tag:easy" (easy-bugs))))
     (('GET "search")
      (let ((query (-> request
                       request-uri
@@ -74,24 +77,35 @@
         ;; Search for matching messages and return list of bug reports
         ;; that belong to them.
         (else
-         (apply render-html
-                (list-of-matching-bugs query
-                                       (match (process-query query)
-                                         ((#:terms terms
-                                           #:sets s)
-                                          (search-bugs (string-join terms)
-                                                       #:sets s)))))))))
+         (render-html
+          (list-of-matching-bugs query
+                                 (match (process-query query)
+                                   ((#:terms terms
+                                     #:sets s)
+                                    (search-bugs (string-join terms)
+                                                 #:sets s)))))))))
     ((or ('GET "issue" (? string->number id))
          ('GET (? string->number id)))
-     (let ((message (match (uri-query (request-uri request))
+     (let ((bug (fetch-bug id))
+           (message (match (uri-query (request-uri request))
                       ("comment-ok"
                        '(info . "Your comment has been submitted!"))
                       ("comment-error"
                        '(error . "There was an error submitting your comment!"))
                       (_ #f))))
-       (apply render-html (or (and=> (fetch-bug id)
-                                     (lambda (bug) (issue-page bug message)))
-                              (unknown id)))))
+       (if bug
+           (let ((headers
+                   (cond
+                    ((bug-archived bug)
+                     ;; Tell browser to cache this for 12 hours.
+                     '((cache-control . ((max-age . 43200)))))
+                    ((bug-done bug)
+                     ;; Tell browser to cache this for 1 hour.
+                     '((cache-control . ((max-age . 3600)))))
+                    (else '()))))
+             (render-html (issue-page bug message)
+                          #:extra-headers headers))
+           (render-html (unknown id)))))
     (('GET "issue" (? string->number id)
           "attachment" (? string->number msg-num)
           (? string->number path) ...)
@@ -99,8 +113,11 @@
                       (string->number msg-num)
                       (map string->number path)))
     (('GET "issue" not-an-id)
-     (apply render-html (unknown not-an-id)))
+     (render-html (unknown not-an-id)))
     (('GET "help")
-     (apply render-html (help)))
+     (render-html (help)
+                  ;; Cache for 24 hours.
+                  #:extra-headers
+                  '((cache-control . ((max-age . 86400))))))
     (('GET path ...)
      (render-static-asset request))))
diff --git a/mumi/web/render.scm b/mumi/web/render.scm
index 7f99731..0b4b705 100644
--- a/mumi/web/render.scm
+++ b/mumi/web/render.scm
@@ -96,7 +96,7 @@
               failure))
         failure)))
 
-(define* (render-html #:key sxml (extra-headers '()))
+(define* (render-html sxml #:key (extra-headers '()))
   (list (append extra-headers
                 '((content-type . (text/html))))
         (lambda (port)
diff --git a/mumi/web/view/html.scm b/mumi/web/view/html.scm
index cbc907d..9771dee 100644
--- a/mumi/web/view/html.scm
+++ b/mumi/web/view/html.scm
@@ -45,50 +45,48 @@
 (define* (layout #:key
                  (head '())
                  (body '())
-                 (title "Guix issue tracker")
-                 (extra-headers '()))
-  `(#:sxml ((doctype "html")
-            (html
-             (head
-              (title ,title)
-              (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8")))
-              (meta (@ (http-equiv "Content-Language") (content "en")))
-              (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/reset.css")))
-              (link
-               (@ (rel "stylesheet")
-                  (media "screen")
-                  (type "text/css")
-                  (href "/css/bootstrap.css")))
-              ,@head
-              (link
-               (@ (rel "stylesheet")
-                  (media "screen")
-                  (type "text/css")
-                  (href "/css/screen.css")))
-              (link
-               (@ (rel "stylesheet")
-                  (media "screen")
-                  (type "text/css")
-                  (href "/css/code.css"))))
-             (body ,@body
-                   (footer (@ (class "text-center"))
-                    (p "Copyright © 2016—2020 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
-              (@ (type "text/javascript")
-                 (src "/js/sort-table.js")))))
-    #:extra-headers ,extra-headers))
+                 (title "Guix issue tracker"))
+  `((doctype "html")
+    (html
+     (head
+      (title ,title)
+      (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8")))
+      (meta (@ (http-equiv "Content-Language") (content "en")))
+      (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/reset.css")))
+      (link
+       (@ (rel "stylesheet")
+          (media "screen")
+          (type "text/css")
+          (href "/css/bootstrap.css")))
+      ,@head
+      (link
+       (@ (rel "stylesheet")
+          (media "screen")
+          (type "text/css")
+          (href "/css/screen.css")))
+      (link
+       (@ (rel "stylesheet")
+          (media "screen")
+          (type "text/css")
+          (href "/css/code.css"))))
+     (body ,@body
+           (footer (@ (class "text-center"))
+                   (p "Copyright © 2016—2020 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
+      (@ (type "text/javascript")
+         (src "/js/sort-table.js"))))))
 
 (define* (search-form #:key (standalone? #f) (text ""))
   `(form (@ (id "search")
@@ -170,8 +168,6 @@
 
 (define (index)
   (layout
-   #:extra-headers
-   '((cache-control . ((max-age . 60))))
    #:body
    `(,(header #:search-bar? #f)
      (main
@@ -213,9 +209,6 @@
 
 (define (help)
   (layout
-   #:extra-headers
-   ;; Cache for 24 hours.
-   '((cache-control . ((max-age . 86400))))
    #:body
    `(,(header #:search-bar? #f)
      (div
@@ -354,15 +347,6 @@ some examples.")
             '())))
   (layout
    #:title (bug-subject* bug)
-   #:extra-headers
-   (cond
-    ((bug-archived bug)
-     ;; Tell browser to cache this for 12 hours.
-     '((cache-control . ((max-age . 43200)))))
-    ((bug-done bug)
-     ;; Tell browser to cache this for 1 hour.
-     '((cache-control . ((max-age . 3600)))))
-    (else '()))
    #:body
    `(,(header)
      (div