Implement all kinds of stuff

4 files changed, 73 insertions, 23 deletions

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/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/index.html b/template.html
index ce0fb2e..ce0fb2e 100644
--- a/index.html
+++ b/template.html
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