diff --git a/sorrel.dev.rkt b/sorrel.dev.rkt index 13566bb..843f615 100644 --- a/sorrel.dev.rkt +++ b/sorrel.dev.rkt @@ -17,9 +17,11 @@ web-server/http csv-reading) +;; namespace needed for evaluating read files (define-namespace-anchor anc) (define ns (namespace-anchor->namespace anc)) +;; it's all html! (define (html-response content) (response/full 200 @@ -34,37 +36,46 @@ ;; 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 +(define respond-resource-with-processor (lambda (type resource-processor) - (case-lambda - [(req) (let ([res-path (path-add-extension - (if (and (non-empty-string? type) (not (eq? type "root"))) - (build-path "source" type "index") + ;; bound path builders + ;; extension is always #".txt" because source files are not well-formed racket, + ;; but must be read and evaluated in this namespace + (define (make-res-path-no-param t) + (path-add-extension + (if (and (non-empty-string? t) (not (eq? t "root"))) + (build-path "source" t "index") (build-path "source" "index" )) - #".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" - (if (eq? type "root") - (if (eq? id "") - ;; if "root/" something weird has happened - "index" - ;; allows for loading "/this" and other root resources - (~a id)) - (if - ;; if "type/" id will be an empty string - (or (not (string? id)) (non-empty-string? id)) - (build-path type (~a id)) - ;; and should return index for that type - (build-path type "index")))) - #".txt")]) - (if (file-exists? res-path) - (html-response (resource-processor res-path)) - (html-response (resource-processor "source/not-found.txt"))))]))) + #".txt")) + + (define (make-res-path-id-param t id) + (path-add-extension + (build-path "source" (if (eq? t "root") + (if (eq? id "") + ;; if "root/" something weird has happened + "index" + ;; allows for loading "/this" and other root resources + (~a id)) + (if + ;; if url has trailing backslash, id will be an empty string + ;; and should return index for that type + (or (not (string? id)) + (non-empty-string? id)) + (build-path t (~a id)) + (build-path t "index")))) + #".txt")) + ;; this lambda will be called by dispatch-rules + ;; (req) is the request object + (case-lambda + [(req) (let ([res-path (make-res-path-no-param type)]) + (if (file-exists? res-path) + (html-response (resource-processor res-path)) + (html-response (resource-processor "source/not-found.txt"))))] + ;; (req id) is (request object . url parameter) + [(req id) (let ([res-path (make-res-path-id-param type id)]) + (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 @@ -72,19 +83,6 @@ (string->bytes/utf-8 (xexpr->string (read (open-input-file file))))) -(define (build-index res) - (let* ([table (csv->list (open-input-file - (path-add-extension - (build-path "data" res) #".csv")))] - [make-index - (read (open-input-file "source/make-index.txt"))] - [index ((eval make-index ns) res (rest table))]) - (lambda (req) - (if (equal? res "tagged") - '() - (html-response - (string->bytes/utf-8 - (xexpr->string index))))))) (define (404-hx request) (html-response (xexpr-file->xml "source/not-found.txt"))) @@ -93,9 +91,9 @@ (define-values (httpx-app reverse-httpx-uri) (dispatch-rules [("hx" "home") (respond-resource-with-processor "root" xexpr-file->xml)] - [("hx" "settled") (build-index "settled")] + [("hx" "settled") (respond-resource-with-processor "settled" xexpr-file->xml)] [("hx" "settled" (integer-arg)) (respond-resource-with-processor "settled" xexpr-file->xml)] - [("hx" "unsettled") (build-index "unsettled")] + [("hx" "unsettled") (respond-resource-with-processor "unsettled" xexpr-file->xml)] [("hx" "unsettled" (integer-arg)) (respond-resource-with-processor "unsettled" xexpr-file->xml)] [("hx" "tagged") (respond-resource-with-processor "tagged" xexpr-file->xml)] [("hx" "tagged" (string-arg)) (respond-resource-with-processor "tagged" xexpr-file->xml)] diff --git a/source/settled/index.txt b/source/settled/index.txt new file mode 100644 index 0000000..8e1ef4d --- /dev/null +++ b/source/settled/index.txt @@ -0,0 +1 @@ +'(article (hgroup (h1 "settled* thoughts") (p (em "*-ish, something like a portfolio of projects"))) (h3 "the thoughts") (p "there's nothing here yet")) \ No newline at end of file diff --git a/source/tagged/index.txt b/source/tagged/index.txt new file mode 100644 index 0000000..5588556 --- /dev/null +++ b/source/tagged/index.txt @@ -0,0 +1 @@ +'(article (hgroup (h1 "all the tags") (p (em "a categorical mess for your perusal"))) (h3 "the thoughts") (p "there's nothing here yet"))'(article (hgroup (h1 "all the tags") (p (em "a categorical mess for your perusal"))) (h3 "the thoughts") (p "there's nothing here yet"))'(article (hgroup (h1 "all the tags") (p (em "a categorical mess for your perusal"))) (h3 "the thoughts") (p "there's nothing here yet")) \ No newline at end of file diff --git a/source/unsettled/index.txt b/source/unsettled/index.txt new file mode 100644 index 0000000..de1dd95 --- /dev/null +++ b/source/unsettled/index.txt @@ -0,0 +1 @@ +'(article (hgroup (h1 "unsettled thoughts") (p (em "just doing some thinking aloud"))) (h3 "the thoughts") (p "there's nothing here yet")) \ No newline at end of file