From c69fe335e3b9177cd965cf6d75f7f4142f93fc63 Mon Sep 17 00:00:00 2001
From: pho4cexa <pho4cexa@orbital.rodeo>
Date: Sun, 4 Dec 2022 18:07:09 -0800
Subject: [PATCH] generate a simple contributors file

i very much don't know quite what i'm doing with scheme's ports and
capturing output to write to files. this arrangement seems to work but i
suspect some of my changes are unnecessary or redundant and there must
be a much more elegant way to write it
---
 main.scm | 20 ++++++++++++++++++--
 1 file changed, 18 insertions(+), 2 deletions(-)

diff --git a/main.scm b/main.scm
index 11db882..fe948b7 100755
--- a/main.scm
+++ b/main.scm
@@ -9,7 +9,9 @@
         (chicken process-context)
         (chicken format)
         (chicken pathname)
-        (chicken file))
+        (chicken file)
+        sxml-transforms
+        )
 
 (define WEB-DIRECTORY (or (get-environment-variable "GIT_WWW") "/var/www/git"))
 (define CLONE-URL     (or (get-environment-variable "GIT_WWW_CLONE_URL") "git://git.example.com"))
@@ -62,6 +64,7 @@ hr {
 <nav>
 <a href="/#{REPOSITORY-NAME}/index.html">about</a>
 <a href="/#{REPOSITORY-NAME}/files.html">files</a>
+<a href="/#{REPOSITORY-NAME}/contributors.html">contributors</a>
 </nav>
 <hr>
 #{body}
@@ -71,7 +74,7 @@ string-block
 )
 
 (define (write-file file contents)
-  (with-output-to-file file (lambda () (display contents))))
+  (call-with-output-file file (lambda (port) (write-line contents port))))
 
 (define (in-git-directory?)
   (equal? (call-with-input-pipe "git rev-parse --is-bare-repository 2> /dev/null" read-line) "true"))
@@ -139,6 +142,18 @@ string-block
     index-page-path
     (populate-html-template (md->html (git-file->string "README.md")))))
 
+(define (generate-contributors-html)
+  (populate-html-template
+   (with-output-to-string
+     (lambda ()
+       (SXML->HTML
+        `((h1 "Contributors")
+          (ul ,(map
+                (lambda (line)
+                  (let-values (((commits . author) (apply values (string-split line "\t"))))
+                    `(li ,author)))
+                (call-with-input-pipe "git shortlog -ns HEAD" read-lines)))))))))
+
 (define (generate-repository-directory)
   (if (directory-exists? REPOSITORY-DIRECTORY)
     (begin (delete-directory REPOSITORY-DIRECTORY #t)
@@ -150,6 +165,7 @@ string-block
     (generate-repository-directory)
     (generate-readme-page (make-pathname REPOSITORY-DIRECTORY "index.html"))
     (generate-files-page (make-pathname REPOSITORY-DIRECTORY "files.html") source-files-list)
+    (write-file (make-pathname REPOSITORY-DIRECTORY "contributors.html") (generate-contributors-html))
     (generate-source-files source-files-list)))
 
 (define (bail . args)