implement xref checking
This commit is contained in:
parent
fe87941b51
commit
9408f67b01
1
defs.rkt
1
defs.rkt
|
@ -8,7 +8,6 @@
|
||||||
(listof (or/c
|
(listof (or/c
|
||||||
(list/c 'date integer? integer? integer?)
|
(list/c 'date integer? integer? integer?)
|
||||||
(list/c 'title string?)
|
(list/c 'title string?)
|
||||||
(list/c 'slug string?)
|
|
||||||
(list/c 'lang string?)
|
(list/c 'lang string?)
|
||||||
(cons/c 'tags (listof string?))
|
(cons/c 'tags (listof string?))
|
||||||
(list/c 'summary string?)
|
(list/c 'summary string?)
|
||||||
|
|
|
@ -14,7 +14,6 @@ example
|
||||||
|
|
||||||
```
|
```
|
||||||
((date 2021 06 06)
|
((date 2021 06 06)
|
||||||
(slug "meow")
|
|
||||||
(title "meow!")
|
(title "meow!")
|
||||||
(summary "the summary")
|
(summary "the summary")
|
||||||
(tags "WaterDrinkers" "drinking" "water")
|
(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
|
## xrefs
|
||||||
|
|
||||||
pages go into a hierarchy based on their folders and the declared `slug` metadata (or slug derived
|
pages go into a hierarchy based on their folders and a slug derived from markdown filename - except
|
||||||
from markdown filename - except for `index.md` which becomes the index in a certain folder).
|
for `index.md` which becomes the index in a certain folder. xrefs are a way to refer to slugs.
|
||||||
xrefs are a way to refer to slugs. xref can appear in links as follows
|
xref can appear in links as follows
|
||||||
|
|
||||||
```
|
```
|
||||||
[some link](^some/page/xref)
|
[some link](^some/page/xref)
|
||||||
|
|
61
render.rkt
61
render.rkt
|
@ -10,17 +10,19 @@
|
||||||
(prefix-in syntax: "ext-syntax/main.rkt")
|
(prefix-in syntax: "ext-syntax/main.rkt")
|
||||||
(prefix-in page: "templates/page.html.rkt"))
|
(prefix-in page: "templates/page.html.rkt"))
|
||||||
|
|
||||||
(struct input-doc [metadata text] #:transparent)
|
(struct input-doc [metadata xref-name text] #:transparent)
|
||||||
(struct ir-doc [metadata html] #:prefab)
|
(struct ir-doc [metadata xref-name html] #:prefab)
|
||||||
|
|
||||||
(define-runtime-path *render.scss* "render.scss")
|
(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))
|
(define metadata (read port))
|
||||||
(unless (metadata? metadata)
|
(unless (metadata? metadata)
|
||||||
(error "post front matter is not valid metadata!"))
|
(error "post front matter is not valid metadata!"))
|
||||||
(define text (port->string port))
|
(define text (port->string port))
|
||||||
(input-doc metadata text))
|
(input-doc metadata xref-name text))
|
||||||
|
|
||||||
(define *xref-char* "^")
|
(define *xref-char* "^")
|
||||||
(define *user-char* "@")
|
(define *user-char* "@")
|
||||||
|
@ -68,19 +70,35 @@
|
||||||
(apply list tag attrs (map extract-prefixed-links+ children))]
|
(apply list tag attrs (map extract-prefixed-links+ children))]
|
||||||
[(? string? str) str]))
|
[(? string? str) str]))
|
||||||
(extract-prefixed-links+ xexpr))
|
(extract-prefixed-links+ xexpr))
|
||||||
|
|
||||||
(define (extract-prefixed-links/many xexprs start-char tag-name)
|
(define (extract-prefixed-links/many xexprs start-char tag-name)
|
||||||
(map (λ (xexpr) (extract-prefixed-links xexpr start-char tag-name)) xexprs))
|
(map (λ (xexpr) (extract-prefixed-links xexpr start-char tag-name)) xexprs))
|
||||||
|
|
||||||
(define (input-doc->ir-doc doc)
|
(define (check-xrefs xexprs xrefs-repo)
|
||||||
(match-define (input-doc md text) doc)
|
(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-raw (parse-markdown text))
|
||||||
(define output-cooked
|
(define output-cooked
|
||||||
(~> output-raw syntax:transform-xexprs mathml:transform-xexprs
|
(~> output-raw syntax:transform-xexprs mathml:transform-xexprs
|
||||||
(extract-text-starting-with/many *hashtag-char* 'hashtag)
|
(extract-text-starting-with/many *hashtag-char* 'hashtag)
|
||||||
(extract-text-starting-with/many *user-char* 'user)
|
(extract-text-starting-with/many *user-char* 'user)
|
||||||
(extract-prefixed-links/many *xref-char* 'xref)
|
(extract-prefixed-links/many *xref-char* 'xref)
|
||||||
(extract-prefixed-links/many *user-char* 'user)))
|
(extract-prefixed-links/many *user-char* 'user)
|
||||||
(ir-doc md output-cooked))
|
(check-xrefs xrefs-repo)))
|
||||||
|
(ir-doc md xref-name output-cooked))
|
||||||
|
|
||||||
;; lowers pseudo-tags into their final form
|
;; lowers pseudo-tags into their final form
|
||||||
(define (lower-specials xexpr base-url)
|
(define (lower-specials xexpr base-url)
|
||||||
|
@ -114,13 +132,14 @@
|
||||||
(lower-specials* xexpr))
|
(lower-specials* xexpr))
|
||||||
|
|
||||||
(define (ir-doc->page doc)
|
(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")])
|
(let ([content (lower-specials content "https://awoo.systems")])
|
||||||
(define content-toc (toc content))
|
(define content-toc (toc content))
|
||||||
|
|
||||||
(define document
|
(define document
|
||||||
(page:execute
|
(page:execute
|
||||||
(hash 'metadata md
|
(hash 'metadata md
|
||||||
|
'xref-name xref-name
|
||||||
'content-toc content-toc
|
'content-toc content-toc
|
||||||
'content content)))
|
'content content)))
|
||||||
|
|
||||||
|
@ -141,30 +160,44 @@
|
||||||
[in (build-path src-dir "index.scss")])
|
[in (build-path src-dir "index.scss")])
|
||||||
(~> (compile-index-scss (port->string in)) (write-string out)))
|
(~> (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
|
(define rule-specs
|
||||||
(parameterize ([current-directory src-dir])
|
(parameterize ([current-directory src-dir])
|
||||||
(for/list ([md-file (in-directory #f)]
|
(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 fasl-file (path-replace-extension md-file #".fasl"))
|
||||||
(define out-file (path-replace-extension md-file #".html"))
|
(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)
|
(rule-spec (build-path src-dir md-file)
|
||||||
(build-path build-dir fasl-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
|
(define intermediate-rules
|
||||||
(for/list ([spec (in-list rule-specs)])
|
(for/list ([spec (in-list rule-specs)])
|
||||||
(define-rule (intermediate-rule [out (rule-spec-intermediate spec)]
|
(define-rule (intermediate-rule [out (rule-spec-intermediate spec)]
|
||||||
[in (rule-spec-src 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))
|
intermediate-rule))
|
||||||
|
|
||||||
(define output-rules
|
(define output-rules
|
||||||
(for/list ([spec (in-list rule-specs)])
|
(for/list ([spec (in-list rule-specs)])
|
||||||
(define-rule (output-rule [out (rule-spec-output spec)]
|
(define-rule (output-rule [out (rule-spec-output spec)]
|
||||||
[in (rule-spec-intermediate 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))
|
output-rule))
|
||||||
(append intermediate-rules output-rules (list scss)))
|
(append intermediate-rules output-rules (list scss)))
|
||||||
|
|
||||||
|
|
|
@ -8,15 +8,15 @@
|
||||||
(meta ([charset "utf-8"]))
|
(meta ([charset "utf-8"]))
|
||||||
(title () ,(metadata-ref+ metadata 'title "<untitled page>"))
|
(title () ,(metadata-ref+ metadata 'title "<untitled page>"))
|
||||||
(meta ([name "viewport"] [content "width=device-width, initial-scale=1"]))
|
(meta ([name "viewport"] [content "width=device-width, initial-scale=1"]))
|
||||||
,@(match (metadata-ref+ metadata 'summary)
|
,@(match (metadata-ref+ metadata 'summary #f)
|
||||||
[#f '()]
|
[#f '()]
|
||||||
[summary
|
[summary
|
||||||
`((meta ([name "description"] [content ,summary])))])
|
`((meta ([name "description"] [content ,summary])))])
|
||||||
,@(match (metadata-ref metadata 'authors)
|
,@(match (metadata-ref metadata 'authors #f)
|
||||||
[(or #f '()) '()]
|
[(or #f '()) '()]
|
||||||
[authors
|
[authors
|
||||||
`((meta ([name "author"] [content ,(string-join authors ", ")])))])
|
`((meta ([name "author"] [content ,(string-join authors ", ")])))])
|
||||||
,@(match (metadata-ref metadata 'date)
|
,@(match (metadata-ref metadata 'date #f)
|
||||||
[#f '()]
|
[#f '()]
|
||||||
[(list yn mn dn)
|
[(list yn mn dn)
|
||||||
`((meta ([name "DC.Date.created"]
|
`((meta ([name "DC.Date.created"]
|
||||||
|
|
Loading…
Reference in New Issue