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
This commit is contained in:
pho4cexa 2022-12-04 18:07:09 -08:00 committed by m455
parent f09f679ad3
commit c69fe335e3

View file

@ -9,7 +9,9 @@
(chicken process-context) (chicken process-context)
(chicken format) (chicken format)
(chicken pathname) (chicken pathname)
(chicken file)) (chicken file)
sxml-transforms
)
(define WEB-DIRECTORY (or (get-environment-variable "GIT_WWW") "/var/www/git")) (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")) (define CLONE-URL (or (get-environment-variable "GIT_WWW_CLONE_URL") "git://git.example.com"))
@ -62,6 +64,7 @@ hr {
<nav> <nav>
<a href="/#{REPOSITORY-NAME}/index.html">about</a> <a href="/#{REPOSITORY-NAME}/index.html">about</a>
<a href="/#{REPOSITORY-NAME}/files.html">files</a> <a href="/#{REPOSITORY-NAME}/files.html">files</a>
<a href="/#{REPOSITORY-NAME}/contributors.html">contributors</a>
</nav> </nav>
<hr> <hr>
#{body} #{body}
@ -71,7 +74,7 @@ string-block
) )
(define (write-file file contents) (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?) (define (in-git-directory?)
(equal? (call-with-input-pipe "git rev-parse --is-bare-repository 2> /dev/null" read-line) "true")) (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 index-page-path
(populate-html-template (md->html (git-file->string "README.md"))))) (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) (define (generate-repository-directory)
(if (directory-exists? REPOSITORY-DIRECTORY) (if (directory-exists? REPOSITORY-DIRECTORY)
(begin (delete-directory REPOSITORY-DIRECTORY #t) (begin (delete-directory REPOSITORY-DIRECTORY #t)
@ -150,6 +165,7 @@ string-block
(generate-repository-directory) (generate-repository-directory)
(generate-readme-page (make-pathname REPOSITORY-DIRECTORY "index.html")) (generate-readme-page (make-pathname REPOSITORY-DIRECTORY "index.html"))
(generate-files-page (make-pathname REPOSITORY-DIRECTORY "files.html") source-files-list) (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))) (generate-source-files source-files-list)))
(define (bail . args) (define (bail . args)