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:
parent
f09f679ad3
commit
c69fe335e3
1 changed files with 18 additions and 2 deletions
20
main.scm
20
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)
|
||||
|
|
Loading…
Reference in a new issue