From 920707f2762c61e8e69970654a29344d56d22e74 Mon Sep 17 00:00:00 2001
From: pho4cexa <pho4cexa@orbital.rodeo>
Date: Mon, 12 Dec 2022 06:14:15 -0800
Subject: [PATCH] implemented (very basic) issues list according to m455 spec

---
 main.scm | 31 ++++++++++++++++++++++++++++---
 1 file changed, 28 insertions(+), 3 deletions(-)

diff --git a/main.scm b/main.scm
index d81cb90..b6d5b44 100755
--- a/main.scm
+++ b/main.scm
@@ -12,7 +12,9 @@
         (chicken file)
         sxml-transforms
         (clojurian syntax)
-        srfi-1
+        srfi-1  ;; list utils
+        srfi-13 ;; string utils
+        srfi-14 ;; charsets
         )
 
 (define CLONE-URL     (or (get-environment-variable "REPO2HTML_CLONE_URL") "git://git.example.com"))
@@ -103,7 +105,10 @@
                '("README" "README.md" "README.txt")))
         (license-file
          (find (lambda (x) (member x source-files-list))
-               '("LICENSE" "LICENSE.md" "LICENSE.txt"))))
+               '("LICENSE" "LICENSE.md" "LICENSE.txt")))
+        (issues-present?
+         (find (lambda (x) (string-prefix? "ISSUES/" x)) source-files-list)))
+
     (lambda (source-file body-sxml)
       (define-values (_ _ _ _ relative-root) (pathparts source-file))
       `(html (@ lang en)
@@ -124,6 +129,8 @@
           (a (@ href ,relative-root "files.html") "files")
           ,(when license-file
              `(a (@ href ,relative-root ,license-file ".html") "license"))
+          ,(when issues-present?
+             `(a (@ href ,relative-root "ISSUES.html") "issues"))
           (a (@ href ,relative-root "commits.html") "commits")
           (a (@ href ,relative-root "contributors.html") "contributors")))
         (hr)
@@ -207,6 +214,21 @@
            `(tr (td ,author) (td ,commits))))
        (call-with-input-pipe "git shortlog -ns HEAD" read-lines)))))
 
+(define (issueslist->sxml source-files-list)
+  `((h1 "Issues")
+    ((ul
+      ,(filter-map
+        (lambda (source-file)
+          (and
+           (string-prefix? "ISSUES/" source-file)
+           `(li (a (@ href ,source-file ".html")
+                   ,(->
+                     source-file
+                     ((flip format) "git show HEAD:~a")
+                     (call-with-input-pipe read-line)
+                     (string-trim (string->char-set "# ")))))))
+        source-files-list)))))
+
 (define (generate-html-files html-repo-path)
   (let* ((source-files-list (git-repository->paths-list))
          (repository-name (pathname-strip-directory (string-chomp html-repo-path "/")))
@@ -244,7 +266,10 @@
      '("README.md.html" "README.html" "README.txt.html" "files.html")
      (map (lambda (x) (make-pathname html-repo-path x)))
      (find file-exists?)
-     ((lambda (x) (copy-file x (make-pathname html-repo-path "index.html") #t))))))
+     ((lambda (x) (copy-file x (make-pathname html-repo-path "index.html") #t))))
+
+    (when (file-exists? (make-pathname html-repo-path "ISSUES"))
+      (write-with-template "ISSUES.html" (issueslist->sxml source-files-list)))))
 
 (define (main args)
   (let-optionals args ((html-repo-path ""))