01/01: hydra: Enable log viewing for #guile and #bootstrappable.

[Ricardo Wurmus]

rekado pushed a commit to branch master
in repository maintenance.

commit 6dc4dc1301081fc6c42655eaa3c9c3864eaedd24
Author: Ricardo Wurmus <address@hidden>
Date:   Thu Aug 8 14:12:16 2019 +0200

    hydra: Enable log viewing for #guile and #bootstrappable.
    
    * hydra/goggles.scm (%log-root): Use new location.
    (render-log): Do not mention #guix.
    (index): Take the channel name as an argument; use it.
    (%controller): Awkwardly handle other channels.
---
 hydra/goggles.scm | 39 ++++++++++++++++++++++++++-------------
 1 file changed, 26 insertions(+), 13 deletions(-)

diff --git a/hydra/goggles.scm b/hydra/goggles.scm
index 4082bd0..b762172 100644
--- a/hydra/goggles.scm
+++ b/hydra/goggles.scm
@@ -14,7 +14,7 @@
              (ice-9 regex)
              (ice-9 textual-ports))
 
-(define %log-root "/var/www/.well-known/logs/")
+(define %log-root "/var/www/.well-known/all-logs/")
 (define %config
   '((host . "0.0.0.0")
     (port . 3333)))
@@ -154,10 +154,10 @@ representation highlighting certain parts."
                (handle-line (make-line-renderer split-lines)))
           (render-html
            `(html
-             (head (title "Guix IRC channel logs")
+             (head (title "IRC channel logs")
                    (style ,css))
              (body
-              (h1 "#guix channel logs")
+              (h1 "IRC channel logs")
               (h2 ,path)
               (p (a (@ (href "/")) "back to list of logs"))
               (div (@ (id "logs"))
@@ -167,27 +167,40 @@ representation highlighting certain parts."
                               #:port (assoc-ref %config 'port)
                               #:path (string-join path "/" 'prefix))))))
 
-(define (index)
+(define (index channel)
   `(html
-    (head (title "Guix IRC channel logs")
+    (head (title ,(string-append channel " IRC channel logs"))
           (style ,css))
     (body
-     (h1 "Guix IRC channel logs")
-     (p "These are the channel logs for the #guix IRC channel on
-freenode.")
+     (h1 ,(string-append channel " IRC channel logs"))
+     (p ,(format #f "These are the channel logs for the #~a IRC channel on
+freenode." channel))
      (ul
       ,@(map (lambda (file)
-               `(li (a (@ (href ,file)) ,file)))
-             (or (scandir %log-root (lambda (name)
-                                      (not (member name '("." ".." 
"index.html")))))
+               `(li (a (@ (href ,(string-append "/" channel "/" file))) 
,file)))
+             (or (scandir (string-append %log-root "/#" channel "/")
+                          (lambda (name)
+                           (not (member name '("." ".." "index.html")))))
                  '()))))))
 
 (define %controller
   (match-lambda
     ((GET)
-     (render-html (index)))
+     (render-html (index "guix")))
+    ((GET "guix")
+     (render-html (index "guix")))
+    ((GET "guile")
+     (render-html (index "guile")))
+    ((GET "bootstrappable")
+     (render-html (index "bootstrappable")))
+    ((GET "guix" path ...)
+     (render-log (string-append %log-root "/#guix/") path))
+    ((GET "guile" path ...)
+     (render-log (string-append %log-root "/#guile/") path))
+    ((GET "bootstrappable" path ...)
+     (render-log (string-append %log-root "/#bootstrappable/") path))
     ((GET path ...)
-     (render-log %log-root path))))
+     (render-log (string-append %log-root "/#guix/") path))))
 
 (define (request-path-components request)
   (split-and-decode-uri-path (uri-path (request-uri request))))