make hashtag page actually work
This commit is contained in:
parent
b37802627d
commit
ba73943129
10
compiler.rkt
10
compiler.rkt
|
@ -7,7 +7,8 @@
|
||||||
(require racket/bool racket/file racket/match racket/set
|
(require racket/bool racket/file racket/match racket/set
|
||||||
syntax/parse/define (for-syntax racket/base racket/syntax))
|
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
|
;; A compiler rule
|
||||||
;; Input files, output file, compile function
|
;; Input files, output file, compile function
|
||||||
|
@ -23,6 +24,13 @@
|
||||||
(lambda (outfile infile ...)
|
(lambda (outfile infile ...)
|
||||||
body ...))))
|
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
|
;; Converts set of rules into ordered list of rules to execute based on current filesystem state
|
||||||
(define (generate-operations rules)
|
(define (generate-operations rules)
|
||||||
(define nodes (mutable-set))
|
(define nodes (mutable-set))
|
||||||
|
|
|
@ -1,6 +1,8 @@
|
||||||
# todo
|
# todo
|
||||||
|
|
||||||
- prefers-color-scheme
|
- 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)
|
- firefox alternative stylesheets too maybe (send more js for chrome to do the thing too)
|
||||||
- explicitly block brave (also needs js)
|
- explicitly block brave (also needs js)
|
||||||
- rss/atom
|
- rss/atom
|
||||||
|
|
48
render.rkt
48
render.rkt
|
@ -7,7 +7,8 @@
|
||||||
threading
|
threading
|
||||||
(prefix-in sass: sass)
|
(prefix-in sass: sass)
|
||||||
(prefix-in ext: "ext/main.rkt")
|
(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)
|
(provide scan-for-rules)
|
||||||
|
|
||||||
|
@ -118,7 +119,7 @@
|
||||||
(match xexpr
|
(match xexpr
|
||||||
;; hashtags
|
;; hashtags
|
||||||
[(list 'hashtag (list (list 'target target)) body ...)
|
[(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))]
|
,@(map lower-specials* body))]
|
||||||
;; xrefs
|
;; xrefs
|
||||||
[(list 'xref (list (list 'target target)) body ...)
|
[(list 'xref (list (list 'target target)) body ...)
|
||||||
|
@ -143,6 +144,9 @@
|
||||||
[(? string? str) str]))
|
[(? string? str) str]))
|
||||||
(map lower-specials* xexpr))
|
(map lower-specials* xexpr))
|
||||||
|
|
||||||
|
(define (capy-xexp->string document)
|
||||||
|
(with-output-to-string (λ () (display "<!doctype html>") (display-xexpr document))))
|
||||||
|
|
||||||
(define (ir-doc->page doc xrefs-repo site-config)
|
(define (ir-doc->page doc xrefs-repo site-config)
|
||||||
(match-define (ir-doc md xref-name content) doc)
|
(match-define (ir-doc md xref-name content) doc)
|
||||||
(define base-url (assoc-ref+ site-config 'base))
|
(define base-url (assoc-ref+ site-config 'base))
|
||||||
|
@ -182,13 +186,34 @@
|
||||||
(page:execute
|
(page:execute
|
||||||
(hash 'metadata md
|
(hash 'metadata md
|
||||||
'site-config site-config
|
'site-config site-config
|
||||||
'xref-name xref-name
|
|
||||||
'base-url base-url
|
'base-url base-url
|
||||||
'site-toc site-toc
|
'site-toc site-toc
|
||||||
'content-toc content-toc
|
'content-toc content-toc
|
||||||
'content content)))
|
'content content)))
|
||||||
|
|
||||||
(with-output-to-string (λ () (display "<!doctype html>") (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 (compile-index-scss index.scss)
|
||||||
(define scss-files (list *render.scss*))
|
(define scss-files (list *render.scss*))
|
||||||
|
@ -253,6 +278,19 @@
|
||||||
s-exp->fasl (write-bytes out)))
|
s-exp->fasl (write-bytes out)))
|
||||||
intermediate-rule))
|
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 "<untitled page>"))
|
||||||
|
(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
|
(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)]
|
||||||
|
@ -265,7 +303,7 @@
|
||||||
(ir-doc->page xrefs-repo config)
|
(ir-doc->page xrefs-repo config)
|
||||||
(write-string out)))
|
(write-string out)))
|
||||||
output-rule))
|
output-rule))
|
||||||
(append intermediate-rules output-rules (list scss favicon)))
|
(append intermediate-rules output-rules (list scss favicon hashtag-page)))
|
||||||
|
|
||||||
(module+ main
|
(module+ main
|
||||||
(require racket/cmdline)
|
(require racket/cmdline)
|
||||||
|
|
|
@ -0,0 +1,15 @@
|
||||||
|
#lang capybara/template
|
||||||
|
|
||||||
|
(apply
|
||||||
|
append
|
||||||
|
(for*/list ([name (in-list (sort (hash-keys hashtags-map) string<? #:key string-downcase))]
|
||||||
|
[entries (in-value (hash-ref hashtags-map name))])
|
||||||
|
(list
|
||||||
|
`(h1 ([class "tag-heading"] [id ,name]) ,(format "#~a" name))
|
||||||
|
`(ul ([class "tagged-pages"])
|
||||||
|
,@(for*/list ([ref (in-list (sort (hash-keys entries) string<?
|
||||||
|
#:key (compose string-downcase path->string)))]
|
||||||
|
[name (in-value (hash-ref entries ref))])
|
||||||
|
`(li () (a ([class "tagged-page"]
|
||||||
|
[href ,(format "~a~a" base-url ref)])
|
||||||
|
,name)))))))
|
|
@ -21,7 +21,9 @@
|
||||||
[(list yn mn dn)
|
[(list yn mn dn)
|
||||||
`((meta ([name "DC.Date.created"]
|
`((meta ([name "DC.Date.created"]
|
||||||
[content ,(format "~a-~a-~a" (~r/pad yn 4) (~r/pad mn 2) (~r/pad dn 2))])))])
|
[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 "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)])))
|
(link ([rel "stylesheet"] [type "text/css"] [href ,(format "~a/index.css" base-url)])))
|
||||||
(body
|
(body
|
||||||
|
@ -29,9 +31,16 @@
|
||||||
(nav
|
(nav
|
||||||
()
|
()
|
||||||
(section () ,site-toc)
|
(section () ,site-toc)
|
||||||
(section () ,content-toc))
|
,@(if content-toc `((section () ,content-toc)) '()))
|
||||||
(main
|
(main
|
||||||
()
|
()
|
||||||
|
,@(match (assoc-ref metadata 'tags '())
|
||||||
|
['() '()]
|
||||||
|
[tags
|
||||||
|
`((p ()
|
||||||
|
"tags:"
|
||||||
|
,@(for/list ([tag (in-list tags)])
|
||||||
|
`(span ([class "page-tag"]) ,(format "#~a" tag)))))])
|
||||||
,@content)
|
,@content)
|
||||||
;; mathjax polyfill script sentinel -- gets replaced by a script tag for crying doge chrombe
|
;; mathjax polyfill script sentinel -- gets replaced by a script tag for crying doge chrombe
|
||||||
;; and with nothing for swole firefox
|
;; and with nothing for swole firefox
|
||||||
|
|
7
util.rkt
7
util.rkt
|
@ -1,8 +1,11 @@
|
||||||
#lang racket/base
|
#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 (get-date-ymd)
|
||||||
(define date (current-date))
|
(define date (current-date))
|
||||||
|
|
Loading…
Reference in New Issue