github/repo2html
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

implemented (very basic) issues list according to m455 spec

Browse source
This commit is contained in:
pho4cexa 2022-12-12 06:14:15 -08:00 committed by m455
parent fa65d5ba49
commit 920707f276
1 changed files with 28 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
main.scm
View file

@ -12,7 +12,9 @@
(chicken file) (chicken file)
sxml-transforms sxml-transforms
(clojurian syntax) (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")) (define CLONE-URL (or (get-environment-variable "REPO2HTML_CLONE_URL") "git://git.example.com"))
@ -103,7 +105,10 @@
'("README" "README.md" "README.txt"))) '("README" "README.md" "README.txt")))
(license-file (license-file
(find (lambda (x) (member x source-files-list)) (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) (lambda (source-file body-sxml)
(define-values (_ _ _ _ relative-root) (pathparts source-file)) (define-values (_ _ _ _ relative-root) (pathparts source-file))
`(html (@ lang en) `(html (@ lang en)
@ -124,6 +129,8 @@
(a (@ href ,relative-root "files.html") "files") (a (@ href ,relative-root "files.html") "files")
,(when license-file ,(when license-file
`(a (@ href ,relative-root ,license-file ".html") "license")) `(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 "commits.html") "commits")
(a (@ href ,relative-root "contributors.html") "contributors"))) (a (@ href ,relative-root "contributors.html") "contributors")))
(hr) (hr)
@ -207,6 +214,21 @@
`(tr (td ,author) (td ,commits)))) `(tr (td ,author) (td ,commits))))
(call-with-input-pipe "git shortlog -ns HEAD" read-lines))))) (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) (define (generate-html-files html-repo-path)
(let* ((source-files-list (git-repository->paths-list)) (let* ((source-files-list (git-repository->paths-list))
(repository-name (pathname-strip-directory (string-chomp html-repo-path "/"))) (repository-name (pathname-strip-directory (string-chomp html-repo-path "/")))
@ -244,7 +266,10 @@
'("README.md.html" "README.html" "README.txt.html" "files.html") '("README.md.html" "README.html" "README.txt.html" "files.html")
(map (lambda (x) (make-pathname html-repo-path x))) (map (lambda (x) (make-pathname html-repo-path x)))
(find file-exists?) (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) (define (main args)
(let-optionals args ((html-repo-path "")) (let-optionals args ((html-repo-path ""))