You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
117 lines
4.8 KiB
Scheme
117 lines
4.8 KiB
Scheme
9 years ago
|
(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
|
||
|
|
"<script src='" (uri->string (hash-file->src-url
|
||
|
|
(filesystem-path-js-lib)
|
||
|
|
(uri-js-lib)))
|
||
|
|
"'></script>"
|
||
|
|
"<script src='" (uri->string (hash-file->src-url
|
||
|
|
(filesystem-path-js-news)
|
||
|
|
(uri-js-news)))
|
||
|
|
"'></script>")))
|
||
|
|
(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)))) "', '")
|
||
|
|
"']; "))))))
|