Initial commit.
						commit
						968d639d2e
					
				| @ -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. | ||||||
| @ -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.") | ||||||
|  | ) | ||||||
| @ -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)) | ||||||
|  | 
 | ||||||
|  | ) | ||||||
| @ -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"))) | ||||||
					Loading…
					
					
				
		Reference in New Issue
	
	 Thomas Hintz
						Thomas Hintz