diff --git a/render.rkt b/render.rkt index 4df49dd..5c6c9a6 100644 --- a/render.rkt +++ b/render.rkt @@ -1,7 +1,7 @@ #lang racket/base (require racket/fasl racket/list racket/match racket/port racket/path racket/set racket/string - racket/runtime-path + racket/runtime-path net/url-string markdown markdown/display-xexpr markdown/toc "compiler.rkt" "defs.rkt" "fetch.rkt" threading @@ -17,6 +17,8 @@ (define *index.md* (build-path "index.md")) +(define *reserved-slugs* (set (build-path "hashtag") (build-path "user") (build-path "tech"))) + (define (read-input-doc xref-name [port (current-input-port)]) (define metadata (read port)) (unless (metadata? metadata) @@ -74,19 +76,25 @@ (define (extract-prefixed-links/many xexprs start-char tag-name) (map (λ (xexpr) (extract-prefixed-links xexpr start-char tag-name)) xexprs)) -(define (check-xrefs xexprs xrefs-repo) +(define (check-xrefs xexprs xrefs-repo base-xref) (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) + (define abs-target + (simplify-path + (url->path + (combine-url/relative + (path->url base-xref) + target)) + #f)) + (unless (set-member? xrefs-repo (explode-path abs-target)) (error "invalid xref!" target)) - (map check-xrefs-help body)] + (apply list 'xref (list (list 'target (path->string abs-target))) + (map check-xrefs-help body))] [(list tag attrs body ...) - (map check-xrefs-help body)] - [(? string?) (void)])) - (map check-xrefs-help xexprs) - xexprs) + (cons tag (cons attrs (map check-xrefs-help body)))] + [(? string?) xexpr])) + (map check-xrefs-help xexprs)) (define (input-doc->ir-doc doc xrefs-repo) (match-define (input-doc md xref-name text) doc) @@ -97,7 +105,7 @@ (extract-text-starting-with/many *user-char* 'user) (extract-prefixed-links/many *xref-char* 'xref) (extract-prefixed-links/many *user-char* 'user) - (check-xrefs xrefs-repo))) + (check-xrefs xrefs-repo xref-name))) (ir-doc md xref-name output-cooked)) ;; lowers pseudo-tags into their final form @@ -110,7 +118,7 @@ ,@(map lower-specials* body))] ;; xrefs [(list 'xref (list (list 'target target)) body ...) - `(a ([class "xref"] [href ,(format "~a/xref/~a" base-url target)]) + `(a ([class "xref"] [href ,(format "~a~a" base-url target)]) ,@(map lower-specials* body))] ;; users [(list 'user (list (list 'target target)) body ...) @@ -182,7 +190,10 @@ (define xrefs-repo (for/set ([spec (in-list rule-specs)]) - (explode-path (rule-spec-xref-name spec)))) + (define exploded (explode-path (rule-spec-xref-name spec))) + (when (and (> (length exploded) 1) + (set-member? *reserved-slugs* (second exploded))) + (error "file is using a reserved slug" (rule-spec-src spec))))) (define intermediate-rules (for/list ([spec (in-list rule-specs)])