Support subdirectories

1 files changed, 33 insertions, 19 deletions

diff --git a/app.scm b/app.scm
index 683dc5f..a98d21a 100644
--- a/app.scm
+++ b/app.scm
@@ -95,32 +95,46 @@
   (send-response body: html-text
 		 headers: '((content-type #(text/html ((charset . utf-8)))))))
 
-(define (compile-file filepath return)
-  (if (not (irregex-search "\\.md$" filepath))
-      (begin
-	(print (format "Copying non-md file: ~A" filepath))
-	(copy-file filepath
-		   (replace "pages\\/" "dist/" filepath))
-	(return (void))))
+(define (compile-file filepath prev-result)
+  (define (inner return)
+    (if (directory-exists? filepath)
+	(begin
+	  (print (format "Creating corresponding directory: ~A" filepath))
+	  (create-directory (replace "^pages\\/" "dist/" filepath) #t)
+	  (return (void))))
 
-  (print (format "Compiling: ~A" filepath))
-  (define out-path (pipe filepath
-			 (@ replace "\\.md" ".html")
-			 (@ replace "pages\\/" "dist/")))
+    (if (not (irregex-search "\\.md$" filepath))
+	(begin
+	  (print (format "Copying non-md file: ~A" filepath))
+	  (copy-file filepath
+		     (replace "^pages\\/" "dist/" filepath))
+	  (return (void))))
 
-  (define out-content (pipe filepath
-			    (@ convert-md-to-html)
-			    (@ highlight-code-blocks)
-			    (@ insert-to-page-tmpl "index.html")))
+    (print (format "Compiling markdown: ~A" filepath))
+    (define out-path (pipe filepath
+			   (@ replace "\\.md" ".html")
+			   (@ replace "^pages\\/" "dist/")))
 
-  (with-output-to-file out-path
-    (thunk display out-content)))
+    (define out-content (pipe filepath
+			      (@ convert-md-to-html)
+			      (@ highlight-code-blocks)
+			      (@ insert-to-page-tmpl "index.html")))
+
+    (with-output-to-file out-path
+      (thunk display out-content)))
+
+  (call/cc inner))
 
 (define (recompile)
   (create-directory "dist" #t)
-  (for-each (@ delete-file) (glob "dist/*"))
+
+  (define (delete-path path)
+    (if (directory-exists? path)
+	(delete-directory path #t)
+	(delete-file path)))
+  (for-each delete-path (glob "dist/*"))
   (find-files "pages"
-	      action: (lambda (filepath prev-result) (call/cc (lambda (k) (compile-file filepath k))))))
+	      action: compile-file))
 
 (thread-start!
  (lambda ()