oxaliq/oxaliq.net
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

refactor dispatcher code and add style

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

111
sorrel.dev.rkt
View file

@ -1,9 +1,11 @@
#lang racket #lang racket
(require net/url (require racket/date
net/url
xml xml
web-server/web-server web-server/web-server
web-server/servlet-dispatch web-server/servlet-dispatch
web-server/dispatchers/dispatch
web-server/dispatch web-server/dispatch
(prefix-in files: web-server/dispatchers/dispatch-files) (prefix-in files: web-server/dispatchers/dispatch-files)
(prefix-in filter: web-server/dispatchers/dispatch-filter) (prefix-in filter: web-server/dispatchers/dispatch-filter)
@ -11,6 +13,7 @@
web-server/dispatchers/filesystem-map web-server/dispatchers/filesystem-map
web-server/http) web-server/http)
(define (html-response content) (define (html-response content)
(response/full (response/full
200 200
@ -21,43 +24,46 @@
(list content))) (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) (define (xexpr-file->xml file)
(string->bytes/utf-8 (string->bytes/utf-8
(xexpr->string (read (open-input-file file))))) (xexpr->string (read (open-input-file file)))))
;;; httpx (define (404-hx request)
;; 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)
(html-response (xexpr-file->xml "source/not-found.txt"))) (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) (define-values (httpx-app reverse-httpx-uri)
(dispatch-rules (dispatch-rules
[("hx" "about") about] [("hx" "about") (respond-resource-with-processor "about" xexpr-file->xml)]
[("hx" "home") home] [("hx" "home") (respond-resource-with-processor "index" xexpr-file->xml)]
[("hx" "structures" (integer-arg)) structures] [("hx" "settleds" (integer-arg)) (respond-resource-with-processor "settleds" xexpr-file->xml)]
[("hx" "structures") index-structures] [("hx" "settleds") (respond-resource-with-processor "settleds" xexpr-file->xml)]
[("hx" "unstructures" (integer-arg)) unstructures] [("hx" "unsettleds" (integer-arg)) (respond-resource-with-processor "unsettleds" xexpr-file->xml)]
[("hx" "unstructures") index-unstructures] [("hx" "unsettleds") (respond-resource-with-processor "unsettleds" xexpr-file->xml)]
[else 404-])) [("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 ;;; page-app
;; constructs entire page for each response ;; constructs entire page for each response
@ -70,15 +76,19 @@
,(read (open-input-file "source/header.txt")) ,(read (open-input-file "source/header.txt"))
,(read (open-input-file resource))))))) ,(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) (define-values (page-app reverse-page-uri)
(dispatch-rules (dispatch-rules
[("") homepage] [("") (respond-resource-with-processor "index" make-page)]
[("about") about-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 ;;; from /static
@ -89,6 +99,36 @@
(url->path/static (url->path/static
(struct-copy url u [path (cdr (url-path u))]))))) (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 ;;; 404
(define (not-found request) (define (not-found request)
@ -101,6 +141,7 @@
#:dispatch (sequencer:make #:dispatch (sequencer:make
(filter:make #rx"^/static/" static-dispatcher) (filter:make #rx"^/static/" static-dispatcher)
(dispatch/servlet #:regexp #rx"^/hx/" httpx-app) (dispatch/servlet #:regexp #rx"^/hx/" httpx-app)
(dispatch/servlet #:regexp #rx"^/feed.atom" rss-feed)
(dispatch/servlet page-app) (dispatch/servlet page-app)
(dispatch/servlet not-found) (dispatch/servlet not-found)
) )

50
source/about.txt
View file

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

24
source/header.txt
View file

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

44
source/index.txt
View file

@ -1,30 +1,34 @@
(main (main
(noscript (noscript
(p "hey! yr not letting yr browser execute javascript served by my page.") (span
(p "that's cool!") ((class "noscript"))
(p "(google?) browser as arbitrary code execution platform is one of the (p "hey! yr not letting yr browser execute javascript served by my page.")
weird, regrettable consequences of our political economy.") (p "that's cool!")
(p "anyway, feel free to browse! yr experience won't be much different, (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.") you'll just get bigger html blob.")
(p "the only js i deliver is " (p "the only js i deliver is "
(a ((href "https://htmx.org")) (a ((href "https://htmx.org"))
"this little REST tool called htmx") "this little REST tool called htmx")
" if you want to see what that's about.") " if you want to see what that's about.")
(p "o! and if you want to hear/read " (p "o! and if you want to hear/read "
(a ((href "/tagged/javascript")) (a ((href "/tagged/javascript"))
"what i have to say about javascript") "what i have to say about javascript")
" you could do that maybe") " you could do that maybe")
(p "/noscript")) (p "/noscript")))
(p "hey! i'm sorrel.") (p "hey! i'm sorrel.")
(p "(called like the plant up there)") (p "(called like the plant up there)")
(p "this is my new-fangled website computer page on the world wide web. i had (p "this is my new-fangled website computer page on the world wide web. i had
a nice time building this little thing " a nice time building this little thing "
(a ((href "/this") (span ((class "hx-target"))
(hx-get "/hx/this") (a ((href "/this")
(hx-target "closest a") (hx-get "/hx/this")
(hx-swap "inner HTML")) (hx-target "closest span")
"(how i build this little page.)")) (hx-swap "inner HTML"))
(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")) (p ((class "ascii but-normal-size"))
"︿︿ "︿︿
〰")) 〰"))

2
source/not-found.txt
View file

@ -1,3 +1,3 @@
(main (section
(h1 "404") (h1 "404")
(p "hey, i couldn't find that. could ya try something else maybe?")) (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;
}