refactor dispatcher code and add style

stubbed rss/atom feed, applied consistent hx-target for in-place fragments
This commit is contained in:
Sorrel 2023-10-31 16:46:45 -04:00
parent c1ee729671
commit 92f20f47a0
8 changed files with 265 additions and 90 deletions

View file

@ -1,9 +1,11 @@
#lang racket
(require net/url
(require racket/date
net/url
xml
web-server/web-server
web-server/servlet-dispatch
web-server/dispatchers/dispatch
web-server/dispatch
(prefix-in files: web-server/dispatchers/dispatch-files)
(prefix-in filter: web-server/dispatchers/dispatch-filter)
@ -11,6 +13,7 @@
web-server/dispatchers/filesystem-map
web-server/http)
(define (html-response content)
(response/full
200
@ -21,43 +24,46 @@
(list content)))
;; takes a resource-type (corresponds to the REST resource and the system path or
;; an index resource in the source path)
;; and a resource-processor (-> file-handle . http-response)
;; and returns a valid html-response irrespective of hx/ type fragment of html or full page
(define respond-resource-with-processor
(lambda (type resource-processor)
(case-lambda
[(req) (let ([res-path (path-add-extension
(build-path "source" type) #".txt")])
(if (file-exists? res-path)
(html-response (resource-processor res-path))
(html-response (resource-processor "source/not-found.txt"))))]
[(req id) (let ([res-path (path-add-extension
(build-path "source" type (~a id)) #".txt")])
(if (file-exists? res-path)
(html-response (resource-processor res-path))
(html-response (resource-processor "source/not-found.txt"))))])))
;;; httpx
;; sends only the requested resource
(define (xexpr-file->xml file)
(string->bytes/utf-8
(xexpr->string (read (open-input-file file)))))
;;; httpx
;; sends only the requested resource
(define (about request)
(html-response (xexpr-file->xml "source/about.txt")))
(define (home request)
(html-response (xexpr-file->xml "source/index.txt")))
(define (404- request)
(define (404-hx request)
(html-response (xexpr-file->xml "source/not-found.txt")))
(define (structures request structure-id)
(html-response (xexpr-file->xml "source/not-found.txt")))
(define (index-structures request)
(html-response (xexpr-file->xml "source/not-found.txt")))
(define (unstructures request structure-id)
(html-response (xexpr-file->xml "source/not-found.txt")))
(define (index-unstructures request)
(html-response (xexpr-file->xml "source/not-found.txt")))
(define-values (httpx-app reverse-httpx-uri)
(dispatch-rules
[("hx" "about") about]
[("hx" "home") home]
[("hx" "structures" (integer-arg)) structures]
[("hx" "structures") index-structures]
[("hx" "unstructures" (integer-arg)) unstructures]
[("hx" "unstructures") index-unstructures]
[else 404-]))
[("hx" "about") (respond-resource-with-processor "about" xexpr-file->xml)]
[("hx" "home") (respond-resource-with-processor "index" xexpr-file->xml)]
[("hx" "settleds" (integer-arg)) (respond-resource-with-processor "settleds" xexpr-file->xml)]
[("hx" "settleds") (respond-resource-with-processor "settleds" xexpr-file->xml)]
[("hx" "unsettleds" (integer-arg)) (respond-resource-with-processor "unsettleds" xexpr-file->xml)]
[("hx" "unsettleds") (respond-resource-with-processor "unsettleds" xexpr-file->xml)]
[("hx" "tagged" (string-arg)) (respond-resource-with-processor "tagged" xexpr-file->xml)]
[("hx" "tagged") (respond-resource-with-processor "tagged" xexpr-file->xml)]
[("hx" "this") (respond-resource-with-processor "this" xexpr-file->xml)]
[else 404-hx]))
;;; page-app
;; constructs entire page for each response
@ -70,15 +76,19 @@
,(read (open-input-file "source/header.txt"))
,(read (open-input-file resource)))))))
(define (homepage request)
(html-response (make-page "source/index.txt")))
(define (about-page request)
(html-response (make-page "source/about.txt")))
(define-values (page-app reverse-page-uri)
(dispatch-rules
[("") homepage]
[("about") about-page]))
[("") (respond-resource-with-processor "index" make-page)]
[("about") (respond-resource-with-processor "about" make-page)]
[("settleds" (integer-arg)) (respond-resource-with-processor "settleds" make-page)]
[("settleds") (respond-resource-with-processor "settleds" make-page)]
[("unsettleds" (integer-arg)) (respond-resource-with-processor "unsettleds" make-page)]
[("unsettleds") (respond-resource-with-processor "unsettleds" make-page)]
[("tagged" (string-arg)) (respond-resource-with-processor "tagged" make-page)]
[("tagged") (respond-resource-with-processor "tagged" make-page)]
[("this") (respond-resource-with-processor "this" make-page)]
[else not-found]))
;;; from /static
@ -89,6 +99,36 @@
(url->path/static
(struct-copy url u [path (cdr (url-path u))])))))
;; rss feed
(define (xml-response content)
(response/full
200
#"OK"
(current-seconds)
#"application/atom+xml; charset=utf-8"
'()
(list content)))
(define (rss-feed request)
(let ([feed-ref "https://sorrel.dev/feed.atom"]
[update-time (date->string (current-date) (date-display-format 'iso-8601))]
[homepage "https://sorrel.dev"])
;; hard coding for now because reader can't be escaped
(define content
`(feed
((xmlns "http://www.w3.org/2005/Atom"))
(title "λ.sorrel.dev")
(link ((rel "self")
(href ,feed-ref)))
(updated ,update-time)
(author
(name "sorrel"))
(id ,homepage)))
(xml-response
(string->bytes/utf-8 (string-append "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
(xexpr->string content))))))
;;; 404
(define (not-found request)
@ -101,6 +141,7 @@
#:dispatch (sequencer:make
(filter:make #rx"^/static/" static-dispatcher)
(dispatch/servlet #:regexp #rx"^/hx/" httpx-app)
(dispatch/servlet #:regexp #rx"^/feed.atom" rss-feed)
(dispatch/servlet page-app)
(dispatch/servlet not-found)
)

View file

@ -37,33 +37,39 @@
;; about me bullets
(ul
;; language bullet
(li (p "i like linguistics a whole lot."
(li (p "i like linguistics a whole lot. "
(span
((class "hx-target"))
(a ((href "/tagged/conlang")
(hx-get "/hx/tagged/conlang")
(hx-target "nearest a")
(hx-target "closest span.hx-target")
; swap for a tag? just a lil list inside a list?
(hx-swap "innerHTML"))
"i make languages (the human kind) for fun.")
"there's a whole bunch of people who do this! "
"i make languages (the human kind) for fun."))
" there's a whole bunch of people who do this! "
(a ((href "https://conlang.org/"))
"language creation society")
"the language creation society")
" i'm even working on a "
(span
((class "hx-target"))
(a ((href "/tagged/latl")
(hx-get "/hx/tagged/latl")
(hx-target "nearest a")
(hx-target "closest span.hx-target")
(hx-swap "innerHTML"))
"language (computer) to make languages (human).")))
"language (computer) to make languages (human)."))))
;; mmt bullet
(li (p "mmt, but make it anarchist "
(small "and get rid of all that \"sovereignty\" stuff, ew")))
(li (p "the autistic-contiguous position: object-relations theory or gay
sex act?"
(small "a " (em "niche") " joke about having"
sex act? "
(span
((class "hx-target"))
(small "a " (em "niche") " joke about having "
(a ((href "/tagged/brain")
(hx-get "/hx/tagged/brain")
(hx-target "nearest a")
(hx-target "closest span.hx-target")
(hx-swap "innerHTML"))
"a ~type~ of experience"))))
"a ~type~ of experience")))))
(li (p "being trans and gay"))
(li (p "א ⃝"))))
(section
@ -79,7 +85,7 @@
"please be patient! with me and with everyone else you talk about things
you care about with.")
(p "let's hold our strong opinions loosely!")
(p "and first assume good faith from others!")
(p "and first assume good faith from each other!")
(br)
(br)
(p ((class "ascii but-normal-size"))

28
source/atom.txt Normal file
View file

@ -0,0 +1,28 @@
;; required on update
;; -- (let (feed-ref "https://URI/atom")
;; (update-time
(feed
((xmlns "http://www.w3.org/2005/Atom"))
(title "λ.sorrel.dev")
(link ((rel "self")
(href ,feed-ref)))
(updated ,update-time)
(author
(name "sorrel"))
(id ,homepage)
; ,(map
; (lambda (item)
; `(entry
; (title ,(title item))
; (link ((href ,(href item))))
; (id ,(href item))
; (type ,(type item)) ; usually html
; ,(map (lambda (category)
; `(category ((term ,(term category))
; (scheme ,(scheme category)))))
; (categories item))
; (updated ,(updated item)))
; items))
)

View file

@ -1,14 +1,14 @@
(header
(div
((class "banner"))
(a
((href "/")
((class "banner")
(hx-get "/hx/home")
(hx-target "main")
(hx-swap "outerHTML"))
(p
((class "ascii"))
"▒▓░ home ░░▒ ▒▒▓█▒ ░▒
"▒▓░ "(a
((href "/"))
"home")" ░░▒ ▒▒▓█▒ ░▒
░▒▒░▓▓ ▒▒▒▒▒▒▓█ ▒▓
▒▒▓▓░▒▓ ▓█▓▓ ░▓
▓▒▒ ▒▒ ░
@ -45,7 +45,7 @@
░▓▒▓▓▒▓▒▒▒▒▒▒▒▒▒▒▒▒▒▒▓▒▒▒▒▒▓▒▓ ░░▓ ▒▒░ ▒ ▓░ ▒
▓▒░ ▓▒▒▒█▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▓▒▒▒ ▒░ ▓▒▓ ▒▒ ▒ ░
░▒▓ ▓▒▒▒▒▒▓▒▒▒▒▒▒▒▒▒▒▒▒▒▒▓▒▓▒▒▒ ▒░▓ ░▒░▒ ░░
▒▓ ░▒▒▒▒▒▓▒▒▓▒▒▒▒▒▒▒▒▒▒▓▒▓▓▓▒▒ ▓░ ░▒ ░▓ ")))
▒▓ ░▒▒▒▒▒▓▒▒▓▒▒▒▒▒▒▒▒▒▒▓▒▓▓▓▒▒ ▓░ ░▒ ░▓ "))
(nav
(a
((href "/about")
@ -54,14 +54,14 @@
(hx-swap "innerHTML"))
"about sorrel (the bitch who made this)")
(a
((href "/unsettled")
(hx-get "/hx/unsettled")
((href "/unsettleds")
(hx-get "/hx/unsettleds")
(hx-target "main")
(hx-swap "innerHTML"))
"unsettled thoughts (something like a blog)")
(a
((href "/settled")
(hx-get "/hx/settled")
((href "/settleds")
(hx-get "/hx/settleds")
(hx-target "main")
(hx-swap "innerHTML"))
"\"settled\" thoughts (projects built/in progress)")))

View file

@ -1,9 +1,12 @@
(main
(noscript
(span
((class "noscript"))
(p "hey! yr not letting yr browser execute javascript served by my page.")
(p "that's cool!")
(p "(google?) browser as arbitrary code execution platform is one of the
weird, regrettable consequences of our political economy.")
(p "browser (by google?) as arbitrary code execution platform is one of the
weird, regrettable (at least as it is currently implemented)
consequences of our political economy.")
(p "anyway, feel free to browse! yr experience won't be much different,
you'll just get bigger html blob.")
(p "the only js i deliver is "
@ -14,17 +17,18 @@
(a ((href "/tagged/javascript"))
"what i have to say about javascript")
" you could do that maybe")
(p "/noscript"))
(p "/noscript")))
(p "hey! i'm sorrel.")
(p "(called like the plant up there)")
(p "this is my new-fangled website computer page on the world wide web. i had
a nice time building this little thing "
(span ((class "hx-target"))
(a ((href "/this")
(hx-get "/hx/this")
(hx-target "closest a")
(hx-target "closest span")
(hx-swap "inner HTML"))
"(how i build this little page.)"))
(p "i hope you have a nice time looking at things here.")
"(how i build this little page.)")))
(p " i hope you have a nice time looking at things here.")
(p ((class "ascii but-normal-size"))
"︿︿
〰"))

View file

@ -1,3 +1,3 @@
(main
(section
(h1 "404")
(p "hey, i couldn't find that. could ya try something else maybe?"))

2
source/unsettleds/1.txt Normal file
View file

@ -0,0 +1,2 @@
(body
"just a test")

94
static/styles.css Normal file
View file

@ -0,0 +1,94 @@
:root {
--foreground-color: lab(90 50 -80);
--background-color: lab(0 50 -30);
--link-color: lab(80 40 100);
--visited-link-color: lab(70 10 15);
--banner-ascii-color: lab(90 -40 20 / 0.8);
background-color: var(--background-color);
}
html {
padding: 20px;
color: var(--foreground-color);
}
h1, h2, h3, h4, h5 {
font-family: 'Courier New', Courier, monospace;
color: var(--background-color);
background-color: var(--visited-link-color);
padding: 2 10;
}
span.noscript p {
font-family: 'Courier New', Courier, monospace;
font-size: small;
}
span.hx-target section {
border: solid 1px var(--link-color);
border-radius: 4px;
padding: 0 10;
margin: 3;
}
a {
font-family: 'Courier New', Courier, monospace;
font-size: small;
color: var(--link-color);
}
a:visited {
color: var(--visited-link-color);
text-decoration-color: var(--link-color);
}
body {
max-width: 600;
margin: auto;
font-size: medium;
font-family: Verdana, ui-sans-serif;
}
header{
display: flex;
flex-direction: column;
}
@media screen and (max-width: 600px) {
div.banner p.ascii {
font-size: 5px;
}
body {
max-width: 375px;
}
}
@media screen and (min-width: 1000px) {
div.banner {
padding: 0 auto;
}
body {
max-width: 800px;
}
}
div.banner {
background-color: lab(0 5 1 / 0.8);
width: max-content;
margin: auto;
}
div.banner p.ascii {
color: var(--banner-ascii-color);
}
nav {
display: flex;
flex-direction: row;
padding: 5px;
}
nav a {
padding: 5px;
}