diff options
Diffstat (limited to 'app.scm')
| -rw-r--r-- | app.scm | 137 |
1 files changed, 85 insertions, 52 deletions
@@ -17,17 +17,18 @@ intarweb uri-common (chicken process) - (chicken process-context)) + (chicken process-context) + (chicken condition)) -(define *PORT* (string->number - (or (get-environment-variable "PORT") - "8080"))) +(define *PORT* (get-environment-variable "PORT")) (define *WEBROOT* (or (get-environment-variable "WEBROOT") "dist")) (define *SRCROOT* (or (get-environment-variable "SRCROOT") "pages")) (define *TEMPLATE* (or (get-environment-variable "TEMPLATE") - "template.html")) + "template.html")) +(define *NREPL-PORT* (string->number (or (get-environment-variable "NREPL_PORT") + "1234"))) (define (pipe x . fns) (match fns @@ -99,62 +100,89 @@ (format (read-string #f (open-input-file tmpl-path)) html)) -(define (compile-file filepath prev-result) - (define (inner return) - (define initial-srcroot (string-append "^" *SRCROOT*)) - (define replaced-filepath (replace initial-srcroot *WEBROOT* filepath)) +(define (system-has-fswatch?) + (call/cc (lambda (k) + (with-exception-handler + (lambda (exn) (k #f)) + (lambda () (system* "which fswatch") (k #t)))))) - (if (directory-exists? filepath) - (begin - (print (format "Creating corresponding directory: ~A" filepath)) - (create-directory replaced-filepath #t) - (return (void)))) +(define (system-has-inotifywait?) + (call/cc (lambda (k) + (with-exception-handler + (lambda (exn) (k #f)) + (lambda () (system* "which inotifywait") (k #t)))))) - (if (not (irregex-search "\\.md$" filepath)) - (begin - (print (format "Copying non-md file: ~A" filepath)) - (copy-file filepath replaced-filepath) - (return (void)))) +(define (compile-file-into outdir) + (lambda (filepath prev-result) + (define (inner return) + (define initial-srcroot (string-append "^" *SRCROOT*)) + (define replaced-filepath (replace initial-srcroot outdir filepath)) - (print (format "Compiling markdown: ~A" filepath)) - (define out-path (pipe filepath - (@ replace "\\.md" ".html") - (@ replace initial-srcroot *WEBROOT*))) + (if (directory-exists? filepath) + (begin + (print (format "Creating corresponding directory: ~A" filepath)) + (create-directory replaced-filepath #t) + (return (void)))) - (define out-content (pipe filepath - (@ convert-md-to-html) - (@ highlight-code-blocks) - (@ insert-to-page-tmpl *TEMPLATE*))) + (if (not (irregex-search "\\.md$" filepath)) + (begin + (print (format "Copying non-md file: ~A" filepath)) + (copy-file filepath replaced-filepath) + (return (void)))) - (with-output-to-file out-path - (thunk display out-content))) + (print (format "Compiling markdown: ~A" filepath)) + (define out-path (pipe filepath + (@ replace "\\.md" ".html") + (@ replace initial-srcroot outdir))) - (call/cc inner)) + (define out-content (pipe filepath + (@ convert-md-to-html) + (@ highlight-code-blocks) + (@ insert-to-page-tmpl *TEMPLATE*))) + + (with-output-to-file out-path + (thunk display out-content))) + + (call/cc inner))) (define (recompile) - (create-directory "dist" #t) + (define tmpdir (create-temporary-directory)) + + (find-files *SRCROOT* + action: (compile-file-into tmpdir)) - (define (delete-path path) - (if (directory-exists? path) - (delete-directory path #t) - (delete-file path))) - (for-each delete-path (glob (string-append *WEBROOT* "/*"))) - (find-files "pages" - action: compile-file)) + (system* (format "rm -r \"~A\" || true" *WEBROOT*)) + (system* (format "mv \"~A\" \"~A\"" tmpdir *WEBROOT*))) +(define (wait-for-filesystem-change stop-watching) + (cond ((system-has-fswatch?) (process (format "fswatch -r -L -1 ~A" *SRCROOT*))) + ((system-has-inotifywait?) (process (format "inotifywait -r -q -e create -e modify -e delete -e move ~A" *SRCROOT*))) + (else (begin (print "No file watching system installed") + (stop-watching (void)))))) + +(define (watch-print . rest) (apply print "[watch] " rest)) (thread-start! (lambda () - (receive (input _ _) (process (format "fswatch -o ~A" *SRCROOT*)) - (let loop () - (print (format "Monitored directory has changed (# of changes: ~A)" (read-line input))) - (recompile) - (loop))))) + (watch-print "Starting watching source directory...") + + (call/cc + (lambda (stop-watching) + (let loop () + (watch-print "Calling file watching system...") + (receive (input _ _) (wait-for-filesystem-change stop-watching) + (watch-print "Waiting for filesystem changes...") + (watch-print (format "Monitored directory has changed (output: ~A)" (read-line input))) + (recompile) + (loop))))) + + (watch-print "Stopped watching source directory."))) +(define (nrepl-print . rest) (apply print "[nrepl] " rest)) (thread-start! (lambda () - (print "starting nrepl on port 1234") + (nrepl-print (format "Starting nrepl on port ~A" *NREPL-PORT*)) (nrepl-prompt (lambda () (display "#;0> "))) - (nrepl 1234))) + (nrepl *NREPL-PORT*))) (recompile) @@ -171,9 +199,9 @@ (define has-ext? (@ irregex-search "\\.\\S+$")) (match fragment ["" "index.html"] - ;; if path ends in an extension, do nothing + ;; if path ends in an extension, do nothing [(? has-ext?) fragment] - ;; otherwise, add .html + ;; otherwise, add .html [_ (string-append fragment ".html")])) (define (string-intercalate delim lst) @@ -187,8 +215,13 @@ (print (format "Serving file ~A" static-file-path)) (send-static-file static-file-path)) -(print (format "Serving ~A on port ~A, using ~A as html template" *WEBROOT* *PORT* *TEMPLATE*)) -(server-port *PORT*) -(root-path *WEBROOT*) -(vhost-map `((".*" . ,(@ app)))) -(start-server) +(if *PORT* + (begin (print (format "Serving ~A on port ~A, using ~A as html template" *WEBROOT* *PORT* *TEMPLATE*)) + (server-port (string->number *PORT*)) + (root-path *WEBROOT*) + (vhost-map `((".*" . ,(@ app)))) + (start-server)) + (begin (print "PORT not defined, not starting HTTP server. Putting main thread to sleep.") + (let loop () + (thread-sleep! 1) + (loop)))) |