From 9408f67b0102a9a6d0f2a17121af9d24f6b8b754 Mon Sep 17 00:00:00 2001 From: haskal Date: Thu, 10 Jun 2021 20:44:03 -0400 Subject: [PATCH] implement xref checking --- defs.rkt | 1 - doc/extensions.md | 7 ++--- render.rkt | 61 +++++++++++++++++++++++++++++++---------- templates/page.html.rkt | 6 ++-- 4 files changed, 53 insertions(+), 22 deletions(-) diff --git a/defs.rkt b/defs.rkt index 5fe8689..b9c2632 100644 --- a/defs.rkt +++ b/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?) diff --git a/doc/extensions.md b/doc/extensions.md index 63acb0e..c77d10a 100644 --- a/doc/extensions.md +++ b/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) diff --git a/render.rkt b/render.rkt index 05b2f51..4df49dd 100644 --- a/render.rkt +++ b/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))) diff --git a/templates/page.html.rkt b/templates/page.html.rkt index 352aedb..a425646 100644 --- a/templates/page.html.rkt +++ b/templates/page.html.rkt @@ -8,15 +8,15 @@ (meta ([charset "utf-8"])) (title () ,(metadata-ref+ metadata 'title "")) (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"]