refactor make-index out of sorrel.dev.rkt
includes stubbed index source files, so that dispatcher has something to serve
This commit is contained in:
parent
773621f610
commit
2b5c103555
4 changed files with 45 additions and 44 deletions
|
@ -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
|
||||
|
@ -36,32 +38,41 @@
|
|||
;; 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
|
||||
(if (and (non-empty-string? type) (not (eq? type "root")))
|
||||
(build-path "source" type "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
|
||||
;; 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
|
||||
(build-path
|
||||
"source"
|
||||
(if (eq? type "root")
|
||||
(if (and (non-empty-string? t) (not (eq? t "root")))
|
||||
(build-path "source" t "index")
|
||||
(build-path "source" "index" ))
|
||||
#".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 "type/" id will be an empty string
|
||||
(or (not (string? id)) (non-empty-string? id))
|
||||
(build-path type (~a id))
|
||||
;; if url has trailing backslash, id will be an empty string
|
||||
;; and should return index for that type
|
||||
(build-path type "index"))))
|
||||
#".txt")])
|
||||
(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"))))])))
|
||||
|
@ -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)]
|
||||
|
|
1
source/settled/index.txt
Normal file
1
source/settled/index.txt
Normal 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
1
source/tagged/index.txt
Normal 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
1
source/unsettled/index.txt
Normal 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"))
|
Loading…
Reference in a new issue