summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Hintz <tjhintz@buddy.thintz.com>2013-10-12 16:04:37 -0700
committerThomas Hintz <tjhintz@buddy.thintz.com>2013-10-12 16:04:37 -0700
commit968d639d2e2639ef1fcbf50d2ba254ff907cf556 (patch)
treec622c020a982cef5e947dd454cfa712a17b6b559
downloadalley-cat-968d639d2e2639ef1fcbf50d2ba254ff907cf556.tar.gz
Initial commit.
-rw-r--r--LICENSE26
-rw-r--r--alley-cat.meta10
-rw-r--r--alley-cat.scm108
-rw-r--r--alley-cat.setup10
4 files changed, 154 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..e871403
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright (C) 2013, Thomas Hintz
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+Redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.
+Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+Neither the name of the author nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/alley-cat.meta b/alley-cat.meta
new file mode 100644
index 0000000..ed7e4a8
--- /dev/null
+++ b/alley-cat.meta
@@ -0,0 +1,10 @@
+(
+(category web)
+
+(needs sxml-transforms srfi-69 scss srfi-13 lowdown doctype)
+
+;(test-depends test)
+
+(author "Thomas Hintz")
+(synopsis "Alley Cat is a simple static website generator.")
+)
diff --git a/alley-cat.scm b/alley-cat.scm
new file mode 100644
index 0000000..28d0a32
--- /dev/null
+++ b/alley-cat.scm
@@ -0,0 +1,108 @@
+(module alley-cat
+ (
+ ; params
+ src-dir out-dir res-dir link-root doctype
+
+ ; generic functions
+ sxml->html
+
+ ; helper functions
+ markdown-file->sxml link link-list css
+
+ ; core functions
+ add-page! delete-page! add-css! delete-css!
+ add-file-resource! delete-file-resource!
+ compile
+ )
+
+(import chicken scheme files srfi-1 extras ports)
+(use sxml-transforms srfi-69 scss srfi-13 lowdown doctype)
+
+(define *pages* (make-hash-table))
+(define *stylesheets* (make-hash-table))
+(define *file-resources* '())
+
+(define src-dir (make-parameter "src"))
+(define out-dir (make-parameter "out"))
+(define res-dir (make-parameter "res"))
+(define link-root (make-parameter "/home"))
+(define doctype (make-parameter doctype-html))
+
+(define ++ string-append)
+
+(define (map-match func list)
+ (if (null? list)
+ '()
+ (cons (apply func (car list))
+ (map-match func (cdr list)))))
+
+; take from awful: Copyright (c) 2010-2013, Mario Domenech Goulart; BSD
+(define sxml->html
+ (let ((rules `((literal *preorder* . ,(lambda (t b) b))
+ . ,universal-conversion-rules*)))
+ (lambda (sxml)
+ (with-output-to-string
+ (lambda ()
+ (SRV:send-reply (pre-post-order* sxml rules)))))))
+
+(define (link path text)
+ `(a (@ (href ,(if (and (> (string-length path) 0)
+ (string=? "/" (string-take path 1)))
+ (++ (link-root) path)
+ path))) ,text))
+
+(define (link-list list #!key (ul@ '(@ ())) (li@ '(@ ())))
+ `(ul ,ul@
+ ,(map-match (lambda (path text)
+ `(li ,li@ ,(link path text)))
+ list)))
+
+(define (markdown-file->sxml file-path)
+ (markdown->sxml (with-input-from-file file-path (lambda () (read-string)))))
+
+(define (css path)
+ `(link (@ (rel "stylesheet") (href ,(++ (link-root) path)))))
+
+(define (add-page! path body)
+ (hash-table-set! *pages* path body))
+
+(define (delete-page! path)
+ (hash-table-delete! *pages* path))
+
+(define (add-css! path body)
+ (hash-table-set! *stylesheets* path body))
+
+(define (delete-css! path)
+ (hash-table-delete! *stylesheets* path))
+
+(define (add-file-resource! path)
+ (cons path *file-resources*))
+
+(define (delete-file-resource! path)
+ (remove (lambda (p) (equal? p path)) *file-resources*))
+
+(define (output-pages)
+ (hash-table-for-each
+ *pages*
+ (lambda (k v)
+ (with-output-to-file (++ (out-dir) "/" k)
+ (lambda () (print (doctype) (sxml->html v)))))))
+
+(define (output-stylesheets)
+ (hash-table-for-each
+ *stylesheets*
+ (lambda (k v)
+ (with-output-to-file (++ (out-dir) "/" k)
+ (lambda () (scss->css v))))))
+
+(define (copy-file-resources)
+ (for-each (lambda (p)
+ (file-copy (++ (res-dir) "/" p) (++ (out-dir) "/" p)))
+ *file-resources*))
+
+(define (compile)
+ (output-pages)
+ (output-stylesheets)
+ (copy-file-resources))
+
+)
diff --git a/alley-cat.setup b/alley-cat.setup
new file mode 100644
index 0000000..f371beb
--- /dev/null
+++ b/alley-cat.setup
@@ -0,0 +1,10 @@
+(compile -s -O2 -d1 alley-cat.scm -j alley-cat)
+(compile -s alley-cat.import.scm -O2 -d0)
+
+(install-extension
+ ;; Name of your extension:
+ 'alley-cat
+ ;; Files to install for your extension:
+ '("alley-cat.so" "alley-cat.import.so")
+ ;; Assoc list with properties for your extension:
+ '((version "0.1.0")))