implement xref checking

defs.rkt

@@ -8,7 +8,6 @@
   (listof (or/c
             (list/c 'date integer? integer? integer?)
             (list/c 'title string?)
-            (list/c 'slug string?)
             (list/c 'lang string?)
             (cons/c 'tags (listof string?))
             (list/c 'summary string?)

doc/extensions.md

@@ -14,7 +14,6 @@ example
 
 ```
 ((date 2021 06 06)
- (slug "meow")
  (title "meow!")
  (summary "the summary")
  (tags "WaterDrinkers" "drinking" "water")
@@ -38,9 +37,9 @@ hashtag link which leads to an aggregate of all pages that use that tag (in the
 
 ## xrefs
 
-pages go into a hierarchy based on their folders and the declared `slug` metadata (or slug derived
-from markdown filename - except for `index.md` which becomes the index in a certain folder).
-xrefs are a way to refer to slugs. xref can appear in links as follows
+pages go into a hierarchy based on their folders and a slug derived from markdown filename - except
+for `index.md` which becomes the index in a certain folder. xrefs are a way to refer to slugs.
+xref can appear in links as follows
 
 ```
 [some link](^some/page/xref)

render.rkt

@@ -10,17 +10,19 @@
          (prefix-in syntax: "ext-syntax/main.rkt")
          (prefix-in page: "templates/page.html.rkt"))
 
-(struct input-doc [metadata text] #:transparent)
-(struct ir-doc [metadata html] #:prefab)
+(struct input-doc [metadata xref-name text] #:transparent)
+(struct ir-doc [metadata xref-name html] #:prefab)
 
 (define-runtime-path *render.scss* "render.scss")
 
-(define (read-input-doc [port (current-input-port)])
+(define *index.md* (build-path "index.md"))
+
+(define (read-input-doc xref-name [port (current-input-port)])
   (define metadata (read port))
   (unless (metadata? metadata)
     (error "post front matter is not valid metadata!"))
   (define text (port->string port))
-  (input-doc metadata text))
+  (input-doc metadata xref-name text))
 
 (define *xref-char* "^")
 (define *user-char* "@")
@@ -68,19 +70,35 @@
        (apply list tag attrs (map extract-prefixed-links+ children))]
       [(? string? str) str]))
   (extract-prefixed-links+ xexpr))
+
 (define (extract-prefixed-links/many xexprs start-char tag-name)
   (map (λ (xexpr) (extract-prefixed-links xexpr start-char tag-name)) xexprs))
 
-(define (input-doc->ir-doc doc)
-  (match-define (input-doc md text) doc)
+(define (check-xrefs xexprs xrefs-repo)
+  (define (check-xrefs-help xexpr)
+    (match xexpr
+      [(list 'xref (list (list 'target target)) body ...)
+       (define target-path (explode-path (build-path "/" target)))
+       (unless (set-member? xrefs-repo target-path)
+         (error "invalid xref!" target))
+       (map check-xrefs-help body)]
+      [(list tag attrs body ...)
+       (map check-xrefs-help body)]
+      [(? string?) (void)]))
+  (map check-xrefs-help xexprs)
+  xexprs)
+
+(define (input-doc->ir-doc doc xrefs-repo)
+  (match-define (input-doc md xref-name text) doc)
   (define output-raw (parse-markdown text))
   (define output-cooked
     (~> output-raw syntax:transform-xexprs mathml:transform-xexprs
         (extract-text-starting-with/many *hashtag-char* 'hashtag)
         (extract-text-starting-with/many *user-char* 'user)
         (extract-prefixed-links/many *xref-char* 'xref)
-        (extract-prefixed-links/many *user-char* 'user)))
-  (ir-doc md output-cooked))
+        (extract-prefixed-links/many *user-char* 'user)
+        (check-xrefs xrefs-repo)))
+  (ir-doc md xref-name output-cooked))
 
 ;; lowers pseudo-tags into their final form
 (define (lower-specials xexpr base-url)
@@ -114,13 +132,14 @@
   (lower-specials* xexpr))
 
 (define (ir-doc->page doc)
-  (match-define (ir-doc md content) doc)
+  (match-define (ir-doc md xref-name content) doc)
   (let ([content (lower-specials content "https://awoo.systems")])
     (define content-toc (toc content))
 
     (define document
       (page:execute
         (hash 'metadata md
+              'xref-name xref-name
               'content-toc content-toc
               'content content)))
 
@@ -141,30 +160,44 @@
                      [in (build-path src-dir "index.scss")])
                (~> (compile-index-scss (port->string in)) (write-string out)))
 
-  (struct rule-spec [src intermediate output] #:transparent)
+  (struct rule-spec [src intermediate output xref-name] #:transparent)
 
   (define rule-specs
     (parameterize ([current-directory src-dir])
       (for/list ([md-file (in-directory #f)]
-                 #:when (bytes=? (path-get-extension md-file) #".md"))
+                 #:when (equal? (path-get-extension md-file) #".md"))
         (define fasl-file (path-replace-extension md-file #".fasl"))
         (define out-file (path-replace-extension md-file #".html"))
+        (define xref-name
+          (let-values ([(base name dir?) (split-path md-file)])
+            (if (equal? *index.md* name)
+              (if (eq? 'relative base)
+                (build-path "/")
+                (build-path "/" base))
+              (build-path "/" (path-replace-extension md-file #"")))))
         (rule-spec (build-path src-dir md-file)
                    (build-path build-dir fasl-file)
-                   (build-path output-dir out-file)))))
+                   (build-path output-dir out-file)
+                   xref-name))))
+
+  (define xrefs-repo
+    (for/set ([spec (in-list rule-specs)])
+      (explode-path (rule-spec-xref-name spec))))
 
   (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)))
+        (~> (read-input-doc (rule-spec-xref-name spec) in)
+            (input-doc->ir-doc xrefs-repo)
+            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)))
+        (~> (port->bytes in) fasl->s-exp ir-doc->page (write-string out)))
       output-rule))
   (append intermediate-rules output-rules (list scss)))
 

templates/page.html.rkt

@@ -8,15 +8,15 @@
     (meta ([charset "utf-8"]))
     (title () ,(metadata-ref+ metadata 'title "<untitled page>"))
     (meta ([name "viewport"] [content "width=device-width, initial-scale=1"]))
-    ,@(match (metadata-ref+ metadata 'summary)
+    ,@(match (metadata-ref+ metadata 'summary #f)
              [#f '()]
              [summary
                `((meta ([name "description"] [content ,summary])))])
-    ,@(match (metadata-ref metadata 'authors)
+    ,@(match (metadata-ref metadata 'authors #f)
              [(or #f '()) '()]
              [authors
                `((meta ([name "author"] [content ,(string-join authors ", ")])))])
-    ,@(match (metadata-ref metadata 'date)
+    ,@(match (metadata-ref metadata 'date #f)
              [#f '()]
              [(list yn mn dn)
               `((meta ([name "DC.Date.created"]