From 58d56dc9dae201d89a4911e125099f1f41780eab Mon Sep 17 00:00:00 2001 From: Ekaitz Zarraga Date: Sat, 5 Dec 2020 22:51:37 +0100 Subject: First version of the website --- schemeato | 146 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 146 insertions(+) create mode 100755 schemeato (limited to 'schemeato') diff --git a/schemeato b/schemeato new file mode 100755 index 0000000..c950af0 --- /dev/null +++ b/schemeato @@ -0,0 +1,146 @@ +#| +#!/usr/bin/env sh +exec chibi-scheme -A `dirname $0` $0 $@ +|# +(import + (scheme base) + (srfi 1) + (srfi 69) + (srfi 115) + (chibi) + (chibi app) + (chibi config) + (chibi filesystem) + (chibi process) + (chibi io) + (chibi pathname) + (chibi string) + (chibi sxml)) + +; - [X] Read all the locales +; - [ ] Prepare needed variables per file: +; - [X] List of languages available +; - [X] Current language +; - [ ] Current file +; - [X] Markdown parser +; - [X] pandoc +; - [ ] Check how to do it in scheme +; - [ ] Some more: check schiumato for reference +; - [X] `load` or `eval` files in the created environment and extract their +; exports to dump them to target folder +; - [ ] deal with input arguments or config, that can be cool for language +; selection and directory config. +; - [ ] Move globs to default config stuff. +; - [ ] Make a `new` command that creates the file structure and the default +; configuration file + +(define (string-startswith? str char) + (string-cursor=? + (string-cursor-start str) + (string-find str (lambda (y) (char=? y char))))) + +; Move this to input/config parameters +(define staticdir "static") +(define templatedir "templates") +(define outdir "www") + +(define (md-to-html md-text) + "Markdown to HTML converter using external Pandoc command" + (call-with-process-io "pandoc" + (lambda (pid in out err) + (display md-text in) + (close-output-port in) + (let ((res (port->string out))) + (waitpid pid 0) + res)))) + +(define (load-templates) + "Read templates `templatedir`. + Returns them as a alist where keys are the filename of the template relative + to the `templatedir` and the values are the contents of the file." + (directory-fold-tree + templatedir + #f + #f + (lambda (file acc) + (if (or (string-startswith? (path-strip-directory file) #\.) + (string-startswith? (path-strip-directory file) #\_)) + acc + (cons (list (path-relative-to file templatedir) + (call-with-input-file + file + (lambda (p) + (let loop ((x (read p))) + (if (eof-object? x) + '() + (cons x (loop (read p)))))))) + acc))) + '())) + +(define (render-template tpl env) + "Render one template" + (let* ((code (let ((codelist (cdr tpl))) + (reduce (lambda (x acc) + (append x acc)) + '() + codelist))) + (fullcode (append env code))) + (eval fullcode))) + +(define (copy-static) + "Copy static directory in output directory" + (directory-fold-tree + staticdir + #f + #f + (lambda (file acc) + (let ((output (make-path outdir + (make-path "static" + (path-relative-to file staticdir))))) + (create-directory* (path-directory output)) + (call-with-output-file output + (lambda (x) + (send-file file x))))) + #\null)) + +(define (include-template name) + ; TODO make template loader + #f) + +(define (create-output cfg spec . args) + "Dumps the templates in the output directory" + (let ((templates (load-templates))) + (or (create-directory* outdir) (error "Unable to create output directory")) + (display "Copying static files...") + (newline) + (copy-static) + (let* ((env `(let ((include-template ,include-template))))) + (for-each + (lambda (x) + (let ((outfile (make-path outdir (car x)))) + (or (create-directory* (path-directory outfile)) + (error "Unable to create directory")) + + (display "Rendering template ") + (display (car x)) + (display " to ") + (display outfile) + + (call-with-output-file + outfile + (lambda (f) + (display (render-template x env) f))) + + (display "\t[Done]") + (newline))) + templates)))) + + +(run-application + `(schemeato + "Schemeato: an easy to translate static site generator" + (or + (create "Create output from current folder" ,create-output) + (help "Show this help" (,app-help-command)))) + (command-line) + #;(conf-load "conf.scm")) -- cgit v1.2.3