haskal
/
capybara
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

make hashtag page actually work

This commit is contained in:
xenia 2021-06-24 00:16:14 -04:00
parent b37802627d
commit ba73943129
6 changed files with 85 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler.rkt
View File

@ -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))

2
doc/todo.md
View File

@ -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

48
render.rkt
View File

@ -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 "<!doctype html>") (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 "<!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 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 "<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
(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)

15
templates/hashtag.html.rkt Normal file
View File

@ -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)))))))

13
templates/page.html.rkt
View File

@ -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

7
util.rkt
View File

@ -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))