add incremental build system

compiler.rkt

@@ -0,0 +1,140 @@
+#lang racket/base
+
+;; compiler:
+;; infrastructure for incrementally compiling site contents from source to html/json/etc
+;; lots of graphs (it's all graphs)
+
+(require racket/bool racket/file racket/match racket/set
+         syntax/parse/define (for-syntax racket/base racket/syntax))
+
+(provide define-rule generate-operations execute-rule execute-operations generate/execute)
+
+;; A compiler rule
+;; Input files, output file, compile function
+(struct rule [name inputs output compiler] #:transparent)
+
+;; cool and good macro for defining rules
+;; binds a rule struct with a list of the given output and input files and a lambda that accepts
+;; port arguments in the same order
+(define-syntax-parse-rule (define-rule (id:id [outfile:id outpath:expr] [infile:id inpath:expr] ...)
+                                       body:expr ...+)
+  #:with name-sym #'(quote id)
+  (define id (rule name-sym (list inpath ...) outpath
+                   (lambda (outfile infile ...)
+                     body ...))))
+
+;; Converts set of rules into ordered list of rules to execute based on current filesystem state
+(define (generate-operations rules)
+  (define nodes (mutable-set))
+  (define edges (make-hash))
+  (define edges-rev (make-hash))
+  (define (edge-add! from to)
+    (when (equal? from to)
+      (error "loop edge" from to))
+    (set-add! nodes from)
+    (set-add! nodes to)
+    (if (hash-has-key? edges from)
+      (set-add! (hash-ref edges from) to)
+      (hash-set! edges from (mutable-set to)))
+    (if (hash-has-key? edges-rev to)
+      (set-add! (hash-ref edges-rev to) from)
+      (hash-set! edges-rev to (mutable-set from))))
+
+  ;; construct graph
+  (for ([rule (in-set rules)])
+    (for ([input (in-list (rule-inputs rule))])
+      (edge-add! input rule))
+    (when (hash-has-key? edges-rev (rule-output rule))
+      (error "duplicate output rule" (rule-output rule)))
+    (edge-add! rule (rule-output rule)))
+
+  ;; construct topological sort
+  (define (topo-sort nodes edges)
+    (define temp-mark (mutable-set))
+    (define perm-mark (mutable-set))
+    ;; visits recursively
+    (define (visit node sorted)
+      (cond
+        [(set-member? perm-mark node) sorted]
+        [(set-member? temp-mark node) (error "cycle detected")]
+        [else
+          (set-add! temp-mark node)
+
+          (define new-sorted
+            (for/fold ([s sorted]) ([neighbor (in-set (hash-ref edges node (set)))])
+              (visit neighbor s)))
+
+          (set-remove! temp-mark node)
+          (set-add! perm-mark node)
+          (cons node new-sorted)]))
+
+    (for/fold ([s '()]) ([node (in-set nodes)] #:unless (set-member? perm-mark node))
+      (visit node s)))
+
+  (define topo-sorted (topo-sort nodes edges))
+
+  ;; everything where either the output does not exist, or one of the inputs does not exist, or one
+  ;; of the inputs is newer than the output
+  (define (rule-dirty? rule)
+    (define (modt f)
+      (file-or-directory-modify-seconds f #f (λ () #f)))
+    (define output-time (modt (rule-output rule)))
+    (define input-times (map modt (rule-inputs rule)))
+    (or (false? output-time)
+        (for/or ([time (in-list input-times)])
+          (or (false? time) (> time output-time)))))
+
+  (define initial-dirty (for/set ([rule (in-set rules)] #:when (rule-dirty? rule)) rule))
+  ;; propagate the dirty set recursively
+  ;; for each missing input, add the rule that generates the input
+  ;; if outputs have dependents, add the dependents
+  (define (expand-dirty rule [dset (mutable-set)])
+    (unless (set-member? dset rule)
+      (set-add! dset rule)
+      (for ([dep (in-set (hash-ref edges (rule-output rule) (set)))])
+        (expand-dirty dep dset))
+      (for ([input (in-list (rule-inputs rule))])
+        (unless (or (file-exists? input) (link-exists? input) (directory-exists? input))
+          (define dep-revs (hash-ref edges-rev input (set)))
+          (when (zero? (set-count dep-revs))
+            (error "no rule to generate" input))
+          (for ([dep-rev (in-set dep-revs)])
+            (expand-dirty dep-rev dset)))))
+    dset)
+  (define dirty
+    (for/fold ([d (set)]) ([item (in-set initial-dirty)])
+      (set-union d (expand-dirty item))))
+
+  (define dirty-sorted
+    (for/list ([item (in-list topo-sorted)] #:when (set-member? dirty item))
+      item))
+  (unless (= (set-count dirty) (length dirty-sorted))
+    (error "self-check failed lmao"))
+  dirty-sorted)
+
+;; TODO : replace printf with logging
+
+;; Executes one rule
+(define (execute-rule r)
+  (match-define (rule name ins out func) r)
+  (printf "executing: ~a\n" name)
+  (define cust (make-custodian))
+  (parameterize ([current-custodian cust])
+    (thread-wait
+      (thread
+        (λ ()
+          (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
+(define (execute-operations ops)
+  (printf "~a task(s) to run\n" (length ops))
+  (for ([op (in-list ops)])
+    (execute-rule op)))
+
+;; generates the list and then executes it
+(define (generate/execute rules)
+  (execute-operations (generate-operations rules)))

ext-syntax/css/syntax.scss

@@ -16,6 +16,10 @@ pre.highlight, .highlight {
   pre {
     margin: 0;
   }
+
+  .linenos {
+    user-select: none;
+  }
 }
 
 .highlight {

render.rkt

@@ -1,6 +1,8 @@
-#lang racket
+#lang racket/base
 
-(require markdown markdown/display-xexpr markdown/toc
+(require racket/contract racket/list racket/match racket/port racket/string
+         markdown markdown/display-xexpr markdown/toc
+         "compiler.rkt"
          (prefix-in sass: sass)
          (prefix-in mathml: "ext-mathml/main.rkt")
          (prefix-in syntax: "ext-syntax/main.rkt")
@@ -10,6 +12,7 @@
   (listof (or/c
             (list/c 'date integer? integer? integer?)
             (list/c 'title string?)
+            (list/c 'slug string?)
             (list/c 'summary string?)
             (cons/c 'authors (listof string?)))))
 
@@ -30,11 +33,6 @@
   (define text (port->string port))
   (input-document metadata text))
 
-(define *banner*
-  '(!HTML-COMMENT () " this page made with: trans rights 🏳️‍⚧️ "))
-(define *mathjax-placeholder*
-  '(div ([style "display: none"]) "__X_MATHJAX_POLYFILL_PLACEHOLDER__"))
-
 (define (markdown->html input)
   (match-define (input-document md text) input)
   (define output-raw (parse-markdown text))
@@ -49,8 +47,6 @@
   (define document
     (article:execute (hash 'metadata-ref metadata-ref
                            'metadata-ref+ metadata-ref+
-                           '*banner* *banner*
-                           '*mathjax-placeholder* *mathjax-placeholder*
                            'metadata md
                            'page-styles styles
                            'content-toc output-toc
@@ -59,5 +55,10 @@
   (with-output-to-string (λ () (display "<!doctype html>") (display-xexpr document))))
 
 (module+ main
-  (define doc (read-doc))
+  (require racket/cmdline)
-  (displayln (markdown->html doc)))
+  (command-line
+    #:program "meow"
+    #:args (infile outfile)
+    (define-rule (render [out outfile] [in infile])
+      (write-string (markdown->html (read-doc in)) out))
+    (generate/execute (list render))))

templates/article.html.rkt

@@ -4,7 +4,7 @@
   ([lang "en"])
   (head
     ()
-    ,*banner*
+    (!HTML-COMMENT () " this page made with: trans rights 🏳️‍⚧️ ")
     (meta ([charset "utf-8"]))
     (title () ,(metadata-ref+ metadata 'title "<untitled article>"))
     (meta ([name "viewport"] [content "width=device-width, initial-scale=1"]))
@@ -35,4 +35,6 @@
     (main
       ()
       ,@content)
-    ,*mathjax-placeholder*))
+    ;; mathjax polyfill script sentinel -- gets replaced by a script tag for crying doge chrombe
+    ;; and with nothing for swole firefox
+    (div ([style "display: none"]) "__X_MATHJAX_POLYFILL_PLACEHOLDER__")))

xtemplate.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
 (require racket/base racket/format racket/list racket/match racket/string
-         syntax/parse syntax/parse/define
+         syntax/parse syntax/parse/define racket/stxparam
          (for-syntax racket/base racket/match racket/set))
 
 (provide (rename-out [x:#%module-begin #%module-begin]
@@ -9,31 +9,26 @@
          (except-out (all-from-out racket/base racket/format racket/list racket/match racket/string)
                      #%module-begin #%top))
 
-(define-for-syntax *unbound-prop* 'xtemplate:unbound)
+(define-syntax-parameter template-id #f)
-
+(define-syntax-parameter template-vars #f)
-(define-for-syntax (collect-unbounds stx)
-  (define (next stx)
-    (match (syntax->list stx)
-      [#f (set)]
-      [lst (foldr set-union (set) (map collect-unbounds lst))]))
-  (match (syntax-property stx *unbound-prop*)
-    [#f (next stx)]
-    [result (set-add (next stx) result)]))
 
 (define-syntax-parse-rule (x:#%top . id:id)
-  #:with #%template-args (datum->syntax #'id '#%template-args)
+  #:with tem:id (syntax-parameter-value #'template-id)
-  #:with propped-id (syntax-property #'(quote id) *unbound-prop* (syntax->datum #'id))
+  #:do [(set-add! (syntax-parameter-value #'template-vars)
-  (hash-ref #%template-args propped-id))
+                  (syntax->datum #'id))]
+  (hash-ref tem 'id))
 
 (define-syntax-parse-rule (x:#%module-begin body)
-  #:with #%template-args (datum->syntax #'body '#%template-args)
-  #:with execute-fn #'(λ (#%template-args) body)
-  #:with expanded-execute-fn #'execute-fn
-  ; #:with expanded-execute-fn (local-expand #'execute-fn (syntax-local-context) '())
-  ; #:with (unbound-ids ...)
-  ;   (map (λ (stx) #`(quote #,stx)) (set->list (collect-unbounds #'expanded-execute-fn)))
   (#%module-begin
-   ; (provide required-ids)
+   (provide execute required-keys)
-   ; (define required-ids (list unbound-ids ...))
+   (define-values [execute required-keys]
-   (provide execute)
+     (syntax-parameterize ([template-vars (mutable-seteq)])
-   (define execute expanded-execute-fn)))
+       (values (λ (tem)
+                  (syntax-parameterize ([template-id #'tem])
+                    body))
+               (x:required-ids-list))))))
+
+(define-syntax-parse-rule (x:required-ids-list)
+  #:with (items ...)
+    (map (λ (stx) #`(quote #,stx)) (set->list (syntax-parameter-value #'template-vars)))
+  (list items ...))