(import chicken scheme srfi-1) (use general-utils (only waffle waffle-sxml->html add-widget widgets widget-rules) md5 message-digest scss) (include "global.scm") (include "widgets.scm") (define (file-md5-hash path) (message-digest-string (md5-primitive) (with-input-from-file path (lambda () (read-string))))) (define (hash-file->src-url file path) (update-uri path query: `((v ,(file-md5-hash file))))) (define (compile-scss in out) (with-output-to-file out (lambda () (write-css (with-input-from-file in (lambda () (eval (read)))))))) (for-each (lambda (f) (compile-scss (++ (filesystem-path-scss) "/" f ".scss") (++ (filesystem-path-css) "/" f ".css"))) '("news")) (define (concat-files files) (with-output-to-string (lambda () (for-each (lambda (f) (display (with-input-from-file f read-string))) files)))) (define (concat-files-and-write resources output) (let ((combined (with-output-to-string (lambda () (concat-files resources))))) (with-output-to-file output (lambda () (display combined))) combined)) (define (md5-hash str) (message-digest-string (md5-primitive) str)) (define (md5-versioned-path path str) (update-uri path query: `((v ,(md5-hash str))))) (define (concat-files-and-version-path files output-file path) (let ((s (concat-files files))) (with-output-to-file output-file (lambda () (display s))) (md5-versioned-path path s))) (define (waffle-sxml->string sxml) (with-output-to-string (lambda () (parameterize ((widgets *widgets*) (widget-rules *widget-rules*)) (waffle-sxml->html sxml))))) ;; Takes a list of files, concatenates them together, outputs the ;; result to 'output-file', and returns a URL with an md5 hashed ;; version parameter. (define (concat-files->html files output-file path proc) (waffle-sxml->string (proc (concat-files-and-version-path files output-file path)))) (define (make-javascript-html-proc) (lambda (url) `(script (@ (type "text/javascript") (language "javascript") (src ,(uri->string url)))))) (define (make-stylesheet-html-proc) (lambda (url) `(stylesheet (@ (path ,(uri->string url)))))) (with-output-to-file "pre-generated-html.scm" (lambda () (write `((news-stylesheet-html . ,(++ (concat-files->html (map (lambda (f) (++ (filesystem-path-css) "/" f)) '("normalize.css" "foundation.min.css" "font-awesome.min.css")) (filesystem-path-css-lib) (uri-css-lib) (make-stylesheet-html-proc)) (waffle-sxml->string `(stylesheet (@ (path ,(uri->string (hash-file->src-url (filesystem-path-css-news) (uri-css-news))))))) (waffle-sxml->string `(link (@ (rel "icon") (type "image/png") (href ,(uri->string (hash-file->src-url (filesystem-path-site-icon) (uri-site-icon))))))))) (news-javascript-html . ,(begin (concat-files->html `(,(filesystem-path-js-jquery)) (filesystem-path-js-lib) (uri-js-lib) (make-javascript-html-proc)) (conc "" ""))) (news-logo-normal-uri . ,(uri->string (hash-file->src-url (filesystem-path-site-logo-normal) (uri-site-logo-normal)))) (news-load-javascript . ,(++ js-uri-var " var jsFiles = ['" (string-intersperse `(,(uri->string (hash-file->src-url (filesystem-path-js-lib) (uri-js-lib))) ,(uri->string (hash-file->src-url (filesystem-path-js-news) (uri-js-news)))) "', '") "']; "))))))