diff --git a/compiler.rkt b/compiler.rkt index 02c3426..96261db 100644 --- a/compiler.rkt +++ b/compiler.rkt @@ -7,7 +7,8 @@ (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) +(provide define-rule define-rule* + generate-operations execute-rule execute-operations generate/execute) ;; A compiler rule ;; Input files, output file, compile function @@ -23,6 +24,13 @@ (lambda (outfile infile ...) body ...)))) +(define-syntax-parse-rule (define-rule* (id:id [outfile:id outpath:expr] [infiles:id inpaths:expr]) + body:expr ...+) + #:with name-sym #'(quote id) + (define id (rule name-sym inpaths outpath + (lambda (outfile . infiles) + 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)) diff --git a/doc/todo.md b/doc/todo.md index b169f2a..041d832 100644 --- a/doc/todo.md +++ b/doc/todo.md @@ -1,6 +1,8 @@ # todo - prefers-color-scheme +- robots.txt, sitemap.xml +- error pages: 404, 500, etc - firefox alternative stylesheets too maybe (send more js for chrome to do the thing too) - explicitly block brave (also needs js) - rss/atom diff --git a/render.rkt b/render.rkt index 4725214..a69bc3b 100644 --- a/render.rkt +++ b/render.rkt @@ -7,7 +7,8 @@ threading (prefix-in sass: sass) (prefix-in ext: "ext/main.rkt") - (prefix-in page: "templates/page.html.rkt")) + (prefix-in page: "templates/page.html.rkt") + (prefix-in hashtag: "templates/hashtag.html.rkt")) (provide scan-for-rules) @@ -118,7 +119,7 @@ (match xexpr ;; hashtags [(list 'hashtag (list (list 'target target)) body ...) - `(a ([class "hashtag"] [href ,(format "~a/hashtag/~a" base-url target)]) + `(a ([class "hashtag"] [href ,(format "~a/hashtag#~a" base-url target)]) ,@(map lower-specials* body))] ;; xrefs [(list 'xref (list (list 'target target)) body ...) @@ -143,6 +144,9 @@ [(? string? str) str])) (map lower-specials* xexpr)) +(define (capy-xexp->string document) + (with-output-to-string (λ () (display "") (display-xexpr document)))) + (define (ir-doc->page doc xrefs-repo site-config) (match-define (ir-doc md xref-name content) doc) (define base-url (assoc-ref+ site-config 'base)) @@ -182,13 +186,34 @@ (page:execute (hash 'metadata md 'site-config site-config - 'xref-name xref-name 'base-url base-url 'site-toc site-toc 'content-toc content-toc 'content content))) - (with-output-to-string (λ () (display "") (display-xexpr document))))) + (capy-xexp->string document))) + +(define (make-hashtag-page hashtags-map site-config) + (define base-url (assoc-ref+ site-config 'base)) + (define content + (hashtag:execute + (hash 'site-config site-config + 'base-url base-url + 'hashtags-map hashtags-map))) + (define site-toc + `(ol () + (li () (a ([href ,(format "~a~a" base-url "/")]) "/")))) + (define document + (page:execute + (hash 'metadata `((lang "en") + (title "All pages by tag") + (summary "List of all pages on this site by tags")) + 'site-config site-config + 'base-url base-url + 'site-toc site-toc + 'content-toc #f + 'content content))) + (capy-xexp->string document)) (define (compile-index-scss index.scss) (define scss-files (list *render.scss*)) @@ -253,6 +278,19 @@ s-exp->fasl (write-bytes out))) intermediate-rule)) + (define-rule* (hashtag-page [out (build-path output-dir "hashtag.html")] + [ins (cons config.rktd (map rule-spec-intermediate rule-specs))]) + (define config (read (first ins))) + (unless (config? config) + (error "invalid config in config.rktd!")) + (define hashtag-map (make-hash)) + (for ([ir-in (in-list (rest ins))] [xref-name (in-list (map rule-spec-xref-name rule-specs))]) + (define md (~> (port->bytes ir-in) fasl->s-exp ir-doc-metadata)) + (define title (assoc-ref+ md 'title "")) + (for ([tag (in-list (assoc-ref md 'tags '()))]) + (hash-set! (hash-ref! hashtag-map tag make-hash) xref-name title))) + (~> (make-hashtag-page hashtag-map config) (write-string out))) + (define output-rules (for/list ([spec (in-list rule-specs)]) (define-rule (output-rule [out (rule-spec-output spec)] @@ -265,7 +303,7 @@ (ir-doc->page xrefs-repo config) (write-string out))) output-rule)) - (append intermediate-rules output-rules (list scss favicon))) + (append intermediate-rules output-rules (list scss favicon hashtag-page))) (module+ main (require racket/cmdline) diff --git a/templates/hashtag.html.rkt b/templates/hashtag.html.rkt new file mode 100644 index 0000000..be75a4a --- /dev/null +++ b/templates/hashtag.html.rkt @@ -0,0 +1,15 @@ +#lang capybara/template + +(apply + append + (for*/list ([name (in-list (sort (hash-keys hashtags-map) stringstring)))] + [name (in-value (hash-ref entries ref))]) + `(li () (a ([class "tagged-page"] + [href ,(format "~a~a" base-url ref)]) + ,name))))))) diff --git a/templates/page.html.rkt b/templates/page.html.rkt index d182dda..5dec948 100644 --- a/templates/page.html.rkt +++ b/templates/page.html.rkt @@ -21,7 +21,9 @@ [(list yn mn dn) `((meta ([name "DC.Date.created"] [content ,(format "~a-~a-~a" (~r/pad yn 4) (~r/pad mn 2) (~r/pad dn 2))])))]) - (meta ([name "generator"] [content "meow meow meow meow"])) + (meta ([name "generator"] + [content + ,(format "capybara ~a https://git.lain.faith/haskal/capybara" capybara-version)])) (link ([rel "shortcut icon"] [type "image/png"] [href ,(format "~a/favicon.png" base-url)])) (link ([rel "stylesheet"] [type "text/css"] [href ,(format "~a/index.css" base-url)]))) (body @@ -29,9 +31,16 @@ (nav () (section () ,site-toc) - (section () ,content-toc)) + ,@(if content-toc `((section () ,content-toc)) '())) (main () + ,@(match (assoc-ref metadata 'tags '()) + ['() '()] + [tags + `((p () + "tags:" + ,@(for/list ([tag (in-list tags)]) + `(span ([class "page-tag"]) ,(format "#~a" tag)))))]) ,@content) ;; mathjax polyfill script sentinel -- gets replaced by a script tag for crying doge chrombe ;; and with nothing for swole firefox diff --git a/util.rkt b/util.rkt index d01c02b..7e66f92 100644 --- a/util.rkt +++ b/util.rkt @@ -1,8 +1,11 @@ #lang racket/base -(require racket/date racket/format racket/match racket/string racket/port) +(require racket/date racket/format racket/match racket/string racket/port + (rename-in "info.rkt" [#%info-lookup capy:info])) -(provide ~r/pad run-external get-date-ymd date->string/iso-8601) +(provide ~r/pad run-external get-date-ymd date->string/iso-8601 capybara-version) + +(define capybara-version (capy:info 'version)) (define (get-date-ymd) (define date (current-date))