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

refactor make-index out of sorrel.dev.rkt

Browse source 
includes stubbed index source files, so that dispatcher has something to serve
This commit is contained in:
sorrel 2023-12-15 11:10:18 -05:00
parent 773621f610
commit 2b5c103555
4 changed files with 45 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

86
sorrel.dev.rkt
View file

@ -17,9 +17,11 @@
web-server/http web-server/http
csv-reading) csv-reading)
;; namespace needed for evaluating read files
(define-namespace-anchor anc) (define-namespace-anchor anc)
(define ns (namespace-anchor->namespace anc)) (define ns (namespace-anchor->namespace anc))
;; it's all html!
(define (html-response content) (define (html-response content)
(response/full (response/full
200 200
@ -34,37 +36,46 @@
;; an index resource in the source path) ;; an index resource in the source path)
;; and a resource-processor (-> file-handle . http-response) ;; and a resource-processor (-> file-handle . http-response)
;; and returns a valid html-response irrespective of hx/ type fragment of html or full page ;; 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) (lambda (type resource-processor)
(case-lambda ;; bound path builders
[(req) (let ([res-path (path-add-extension ;; extension is always #".txt" because source files are not well-formed racket,
(if (and (non-empty-string? type) (not (eq? type "root"))) ;; but must be read and evaluated in this namespace
(build-path "source" type "index") (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" )) (build-path "source" "index" ))
#".txt")]) #".txt"))
(if (file-exists? res-path)
(html-response (resource-processor res-path)) (define (make-res-path-id-param t id)
(html-response (resource-processor "source/not-found.txt"))))] (path-add-extension
[(req id) (let ([res-path (build-path "source" (if (eq? t "root")
(path-add-extension (if (eq? id "")
(build-path ;; if "root/" something weird has happened
"source" "index"
(if (eq? type "root") ;; allows for loading "/this" and other root resources
(if (eq? id "") (~a id))
;; if "root/" something weird has happened (if
"index" ;; if url has trailing backslash, id will be an empty string
;; allows for loading "/this" and other root resources ;; and should return index for that type
(~a id)) (or (not (string? id))
(if (non-empty-string? id))
;; if "type/" id will be an empty string (build-path t (~a id))
(or (not (string? id)) (non-empty-string? id)) (build-path t "index"))))
(build-path type (~a id)) #".txt"))
;; and should return index for that type ;; this lambda will be called by dispatch-rules
(build-path type "index")))) ;; (req) is the request object
#".txt")]) (case-lambda
(if (file-exists? res-path) [(req) (let ([res-path (make-res-path-no-param type)])
(html-response (resource-processor res-path)) (if (file-exists? res-path)
(html-response (resource-processor "source/not-found.txt"))))]))) (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 ;;; httpx
;; sends only the requested resource ;; sends only the requested resource
@ -72,19 +83,6 @@
(string->bytes/utf-8 (string->bytes/utf-8
(xexpr->string (read (open-input-file file))))) (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) (define (404-hx request)
(html-response (xexpr-file->xml "source/not-found.txt"))) (html-response (xexpr-file->xml "source/not-found.txt")))
@ -93,9 +91,9 @@
(define-values (httpx-app reverse-httpx-uri) (define-values (httpx-app reverse-httpx-uri)
(dispatch-rules (dispatch-rules
[("hx" "home") (respond-resource-with-processor "root" xexpr-file->xml)] [("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" "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" "unsettled" (integer-arg)) (respond-resource-with-processor "unsettled" xexpr-file->xml)]
[("hx" "tagged") (respond-resource-with-processor "tagged" 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)] [("hx" "tagged" (string-arg)) (respond-resource-with-processor "tagged" xexpr-file->xml)]

1
source/settled/index.txt Normal file
View file

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

1
source/tagged/index.txt Normal file
View file

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

1
source/unsettled/index.txt Normal file
View file

@ -0,0 +1 @@
'(article (hgroup (h1 "unsettled thoughts") (p (em "just doing some thinking aloud"))) (h3 "the thoughts") (p "there's nothing here yet"))