Add Dockerfile, improvements

5 files changed, 114 insertions, 137 deletions

diff --git a/.gitignore b/.gitignore
index d9df752..a9ec0be 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,4 +2,5 @@ dist
 dist/
 pages
 pages/
+template.html
 
diff --git a/Dockerfile b/Dockerfile
new file mode 100644
index 0000000..44b2559
--- /dev/null
+++ b/Dockerfile
@@ -0,0 +1,26 @@
+FROM alpine:latest AS builder
+
+WORKDIR /app
+
+# Install deps
+RUN apk add --no-cache chicken
+COPY requirements.list ./requirements.list
+RUN chicken-install -from-list requirements.list
+
+# Build app
+COPY app.scm ./app.scm
+RUN csc -static -o md-site-gen app.scm
+RUN chmod +x md-site-gen
+
+FROM alpine:latest AS runner
+
+WORKDIR /app
+
+# Install runtime deps
+RUN apk add --no-cache highlight inotify-tools
+
+# Run app
+COPY --from=builder /app/md-site-gen /usr/bin/md-site-gen
+
+EXPOSE 8080
+CMD ["md-site-gen"]
diff --git a/README.md b/README.md
index f3554dd..44e923d 100644
--- a/README.md
+++ b/README.md
@@ -16,7 +16,8 @@ Markdown -> HTML converter and HTTP server.
 
 | Variable | Description |
 | -------- | ----------- |
-| `PORT` | HTTP server PORT (default: 8080) |
+| `PORT` | HTTP server port. If not specified, will not start development HTTP server. |
 | `SRCROOT` | Relative markdown directory path (default: pages) |
 | `WEBROOT` | Relative output directory path (default: dist) |
 | `TEMPLATE` | Relative path to HTML file with a single `format` marker (default: template.html) |
+| `NREPL_PORT` | nrepl port for remote debugging access (default: 1234) |
diff --git a/app.scm b/app.scm
index ffe8792..4491202 100644
--- a/app.scm
+++ b/app.scm
@@ -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))))
diff --git a/template.html b/template.html
deleted file mode 100644
index ce0fb2e..0000000
--- a/template.html
+++ /dev/null
@@ -1,84 +0,0 @@
-<!doctype html>
-<html lang="en">
-<head>
-  <title>jan.systems</title>
-  <meta name="viewport" content="width=device-width, initial-scale=1" />
-  <link rel="preconnect" href="https://fonts.googleapis.com">
-  <link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
-  <link href="https://fonts.googleapis.com/css2?family=Merriweather:ital,wght@0,300;0,400;1,300&display=swap" rel="stylesheet">
-  <style>
-    /* highlight theme: Kwrite Editor */
-    body.hl { background-color:#e0eaee; }
-    pre.hl  { color:#000000; background-color:#e0eaee; font-size:10pt; font-family:'Courier New',monospace; white-space: pre-wrap; }
-    .hl.num { color:#b07e00; }
-    .hl.esc { color:#ff00ff; }
-    .hl.sng { color:#bf0303; }
-    .hl.pps { color:#818100; }
-    .hl.slc { color:#838183; font-style:italic; }
-    .hl.com { color:#838183; font-style:italic; }
-    .hl.ppc { color:#008200; }
-    .hl.opt { color:#000000; }
-    .hl.ipl { color:#0057ae; }
-    .hl.lin { color:#555555; user-select: none; }
-    .hl.hvr { cursor:help; }
-    .hl.erm { color:#ff0000; font-weight:bold; border:solid 1px red; margin-left: 3em; }
-    .hl.err { color:#ff0000; font-weight:bold; }
-    .hl.kwa { color:#000000; font-weight:bold; }
-    .hl.kwb { color:#0057ae; }
-    .hl.kwc { color:#000000; }
-    .hl.kwd { color:#010181; }
-    .hl.kwe { color:#0d5bc3; }
-    .hl.kwf { color:#750dc3; }
-
-    body {
-	font-size: 20px;
-	margin: 20px auto;
-	padding: 10px 15px;
-	max-width: 800px;
-
-	font-family: "Merriweather", serif;
-	font-optical-sizing: auto;
-	font-weight: 400;
-	font-style: normal;
-
-	line-height: 35px;
-    }
-
-    code {
-	padding: 8px 10px;
-	background-color: #eee;
-    }
-
-    pre {
-	background-color: #eee;
-	padding: 8px 10px;
-	overflow-x: scroll;
-    }
-    pre code {
-	background-color: initial;
-	padding: 0;
-    }
-
-    a {
-	color: #0090a0;
-    }
-
-    img {
-	max-width: 100%;
-    }
-
-    blockquote {
-	display: block;
-	background-color: #0090a020;
-	background-opacity: 0.9;
-	border-left: 10px solid #0090a0;
-	margin: 15px 0;
-	padding: 2px 10px;
-	quotes: "\201C""\201D""\2018""\2019";
-    }
-  </style>
-</head>
-<body>
-  ~A
-</body>
-</html>