meow

compiler.rkt

@@ -123,10 +123,11 @@
     (thread-wait
       (thread
         (λ ()
-          (call-with-atomic-output-file
-            out
-            (λ (out-port tmp-path)
-              (apply func out-port (map open-input-file ins))))))))
+           (make-parent-directory* out)
+           (call-with-atomic-output-file
+             out
+             (λ (out-port tmp-path)
+                (apply func out-port (map open-input-file ins))))))))
   (custodian-shutdown-all cust))
 
 ;; Runs an ordered operations list

render.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 
-(require racket/list racket/match racket/port racket/pretty racket/set racket/string
+(require racket/fasl racket/list racket/match racket/port racket/path racket/set racket/string
          racket/runtime-path
          markdown markdown/display-xexpr markdown/toc
          "compiler.rkt" "defs.rkt" "fetch.rkt"
@@ -11,7 +11,7 @@
          (prefix-in page: "templates/page.html.rkt"))
 
 (struct input-doc [metadata text] #:transparent)
-(struct ir-doc [metadata html] #:transparent)
+(struct ir-doc [metadata html] #:prefab)
 
 (define-runtime-path *render.scss* "render.scss")
 
@@ -104,7 +104,7 @@
       [(list 'tech (list (list 'key key)) (? string? body))
        `(a ([class "tech"] [href ,(format "~a/tech/~a" base-url key)]) ,body)]
       ;; masto
-      ;; TODO
+      ;; TODO make this not janky
       [(list 'p _ (list 'masto _ (? string? url)))
        (masto-fetch-embed url)]
       ;; everything else
@@ -134,13 +134,43 @@
       "\n"))
   (sass:compile/string top-level-style #t))
 
+(define (scan-for-rules [output-dir (build-path "target")]
+                        [build-dir (build-path "build")]
+                        [src-dir (build-path "src")])
+  (define-rule (scss [out (build-path output-dir "index.css")]
+                     [in (build-path src-dir "index.scss")])
+               (~> (compile-index-scss (port->string in)) (write-string out)))
+
+  (struct rule-spec [src intermediate output] #:transparent)
+
+  (define rule-specs
+    (parameterize ([current-directory src-dir])
+      (for/list ([md-file (in-directory #f)]
+                 #:when (bytes=? (path-get-extension md-file) #".md"))
+        (define fasl-file (path-replace-extension md-file #".fasl"))
+        (define out-file (path-replace-extension md-file #".html"))
+        (rule-spec (build-path src-dir md-file)
+                   (build-path build-dir fasl-file)
+                   (build-path output-dir out-file)))))
+
+  (define intermediate-rules
+    (for/list ([spec (in-list rule-specs)])
+      (define-rule (intermediate-rule [out (rule-spec-intermediate spec)]
+                                      [in (rule-spec-src spec)])
+                   (~> (read-input-doc in) input-doc->ir-doc s-exp->fasl (write-bytes out)))
+      intermediate-rule))
+
+  (define output-rules
+    (for/list ([spec (in-list rule-specs)])
+      (define-rule (output-rule [out (rule-spec-output spec)]
+                                [in (rule-spec-intermediate spec)])
+                   (~> (port->bytes in) fasl->s-exp ir-doc->page (write-string out)))
+      output-rule))
+  (append intermediate-rules output-rules (list scss)))
+
 (module+ main
   (require racket/cmdline)
   (command-line
     #:program "meow"
-    #:args (infile outfile)
-    (define-rule (scss [out "index.css"] [in "index.scss"])
-      (~> (compile-index-scss (port->string in)) (write-string out)))
-    (define-rule (render [out outfile] [in infile])
-      (~> (read-input-doc in) input-doc->ir-doc ir-doc->page (write-string out)))
-    (generate/execute (list render scss))))
+    #:args ()
+    (generate/execute (scan-for-rules))))