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

enable customizable jinja-like templates via ersatz!

Browse source 
well this was a journey :)

behavior when running `repo2html <output directory>` remains the same;
we apply our internal sxml template as usual.

to use ersatz templates, run like this:

`repo2html <output directory> <template directory>`

the program will look for a "default.html" file in that directory.
This commit is contained in:
pho4cexa 2022-12-16 09:28:55 -08:00 committed by m455
parent 1209725add
commit 35496ee17e
3 changed files with 259 additions and 123 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
README.md
View file

@ -28,15 +28,16 @@ no one is liable if this software breaks, deletes, corrupts, or ruins anything
## requirements
- [chicken scheme](https://call-cc.org/), and eggs:
- [utf8](https://wiki.call-cc.org/eggref/5/utf8)
- [lowdown](https://wiki.call-cc.org/eggref/5/lowdown)
- [sxml-transforms](https://wiki.call-cc.org/eggref/5/sxml-transforms)
- [clojurian](https://wiki.call-cc.org/eggref/5/clojurian)
- [symbol-utils](https://wiki.call-cc.org/eggref/5/symbol-utils)
- [ersatz](https://wiki.call-cc.org/eggref/5/ersatz)
- [lowdown](https://wiki.call-cc.org/eggref/5/lowdown)
- [scss](https://wiki.call-cc.org/eggref/5/scss)
- [srfi-1](https://wiki.call-cc.org/eggref/5/srfi-1)
- [srfi-13](https://wiki.call-cc.org/eggref/5/srfi-13)
- [srfi-14](https://wiki.call-cc.org/eggref/5/srfi-14)
- [sxml-transforms](https://wiki.call-cc.org/eggref/5/sxml-transforms)
- [symbol-utils](https://wiki.call-cc.org/eggref/5/symbol-utils)
- [utf8](https://wiki.call-cc.org/eggref/5/utf8)
- git
### installation
@ -65,7 +66,6 @@ TODO
- **feature**: multi-page or collapse-able files list
- **feature**: branches and releases (tags)
- **feature**: clickable line numbers in source files
- **feature**: customizable templates
- **feature**: display binary files as output from binary-file analysis tools like hexdump, xxd, dumpelf, elfls, readelf, etc.?
- **feature**: syntax highlighting?
- **feature**: markdown-render git log text

328
main.scm
View file

@ -10,8 +10,9 @@
(chicken process-context)
(chicken string)
(clojurian syntax)
scss
ersatz
lowdown
scss
srfi-1 ;; list utils
srfi-13 ;; string utils
srfi-14 ;; charsets
@ -37,11 +38,11 @@
;; decompose a path s into its constituent parts. returns values:
;;
;; root: "/" if it's an absolute path, "" if relative
;; directory-elements: a list of each directory from root, () if none
;; basename: the filename with extension removed like "readme" or ".bashrc"
;; extension: the file extension with the dot, like ".txt" or "" if none
;; relative-root: the relative path from the given path to the root
;; root: "/" if it's an absolute path, "" if relative directory-elements: a list
;; of each directory from root, () if none basename: the filename with extension
;; removed like "readme" or ".bashrc" extension: the file extension with the
;; dot, like ".txt" or "" if none relative-root: the relative path from the
;; given path to the root
;; e.g foo/bar/baz.html -> ../../
;;
;; this is intended to provide default values that make for easier reassembly
@ -71,9 +72,113 @@
(define (substring* s start end)
(substring s (max start 0) (min end (string-length s))))
;; main code ---------------------------------
;; merge alists a and b. values in b "win"
(define (alist-merge a b)
(lset-union (lambda (x y) (eq? (car x) (car y))) a b))
(define mycss
;; auto-apply ids to headings ---------------------------------
(define (slugify _ inner)
(->
inner
(pre-post-order*
`((*text* .
,(lambda (_ str)
(if (string? str)
(->
str
(string-downcase)
(string-translate "/,:;\"[]{}()=+")
(string-translate " _." "---"))
str)))
,@alist-conv-rules*))
(flatten)
((flip map) ->string)
(string-intersperse "")
(substring* 0 40)))
(define (enumerate-tag tag inner)
`(,tag (@ (id ,tag "-" ,(slugify tag inner))) ,inner))
(define sxml-html-rules
`(;; assign all headings an id so you can link to them
(h1 . ,enumerate-tag)
(h2 . ,enumerate-tag)
(h3 . ,enumerate-tag)
(h4 . ,enumerate-tag)
(h5 . ,enumerate-tag)
;; this copied from lowdown html-serialization-rules* because it
;; is for some reason not exported??
(*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>)))
;; ignore #<unspecified> in tree
(*text* . ,(lambda (_ str) (if (unspecified? str) "" str)))
,@alist-conv-rules*))
;; vvv sxml template writer ------------------------------------------------
;;
;; if we decide to only use the ersatz templates, this whole chunk can be deleted!
;;
;; or we can keep it as a fall-back, or let the user choose which they prefer? idk
(define (make-template-writer-sxml #!optional vars)
(let* ((source-files-list (alist-ref 'source_files_list vars)))
(lambda (output-filename body-sxml #!optional newvars)
(if-let (destination-directory (pathname-directory output-filename))
(create-directory destination-directory #t)
'())
(let ((vars (alist-merge vars (or newvars '()))))
(with-output-to-file output-filename
(lambda ()
(define-values (_ _ _ _ relative-root) (pathparts (or (alist-ref 'source_file vars) "")))
(display "<!DOCTYPE html>\n")
(SXML->HTML
(pre-post-order*
(my-sxml-template body-sxml vars)
sxml-html-rules))))))))
(define (my-sxml-template body-sxml vars)
(let (
(clone-url-prefix (alist-ref 'clone_url_prefix vars))
(forge-title (alist-ref 'forge_title vars))
(h1 (alist-ref 'h1 vars))
(issues-file (alist-ref 'issues_file vars))
(license-file (alist-ref 'license_file vars))
(readme-file (alist-ref 'readme_file vars))
(relative-root (alist-ref 'relative_root vars))
(repository-description (alist-ref 'repository_description vars))
(repository-name (alist-ref 'repository_name vars))
(source-file (alist-ref 'source_file vars))
)
`(html (@ lang en)
(head
(title ,(string-append forge-title " - " repository-name))
(meta (@ charset utf-8))
(meta (@ (name viewport) (content "width=device-width, initial-scale-1.0, user-scalable=yes")))
(link (@ (rel icon) (href "data:,")))
(meta (@ (name description) (content ,repository-description)))
(style ,my-css))
(body
(h1 ,h1)
(h2 ,repository-name)
(p "clone url:" ,clone-url-prefix "/" ,repository-name)
(nav
,(if readme-file
`((a (@ href ,relative-root "index.html") "about")
(a (@ href ,relative-root "files.html") "files"))
`((a (@ href ,relative-root "index.html") "files")))
,(when license-file
`(a (@ href ,relative-root ,license-file ".html") "license"))
,(when issues-file
`(a (@ href ,relative-root ,issues-file ".html") "issues"))
(a (@ href ,relative-root "commits.html") "commits")
(a (@ href ,relative-root "contributors.html") "contributors")))
(hr)
,body-sxml
(hr)
(footer (p "Generated by " (a (@ href "https://git.m455.casa/repo2html/") "repo2html") " using sxml templates")))))
(define my-css
(with-output-to-string
(lambda ()
(write-css
@ -105,86 +210,31 @@
;; change this to your liking
))))))
(define (make-sxml-template-wrapper repository-name source-files-list)
(let ((readme-file
(find (lambda (x) (member x source-files-list))
'("README" "README.md" "README.txt")))
(license-file
(find (lambda (x) (member x source-files-list))
'("LICENSE" "LICENSE.md" "LICENSE.txt")))
(issues-present?
(find (lambda (x) (string-prefix? "ISSUES/" x)) source-files-list)))
;; ^^^ sxml template writer ------------------------------------------------
(lambda (source-file body-sxml)
(define-values (_ _ _ _ relative-root) (pathparts source-file))
`(html (@ lang en)
(head
(title ,(string-append TITLE " - " repository-name))
(meta (@ charset utf-8))
(meta (@ (name viewport) (content "width=device-width, initial-scale-1.0, user-scalable=yes")))
(link (@ (rel icon) (href "data:,")))
(meta (@ (name description) (content ,DESCRIPTION)))
(style ,mycss))
(body
(h1 ,H1)
(h2 ,repository-name)
(p "clone url:" ,CLONE-URL "/" ,repository-name)
(nav
,(when readme-file
`(a (@ href ,relative-root "index.html") "about"))
(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)
,body-sxml
(hr)
(footer (p "Generated by " (a (@ href "https://git.m455.casa/repo2html/") "repo2html")))))))
(define (slugify _ inner)
(->
inner
(pre-post-order*
`((*text* .
,(lambda (_ str)
(if (string? str)
(->
str
(string-downcase)
(string-translate "/,:;\"[]{}()=+")
(string-translate " _." "---"))
str)))
,@alist-conv-rules*))
(flatten)
((flip map) ->string)
(string-intersperse "")
(substring* 0 40)))
(define (enumerate-tag tag inner)
`(,tag (@ (id ,tag "-" ,(slugify tag inner))) ,inner))
;; reading in data from git commands
(define (in-git-directory?)
(not (eof-object? (call-with-input-pipe "git rev-parse --git-dir" read-line))))
(define (git-file-is-text? path)
(define (git-file-is-text? source-file)
(not (equal?
"-\t-\t"
(call-with-input-pipe
(string-append "git diff 4b825dc642cb6eb9a060e54bf8d69288fbee4904 --numstat HEAD -- " path)
(lambda (port) (read-line port 4))))))
"-\t-\t"
(call-with-input-pipe
(string-append "git diff 4b825dc642cb6eb9a060e54bf8d69288fbee4904 --numstat HEAD -- " source-file)
(lambda (port) (read-line port 4))))))
(define (git-repository->paths-list)
(call-with-input-pipe "git ls-tree -r --name-only HEAD" read-lines))
(define (git-file->string path)
(define (git-file->string source-file)
(->
(format "git show HEAD:~a" path)
(format "git show HEAD:~a" source-file)
(call-with-input-pipe read-lines)
(string-intersperse "\n")))
;; sxml generators for constructed pages
(define (source->sxml source-file) ;; src/main.scm
(define-values (_ _ basename extension _)
(pathparts source-file))
@ -257,70 +307,112 @@
(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 "/")))
(template-wrap->sxml (make-sxml-template-wrapper repository-name source-files-list)))
;; used by ersatz writer
(define (alist->tvals vars)
(map (lambda (pair)
`(,(car pair) . ,(sexpr->tvalue (cdr pair)))) vars))
(define (write-with-template filename sxml)
(let ((destination-directory (pathname-directory filename)))
(when destination-directory
(create-directory (make-pathname html-repo-path destination-directory) #t)))
(with-output-to-file (make-pathname html-repo-path filename)
;; this version uses a jinja-style template via ersatz
(define (make-template-writer-ersatz templates-directory #!optional vars)
(define template (statements-from-file (template-std-env search-path: (list templates-directory)) "default.html"))
(lambda (output-filename body-sxml #!optional newvars)
;; create destination directory if needed
(if-let (destination-directory (pathname-directory output-filename))
(create-directory destination-directory #t)
'())
(let* (;; render the sxml to a html string that we can hand to the template
(body-html
(with-output-to-string
(lambda ()
(SXML->HTML (pre-post-order* body-sxml sxml-html-rules)))))
;; vars = global vars + file-specific vars + body k/v pair
(vars
(alist-cons
'content body-html
(alist-merge vars (or newvars '())))))
(with-output-to-file output-filename
(lambda ()
(display "<!DOCTYPE html>\n")
(SXML->HTML
(pre-post-order*
(template-wrap->sxml filename sxml)
`(;; assign all headings an id so you can link to them
(h1 . ,enumerate-tag)
(h2 . ,enumerate-tag)
(h3 . ,enumerate-tag)
(h4 . ,enumerate-tag)
(h5 . ,enumerate-tag)
;; this copied from lowdown html-serialization-rules* because it
;; is for some reason not exported??
(*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>)))
;; ignore #<unspecified> in tree
(*text* . ,(lambda (_ str) (if (unspecified? str) "" str)))
,@alist-conv-rules*))))))
(display (eval-statements template models: (alist->tvals vars))))))))
; main program ------------------------------------------------------------------------------
(define (generate-html-files html-repo-path templates-directory)
(let* ((source-files-list (git-repository->paths-list))
(repository-name (pathname-strip-directory (string-chomp html-repo-path "/")))
(template-alist `(;; variables provided to template at all times
(source_files_list . ,source-files-list)
(clone_url_prefix . ,CLONE-URL)
(forge_title . ,TITLE)
(h1 . ,H1)
(repository_description . ,DESCRIPTION)
(repository_name . ,repository-name)
(readme_file
. ,(find (lambda (x) (member x source-files-list))
'("README" "README.md" "README.txt")))
(license_file
. ,(find (lambda (x) (member x source-files-list))
'("LICENSE" "LICENSE.md" "LICENSE.txt")))
(issues_file
. ,(and (find (lambda (x) (string-prefix? "ISSUES/" x)) source-files-list) "ISSUES"))
))
(write-with-template
;; which template writer do you prefer to use? uncomment one of the next two lines.
(if (equal? "sxml" templates-directory)
(make-template-writer-sxml template-alist)
(make-template-writer-ersatz templates-directory template-alist)
)))
(create-directory html-repo-path #t)
;; special files
(write-with-template "files.html" (filelist->sxml source-files-list))
(write-with-template "contributors.html" (contributors->sxml))
(write-with-template "commits.html" (commits->sxml))
(write-with-template (make-pathname html-repo-path "files" "html") (filelist->sxml source-files-list))
(write-with-template (make-pathname html-repo-path "contributors" "html") (contributors->sxml))
(write-with-template (make-pathname html-repo-path "commits" "html") (commits->sxml))
;; htmlified repo contents
(for-each
(lambda (source-file)
(->> source-file
(pathparts)
(define-values (root elements basename extension relative-root)))
(write-with-template
(string-append source-file ".html")
(source->sxml source-file))
(make-pathname html-repo-path source-file "html")
(source->sxml source-file)
`(;; additional per-page variables provided to template
(source_file . ,source-file)
(root . ,root)
(elements . ,elements)
(basename . ,basename)
(extension . ,extension)
(relative_root . ,relative-root)
))
;; if it's an image also copy it verbatim to output directory
(case (string->symbol (or (pathname-extension source-file) ""))
((jpg jpeg png gif webp webm svg apng avif svgz ico)
(system (format "git show HEAD:~a > ~a"
source-file
(make-pathname html-repo-path source-file))))))
source-files-list)
;; if README.md, README, or README.txt exists, copy that to index.html.
;; otherwise copy files.html to index.html.
;; if (the output version of) README.md, README, or README.txt exists, copy
;; that to index.html. otherwise copy files.html to index.html.
(->>
'("README.md.html" "README.html" "README.txt.html" "files.html")
(map (lambda (x) (make-pathname html-repo-path x)))
'("README.md" "README" "README.txt" "files")
(map (lambda (x) (make-pathname html-repo-path x "html")))
(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))))
;; if the ISSUES directory got created, write out an index file for the
;; stuff in there.
(when (file-exists? (make-pathname html-repo-path "ISSUES"))
(write-with-template "ISSUES.html" (issueslist->sxml source-files-list)))))
(write-with-template (make-pathname html-repo-path "ISSUES" "html") (issueslist->sxml source-files-list)))))
(define (main #!optional html-repo-path)
(define (main #!optional html-repo-path (templates-directory "sxml"))
(unless html-repo-path
(bail "please specify a destination directory for html files"))
(unless html-repo-path
(bail "please specify a destination directory for html files"))
(unless (in-git-directory?)
(bail "woops this isn't a git directory"))
(unless (in-git-directory?)
(bail "woops this isn't a git directory"))
(generate-html-files html-repo-path))
(generate-html-files html-repo-path templates-directory))
(main (command-line-arguments))
(apply main (command-line-arguments))

44
templates/default.html Normal file
View file

@ -0,0 +1,44 @@
<!DOCTYPE html>
<html lang="en">
<head>
<title>{{ forge_title }} - {{ repository_name }}</title>
<meta charset="utf-8" />
<meta name="viewport" content="width=device-width, initial-scale-1.0, user-scalable=yes" />
<link rel="icon" href="data:," />
<meta name="description" content="{{ repository_description }}" />
<style>
body { margin: 0 auto; max-width: 700px }
pre, code { background-color: #ffd9df }
pre { overflow: scroll; padding: 15px 20px; white-space: pre }
a { color: blue }
nav a { margin-right: 10px }
hr { border: 0; border-bottom: 1px solid black; margin-top: 16px }
td { padding: 0em .5em; vertical-align: top }
footer { font-size: small; text-align: right }
</style>
</head>
<body>
<h1>{{ h1 }}</h1>
<h2>{{ repository_name }}</h2>
<p>clone url:{{ clone_url_prefix }}/{{ repository_name }}</p>
<nav>
{% if readme_file %}
<a href="index.html">about</a>
<a href="files.html">files</a>
{% else %}
<a href="index.html">files</a>
{% endif %}
{% if license_file %}
<a href="{{ license_file }}.html">license</a>
{% endif %}
{% if issues_file %}
<a href="{{ issues_file }}.html">issues</a>
{% endif %}
<a href="commits.html">commits</a>
<a href="contributors.html">contributors</a>
</nav>
<hr />
{{ content|safe }}
<hr />
<footer>
<p>Generated by <a href="https://git.m455.casa/repo2html/">repo2html</a> using ersatz templates</p></footer></html>