01/04: hydra/goggles: Group logs by year and month.

[Ricardo Wurmus]

rekado pushed a commit to branch master
in repository maintenance.

commit 5cb7a9bc656c7bd373e419776f1f5dc68ecfb2de
Author: Ricardo Wurmus <address@hidden>
AuthorDate: Fri May 8 05:48:50 2020 +0200

    hydra/goggles: Group logs by year and month.
    
    * hydra/goggles.scm (group-by): New procedure.
    (index): Use it.
    (css): Update.
---
 hydra/goggles.scm | 83 ++++++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 73 insertions(+), 10 deletions(-)

diff --git a/hydra/goggles.scm b/hydra/goggles.scm
index 264a830..596ddf2 100755
--- a/hydra/goggles.scm
+++ b/hydra/goggles.scm
@@ -156,6 +156,25 @@ h2 {
   font-weight: 200;
 }
 
+h3 {
+  padding: .5em 0;
+  border-top: 3px dotted #ddd;
+  margin-bottom: 0;
+}
+
+a {
+  color: #007bff;
+  text-decoration: none;
+}
+
+a:hover {
+  text-decoration: underline;
+}
+
+h4 {
+  margin-bottom: .5em;
+}
+
 table td {
   padding: 0.75em;
 }
@@ -164,6 +183,21 @@ table tr:hover {
   background: #eee;
 }
 
+.year {
+  display: table;
+}
+
+.month {
+  display: table-cell;
+  padding-right: 1em;
+}
+
+ul {
+  margin: 0;
+  padding: 0;
+  list-style: none;
+}
+
 .nick {
   padding-right: 0.6rem;
   font-weight: bold;
@@ -197,11 +231,6 @@ table tr:hover {
   margin-top: 1.5rem;
   padding: 1.5rem;
 }
-
-ul {
-  column-count: 20;
-  column-width: 170px;
-}
 ")
 
 (define colors
@@ -288,7 +317,30 @@ representation highlighting certain parts."
                               #:port (assoc-ref %config 'port)
                               #:path (string-join path "/" 'prefix))))))
 
+(define (group-by proc files)
+    (define (inner init files)
+      (call-with-values
+          (lambda ()
+            (span (lambda (file-name)
+                    (string=? (proc file-name) init))
+                  files))
+        (lambda (group rest)
+          (if (null? rest)
+              (list group)
+              (cons group
+                    (inner (proc (first rest))
+                           rest))))))
+    (inner (proc (first files)) files))
+
 (define (index channel)
+  (define (get-year file-name)
+    (first (string-split file-name #\-)))
+  (define (get-month file-name)
+    (second (string-split file-name #\-)))
+  (define group-by-year
+    (cut group-by get-year <>))
+  (define group-by-month
+    (cut group-by get-month <>))
   `(html
     (head (title ,(string-append channel " IRC channel logs"))
           (style ,css))
@@ -296,11 +348,22 @@ representation highlighting certain parts."
      (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 ,(string-append "/" channel "/" file))) 
,file)))
-             (or (channel-files channel)
-                 '()))))))
+     (div
+      (@ (class "years"))
+      ,@(map (lambda (files)
+               `((h3 ,(get-year (first files)))
+                 (div
+                  (@ (class "year"))
+                  ,@(map (lambda (files)
+                           `((div
+                              (@ (class "month"))
+                              (h4 ,(get-month (first files)))
+                              (ul
+                               ,@(map (lambda (file)
+                                        `(li (a (@ (href ,(string-append "/" 
channel "/" file))) ,file)))
+                                      files)))))
+                         (group-by-month files)))))
+             (group-by-year (channel-files channel)))))))
 
 (define (search-results channel query)
   `(html