suzanne.soy/racket-pkg-website
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allow overriding of static-render filename

Browse Source
This commit is contained in:
Tony Garnock-Jones 2015-01-26 15:42:08 -05:00
parent 1f2ddb4039
commit 6594a86940
1 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/site.rkt
View File

@ -413,7 +413,7 @@
(define (main-page-url) (define (main-page-url)
(if (use-cache?) (if (use-cache?)
(format "~a~a" static-cached-urlprefix (named-url main-page)) (format "~a/index.html" static-cached-urlprefix)
(named-url main-page))) (named-url main-page)))
(define (view-package-url package-name) (define (view-package-url package-name)
@ -1260,13 +1260,18 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (static-render! handler . named-url-args) (define (static-render! #:filename [base-filename #f]
handler . named-url-args)
(local-require racket/promise) (local-require racket/promise)
(local-require racket/file) (local-require racket/file)
(local-require web-server/private/servlet) (local-require web-server/private/servlet)
(local-require web-server/http/request-structs) (local-require web-server/http/request-structs)
(define request-url (apply named-url handler named-url-args)) (define request-url (apply named-url handler named-url-args))
(log-info "Rendering static version of ~a" request-url) (log-info "Rendering static version of ~a~a"
request-url
(if base-filename
(format " to ~a" base-filename)
""))
(define response (define response
(parameterize ((static-render #t)) (parameterize ((static-render #t))
(call-with-continuation-barrier (call-with-continuation-barrier
@ -1284,7 +1289,7 @@
"127.0.0.1") "127.0.0.1")
named-url-args)) named-url-args))
servlet-prompt))))) servlet-prompt)))))
(define filename (format "~a~a" static-cached-directory request-url)) (define filename (format "~a~a" static-cached-directory (or base-filename request-url)))
(make-parent-directory* filename) (make-parent-directory* filename)
(call-with-output-file filename (call-with-output-file filename
(response-output response) (response-output response)
@ -1320,7 +1325,8 @@
(define (package-change-handler index-rerender-needed? pending-completions) (define (package-change-handler index-rerender-needed? pending-completions)
(sync/timeout (and index-rerender-needed? (sync/timeout (and index-rerender-needed?
(lambda () (lambda ()
(static-render! main-page) (static-render! main-page #:filename "/index.html")
;; TODO: copy static files to target
(for ((completion-ch pending-completions)) (for ((completion-ch pending-completions))
(channel-put completion-ch (void))) (channel-put completion-ch (void)))
(package-change-handler #f '()))) (package-change-handler #f '())))