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