refactor dispatcher code and add style
stubbed rss/atom feed, applied consistent hx-target for in-place fragments
This commit is contained in:
parent
c1ee729671
commit
92f20f47a0
8 changed files with 265 additions and 90 deletions
111
sorrel.dev.rkt
111
sorrel.dev.rkt
|
@ -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)
|
||||
)
|
||||
|
|
|
@ -37,33 +37,39 @@
|
|||
;; about me bullets
|
||||
(ul
|
||||
;; language bullet
|
||||
(li (p "i like linguistics a whole lot."
|
||||
(a ((href "/tagged/conlang")
|
||||
(hx-get "/hx/tagged/conlang")
|
||||
(hx-target "nearest a")
|
||||
; 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! "
|
||||
(li (p "i like linguistics a whole lot. "
|
||||
(span
|
||||
((class "hx-target"))
|
||||
(a ((href "/tagged/conlang")
|
||||
(hx-get "/hx/tagged/conlang")
|
||||
(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! "
|
||||
(a ((href "https://conlang.org/"))
|
||||
"language creation society")
|
||||
"the language creation society")
|
||||
" i'm even working on a "
|
||||
(a ((href "/tagged/latl")
|
||||
(hx-get "/hx/tagged/latl")
|
||||
(hx-target "nearest a")
|
||||
(hx-swap "innerHTML"))
|
||||
"language (computer) to make languages (human).")))
|
||||
(span
|
||||
((class "hx-target"))
|
||||
(a ((href "/tagged/latl")
|
||||
(hx-get "/hx/tagged/latl")
|
||||
(hx-target "closest span.hx-target")
|
||||
(hx-swap "innerHTML"))
|
||||
"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"
|
||||
(a ((href "/tagged/brain")
|
||||
(hx-get "/hx/tagged/brain")
|
||||
(hx-target "nearest a")
|
||||
(hx-swap "innerHTML"))
|
||||
"a ~type~ of experience"))))
|
||||
sex act? "
|
||||
(span
|
||||
((class "hx-target"))
|
||||
(small "a " (em "niche") " joke about having "
|
||||
(a ((href "/tagged/brain")
|
||||
(hx-get "/hx/tagged/brain")
|
||||
(hx-target "closest span.hx-target")
|
||||
(hx-swap "innerHTML"))
|
||||
"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
28
source/atom.txt
Normal 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))
|
||||
)
|
|
@ -1,14 +1,14 @@
|
|||
(header
|
||||
(div
|
||||
((class "banner"))
|
||||
(a
|
||||
((href "/")
|
||||
(hx-get "/hx/home")
|
||||
(hx-target "main")
|
||||
(hx-swap "outerHTML"))
|
||||
((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)")))
|
||||
|
|
|
@ -1,30 +1,34 @@
|
|||
(main
|
||||
(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 "anyway, feel free to browse! yr experience won't be much different,
|
||||
(span
|
||||
((class "noscript"))
|
||||
(p "hey! yr not letting yr browser execute javascript served by my page.")
|
||||
(p "that's cool!")
|
||||
(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 "
|
||||
(a ((href "https://htmx.org"))
|
||||
"this little REST tool called htmx")
|
||||
" if you want to see what that's about.")
|
||||
(p "o! and if you want to hear/read "
|
||||
(a ((href "/tagged/javascript"))
|
||||
"what i have to say about javascript")
|
||||
" you could do that maybe")
|
||||
(p "/noscript"))
|
||||
(p "the only js i deliver is "
|
||||
(a ((href "https://htmx.org"))
|
||||
"this little REST tool called htmx")
|
||||
" if you want to see what that's about.")
|
||||
(p "o! and if you want to hear/read "
|
||||
(a ((href "/tagged/javascript"))
|
||||
"what i have to say about javascript")
|
||||
" you could do that maybe")
|
||||
(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 "
|
||||
(a ((href "/this")
|
||||
(hx-get "/hx/this")
|
||||
(hx-target "closest a")
|
||||
(hx-swap "inner HTML"))
|
||||
"(how i build this little page.)"))
|
||||
(p "i hope you have a nice time looking at things here.")
|
||||
(span ((class "hx-target"))
|
||||
(a ((href "/this")
|
||||
(hx-get "/hx/this")
|
||||
(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.")
|
||||
(p ((class "ascii but-normal-size"))
|
||||
"︿︿
|
||||
〰"))
|
||||
|
|
|
@ -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
2
source/unsettleds/1.txt
Normal file
|
@ -0,0 +1,2 @@
|
|||
(body
|
||||
"just a test")
|
94
static/styles.css
Normal file
94
static/styles.css
Normal 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;
|
||||
}
|
||||
|
Loading…
Reference in a new issue