Full new website in production now

1 files changed, 135 insertions, 0 deletions

diff --git a/schemeato b/schemeato
new file mode 100755
index 0000000..cd940d6
--- /dev/null
+++ b/schemeato
@@ -0,0 +1,135 @@
+#|
+#!/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 file)))
+        (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"))
+            (call-with-output-file
+              outfile
+              (lambda (f)
+                (display (render-template x env) f)))))
+        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"))