;; how to use this script ;; 1. cd into a bare git repository ;; 2. run the following, changing any values you want: ;; export GIT_WWW=/var/www/git/ GIT_WWW_CLONE_URL=git://git.m455.casa GIT_WWW_TITLE=git.m455.casa GIT_WWW_DESCRIPTION="m455's git repositories" GIT_WWW_H1=git.m455.casa; csi -s ../main.scm ;; i figured i would use environment variables instead of a config file, ;; because folks are just going to run this as a post-receive hook anyway, so ;; why not all just configure it all in the post-receive hook like so? ;; (assuming git-www is in your $PATH, and assuming git-www is a compiled ;; version of git-www.scm): ;; --------------------------------- ;; #!/bin/sh ;; export GIT_WWW=/var/www/git/ ;; export GIT_WWW_CLONE_URL=git://git.m455.casa ;; export GIT_WWW_TITLE=git.m455.casa ;; export GIT_WWW_DESCRIPTION="m455's git repositories" ;; export GIT_WWW_H1=git.m455.casa ;; git-www ;; --------------------------------- ;; TODO: ;; [x] replace all repository-name with *repository-name* ;; [x] replace all repository-directory with *repository-directory* ;; [x] remove all passed around parameters for repo name and directory ;; [x] move html-body-contents into final html-template format except use ;; string translate for named variables in the html-template ;; Nice-to-haves: ;; [ ] nav link: License (look for LICENSE file) ;; [ ] nav link: Contributors ;; [ ] nav link: Releases ;; [ ] clickable line numbers in source files ;; [ ] render images ;; [ ] make repos with more files and directories less daunting (recursively generate a files list page for each directory in a repo?) (import utf8 lowdown (chicken string) (chicken port) (chicken io) (chicken process) (chicken process-context) (chicken format) (chicken pathname) (chicken file)) ;; decided to make these two buggers globals because i passed them around ;; between functions so much (define *repository-name* #f) (define *repository-directory* #f) (define WEB-DIRECTORY (let ((environment-variable (get-environment-variable "GIT_WWW"))) ;; this seems silly, but i'm not sure how else i should do it haha (if environment-variable environment-variable "/var/www/git"))) (define CLONE-URL (let ((environment-variable (get-environment-variable "GIT_WWW_CLONE_URL"))) ;; this seems silly, but i'm not sure how else i should do it haha (if environment-variable environment-variable "git://git.example.com"))) (define TITLE (let ((environment-variable (get-environment-variable "GIT_WWW_TITLE"))) (if environment-variable environment-variable "my git repositories"))) (define DESCRIPTION (let ((environment-variable (get-environment-variable "GIT_WWW_DESCRIPTION"))) (if environment-variable environment-variable "my git repositories"))) (define H1 (let ((environment-variable (get-environment-variable "GIT_WWW_H1"))) (if environment-variable environment-variable "git.example.com"))) (define HTML-TEMPLATE #< {{title}}

{{h1}}

{{repository-name}}

clone url: {{clone-url}}/{{repository-name}}

{{body-contents}} string-block ) (define (write-file file contents) (with-output-to-file file (lambda () (display contents)))) (define (populate-html-template body-contents) (string-translate* HTML-TEMPLATE `( ("{{title}}" . ,TITLE) ("{{description}}" . ,DESCRIPTION) ("{{h1}}" . ,H1) ("{{clone-url}}" . ,CLONE-URL) ("{{repository-name}}" . ,*repository-name*) ("{{body-contents}}" . ,body-contents)))) (define (in-git-directory?) (if (equal? (call-with-input-pipe "git rev-parse --is-bare-repository 2> /dev/null" read-line) "true") #t #f)) (define (get-repository-name) (pathname-strip-directory (current-directory))) ; (call-with-input-pipe "git config --get remote.origin.url" read-line))) (define (git-repository->paths-list) (call-with-input-pipe "git ls-tree -r --name-only HEAD" read-lines)) (define (git-file->string path) (string-intersperse (call-with-input-pipe (format "git show HEAD:~a" path) read-lines) "\n")) (define (clean-html str) (string-translate* str '(("&" . "&") ("<" . "<") (">" . ">") ("\"" . """) ("'" . "'")))) (define (md->html markdown-string) (with-output-to-string (lambda () (markdown->html markdown-string)))) (define (generate-list-of-files source-files-list) (if (null? source-files-list) "" (let* ((source-file (car source-files-list)) (link-url (string-append source-file ".html"))) ;; src/main.scm.html (string-append (format "
  • ~a
    • \n" link-url source-file) (generate-list-of-files (cdr source-files-list)))))) (define (generate-source-file source-file) ;; src/main.scm (let* ((source-file-directory (pathname-directory source-file)) ;; src or #f (output-directory (if source-file-directory (make-pathname *repository-directory* source-file-directory) ;; //src *repository-directory*))) ;; / ;; create directories that mimic the path of the source file, so when ;; someone clicks a link to view the contents of a source file, the URL ;; matches up with the path of the source file. ;; i guess another reason to do this is to avoid conflicts with files that ;; have the same name, but exist in different directories. (create-directory output-directory #t) (write-file (make-pathname output-directory (pathname-strip-directory source-file) "html") (populate-html-template (string-append "

    " source-file "

    " "
    \n"
                                             (clean-html (git-file->string source-file))
                                             "
    "))))) (define (generate-source-files source-files-list) (for-each (lambda (source-file) (generate-source-file source-file)) source-files-list)) (define (generate-files-file files-list-page-path source-files-list) (write-file files-list-page-path (populate-html-template (string-append "
      \n" (generate-list-of-files source-files-list) "
    \n")))) (define (generate-readme-file index-page-path) (write-file index-page-path (populate-html-template (md->html (git-file->string "README.md"))))) (define (generate-repository-directory) (if (directory-exists? *repository-directory*) (begin (delete-directory *repository-directory* #t) (create-directory *repository-directory* #t)) (create-directory *repository-directory* #t))) (define (generate-html-files) (let ((source-files-list (git-repository->paths-list))) (generate-repository-directory) (generate-readme-file (make-pathname *repository-directory* "index.html")) (generate-files-file (make-pathname *repository-directory* "files.html") source-files-list) (generate-source-files source-files-list))) (define (if-git-directory-generate-html-files) (if (in-git-directory?) (begin (set! *repository-name* (get-repository-name)) (set! *repository-directory* (make-pathname WEB-DIRECTORY *repository-name*)) (generate-html-files)) (print "woops that's not a git directory"))) (define (main args) (if (null? args) (if-git-directory-generate-html-files) (print "woops, i dont take args"))) (main (command-line-arguments))