#!/usr/bin/csi -s
(import utf8
lowdown
(chicken string)
(chicken port)
(chicken io)
(chicken process)
(chicken process-context)
(chicken format)
(chicken pathname)
(chicken file)
sxml-transforms
(clojurian syntax)
)
(define CLONE-URL (or (get-environment-variable "REPO2HTML_CLONE_URL") "git://git.example.com"))
(define TITLE (or (get-environment-variable "REPO2HTML_TITLE") "my git repositories"))
(define DESCRIPTION (or (get-environment-variable "REPO2HTML_DESCRIPTION") "my git repositories"))
(define H1 (or (get-environment-variable "REPO2HTML_H1") "git.example.com"))
;; small utilities ---------------------------------
;; return the first x in xs for which (pred? member) is true,
;; or #f if no such member is found.
(define (first-if pred? xs)
(cond ((null? xs) #f)
((pred? (car xs)) (car xs))
(else (first-if pred? (cdr xs)))))
;; (bail [message [exit-status]])
;; end the program immediately.
;; if a message is provided, print it to the screen.
;; exit-status defaults to 1.
(define (bail . args)
(let-optionals args ((msg "") (status 1))
(unless (equal? "" msg) (print msg))
(exit status)))
;; 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
;; e.g foo/bar/baz.html -> ../../
;;
;; this is intended to provide default values that make for easier reassembly
;; into filenames.
;;
;; typical use:
;; (->> source-file
;; (pathparts)
;; (define-values (root elements basename extension relative-root)))
;;
(define (pathparts s)
(define-values (dirname basename extension)
(decompose-pathname s))
(define-values (origin root directory-elements)
(decompose-directory (or dirname "")))
;; discarding origin because idgaf about windows
(values (or root "")
(or directory-elements '())
basename
(if extension (string-append "." extension) "")
(->>
(or directory-elements '())
(map (constantly "../"))
(apply string-append))))
;; main code ---------------------------------
(define (populate-html-template repository-name source-files-list source-file display-body-thunk)
(define-values (_ _ _ _ relative-root) (pathparts source-file))
(display #<#string-block
#{TITLE}