From 2c729d5540529c3536ee8ee9a5f729c3c7dfb7f2 Mon Sep 17 00:00:00 2001 From: Jan Tuomi Date: Wed, 7 Feb 2024 19:47:12 +0200 Subject: Implement all kinds of stuff --- app.scm | 80 ++++++++++++++++++++++++++++++++++++++-------------- index.html | 84 ------------------------------------------------------- requirements.list | 12 ++++++++ template.html | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ todo.txt | 4 +-- 5 files changed, 157 insertions(+), 107 deletions(-) delete mode 100644 index.html create mode 100644 requirements.list create mode 100644 template.html diff --git a/app.scm b/app.scm index a98d21a..ffe8792 100644 --- a/app.scm +++ b/app.scm @@ -8,15 +8,26 @@ (chicken port) (chicken format) (chicken pretty-print) + (chicken string) lowdown sxml-transforms matchable (chicken irregex) - shell srfi-13 intarweb - html-parser - (chicken process)) + uri-common + (chicken process) + (chicken process-context)) + +(define *PORT* (string->number + (or (get-environment-variable "PORT") + "8080"))) +(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")) (define (pipe x . fns) (match fns @@ -49,6 +60,9 @@ (define tmp-file-path (create-temporary-file ext)) (with-output-to-file tmp-file-path (lambda () (display code))) + (define result + (receive (input _ _) (process (format "highlight ~A -O html -f" tmp-file-path)) + (read-string #f input))) (define result (capture ,(format "highlight ~A -O html -f" tmp-file-path))) (delete-file tmp-file-path) result) @@ -85,40 +99,32 @@ (format (read-string #f (open-input-file tmpl-path)) html)) -(define (app c) - (define html-text - (pipe "article.md" - (@ convert-md-to-html) - (@ highlight-code-blocks) - (@ insert-to-page-tmpl "index.html"))) - - (send-response body: html-text - headers: '((content-type #(text/html ((charset . utf-8))))))) - (define (compile-file filepath prev-result) (define (inner return) + (define initial-srcroot (string-append "^" *SRCROOT*)) + (define replaced-filepath (replace initial-srcroot *WEBROOT* filepath)) + (if (directory-exists? filepath) (begin (print (format "Creating corresponding directory: ~A" filepath)) - (create-directory (replace "^pages\\/" "dist/" filepath) #t) + (create-directory replaced-filepath #t) (return (void)))) (if (not (irregex-search "\\.md$" filepath)) (begin (print (format "Copying non-md file: ~A" filepath)) - (copy-file filepath - (replace "^pages\\/" "dist/" filepath)) + (copy-file filepath replaced-filepath) (return (void)))) (print (format "Compiling markdown: ~A" filepath)) (define out-path (pipe filepath (@ replace "\\.md" ".html") - (@ replace "^pages\\/" "dist/"))) + (@ replace initial-srcroot *WEBROOT*))) (define out-content (pipe filepath (@ convert-md-to-html) (@ highlight-code-blocks) - (@ insert-to-page-tmpl "index.html"))) + (@ insert-to-page-tmpl *TEMPLATE*))) (with-output-to-file out-path (thunk display out-content))) @@ -132,13 +138,13 @@ (if (directory-exists? path) (delete-directory path #t) (delete-file path))) - (for-each delete-path (glob "dist/*")) + (for-each delete-path (glob (string-append *WEBROOT* "/*"))) (find-files "pages" action: compile-file)) (thread-start! (lambda () - (receive (input _ _) (process "fswatch -o pages") + (receive (input _ _) (process (format "fswatch -o ~A" *SRCROOT*)) (let loop () (print (format "Monitored directory has changed (# of changes: ~A)" (read-line input))) (recompile) @@ -152,5 +158,37 @@ (recompile) -(vhost-map `((".*" . ,(lambda (c) (app c))))) +(define (map-last proc lst) + (if (null? (cdr lst)) + (list (proc (car lst))) + (cons (car lst) (map-last proc (cdr lst))))) + +(define (app cont) + (define uri (request-uri (current-request))) + (define path (uri-path uri)) + + (define (append-html-if-needed fragment) + (define has-ext? (@ irregex-search "\\.\\S+$")) + (match fragment + ["" "index.html"] + ;; if path ends in an extension, do nothing + [(? has-ext?) fragment] + ;; otherwise, add .html + [_ (string-append fragment ".html")])) + + (define (string-intercalate delim lst) + (string-intersperse lst delim)) + + (define static-file-path (pipe path + (@ map-last append-html-if-needed) + (@ cdr) + (@ string-intercalate "/"))) + + (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) diff --git a/index.html b/index.html deleted file mode 100644 index ce0fb2e..0000000 --- a/index.html +++ /dev/null @@ -1,84 +0,0 @@ - - - - jan.systems - - - - - - - - ~A - - diff --git a/requirements.list b/requirements.list new file mode 100644 index 0000000..b386598 --- /dev/null +++ b/requirements.list @@ -0,0 +1,12 @@ +(lowdown "3") +(test "1.2") +(srfi-18 "0.1.7") +(intarweb "2.1.0") +(srfi-13 "0.3.4") +(spiffy "6.3") +(7off "1.31") +(sxml-transforms "1.4.3") +(utf8 "3.6.3") +(nrepl "5.0.8") +(matchable "1.1") +(shell "0.4"))) diff --git a/template.html b/template.html new file mode 100644 index 0000000..ce0fb2e --- /dev/null +++ b/template.html @@ -0,0 +1,84 @@ + + + + jan.systems + + + + + + + + ~A + + diff --git a/todo.txt b/todo.txt index 0e26bbe..b4a4ba2 100644 --- a/todo.txt +++ b/todo.txt @@ -1,4 +1,4 @@ -2024-02-07 feat: Remove webserver stuff -2024-02-07 feat: Make pages and dist folders configurable via env +x 2024-02-07 2024-02-07 feat: Make pages and dist folders configurable via env 2024-02-07 feat: Add sxml transform step that parses ![[url]] image links 2024-02-07 feat: self-host font instead of Google dependency +2024-02-07 doc: Add README -- cgit v1.3