refactor dispatcher code and add style

stubbed rss/atom feed, applied consistent hx-target for in-place fragments

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
+(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")))
 
-(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" "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
 ;; 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]
+   [("") (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
@@ -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)
                )

source/about.txt

@@ -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.")
+              "i make languages (the human kind) for fun."))
-          "there's a whole bunch of people who do this! "
+          " 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?"
+           sex act? "
-          (small "a " (em "niche") " joke about having"
+          (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"))

source/atom.txt

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

source/header.txt

@@ -1,14 +1,14 @@
 (header
  (div
-  ((class "banner"))
+  ((class "banner")
-  (a
-   ((href "/")
    (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")
+   ((href "/unsettleds")
-    (hx-get "/hx/unsettled")
+    (hx-get "/hx/unsettleds")
     (hx-target "main")
     (hx-swap "innerHTML"))
    "unsettled thoughts (something like a blog)")
   (a
-   ((href "/settled")
+   ((href "/settleds")
-    (hx-get "/hx/settled")
+    (hx-get "/hx/settleds")
     (hx-target "main")
     (hx-swap "innerHTML"))
    "\"settled\" thoughts (projects built/in progress)")))

source/index.txt

@@ -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
+   (p "browser (by google?) as arbitrary code execution platform is one of the
-      weird, regrettable consequences of our political economy.")
+      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.)"))
+             "(how i build this little page.)")))
- (p "i hope you have  a nice time looking at things here.")
+ (p " i hope you have  a nice time looking at things here.")
  (p ((class "ascii but-normal-size"))
 "︿︿
  〰"))

source/not-found.txt

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

source/unsettleds/1.txt

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

static/styles.css

@@ -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;
+}
+