commit 981178a6d8912ac82e693260550d323f1e0aa190 parent 81550d90fb85a5a5b88b7ba0f08bf9a668c4900d Author: Daniel Barlow <dan@telent.net> Date: Mon, 28 Jul 2025 22:30:02 +0100 rewrite dispatch and add support for topic pages, which this makes a lot easier Diffstat:
| M | main.fnl | | | 201 | ++++++++++++++++++++++++++++++++++++++++++++++--------------------------------- |
1 file changed, 116 insertions(+), 85 deletions(-)
diff --git a/main.fnl b/main.fnl @@ -12,82 +12,56 @@ (local post-index (site.for-pathname "data/blogs/telent.blog/posts/")) -(local handlers - [ - #(if (= $2 "/") - { - :command :search - :format :posts - :filter nil - :order {:date :descending} - :offset 0 - :limit 5 - }) - - #(case (string.match $2 "(/static/%g+)" 1) - pathname - (case (post-index:static-file pathname) - path - { - :command :sendfile - :pathname path - })) - - #(case (string.match $2 "/(%d+)/(%d+)/([%w_]+)" 1) - (year month slug) { :command :show : slug }) - - #(case (string.match $2 "/(%d+)/(%d+)/" 1) - (year month) - (let [after (os.time {: year : month :day -2 }) - before (os.time {: year :month (+ month 1) :day 2 })] - { - :command :search - :format :posts - :filter {:older before :newer after} - :order {:date :ascending} - :offset 0 - })) - - #(case (string.match $2 "/([%w_]+)$" 1) - slug { :command :show : slug }) - - ]) - -(fn route-request [method path] +(fn route-request [method path handlers] (accumulate [matched nil _ pred (ipairs handlers) &until matched] (pred method path))) +(local handlers + [ + #(if (= $2 "/") [ :home { :limit 5 } ]) + #(case (string.match $2 "^/(%d+)/(%d+)/") + (year month) + [ :month { :year (tonumber year) :month (tonumber month) } ] + foo (print :fo foo) + ) + #(case (string.match $2 "^(/static/%g+)") + path + [ :static { : path } ]) + + #(case (string.match $2 "^/topic/([%w_]+)$") + slug [ :topic { : slug }]) + + #(case (string.match $2 "^/([%w_]+)$") + slug [ :show { : slug }]) + +]) + (define-tests :route-request - (expect= (route-request :get "/") - { - :command :search - :format :posts - :filter nil - :order {:date :descending} - :offset 0 - :limit 5 - }) - - (expect= (route-request :get "/pagename") - { - :command :show - :slug "pagename" - }) - - (expect= (route-request :get "/2004/7/") - { - :command :search - :format :posts - :filter {:newer 1088420400 :older 1091444400} - :order {:date :ascending} - :offset 0 - }) + (expect= (route-request :get "/" handlers) + [:home {:limit 5}]) + (expect= (route-request :get "/pagename" handlers) + [ :show { :slug "pagename" } ]) + (expect= (route-request :get "/2004/7/" handlers) + [ :month {:year 2004 :month 7 } ]) + + (expect= (route-request :get "/static/cripslock.png" handlers) + [ :static {:path "/static/cripslock.png" } ]) + + (expect= (route-request :get "/static/README" handlers) + [ :static {:path "/static/README" } ]) + + (expect= (route-request :get "/foo/static/README" handlers) nil) + (expect= (route-request :get "foo/static/README" handlers) nil) + + (expect= (route-request :get "/topic/cripslock" handlers) + [ :topic {:slug "cripslock" } ]) ) + (fn content-type-for-path [pathname] (if (string.match pathname "%.css$") "text/css" @@ -231,39 +205,96 @@ in the Fediverse at <a href=\"https://axillae.telent.net/\">@dan@axillae.telent. (each [_ p (ipairs results)] (send-post p stream (= format :excerpts)))))) -(fn search-posts [route stream] +(fn send-home-page [stream] (server.headers stream { }) (page-header stream "Recently") - (send-search-results stream route.format (post-index:search route)) + (let [posts + (post-index:search + { + :filter nil + :order {:date :descending} + :offset 0 + :limit 5 + })] + (send-search-results stream :posts posts)) (sidebar post-index stream) (page-footer stream) (stream:write_chunk "" true )) +(fn send-month-page [stream year month] + (server.headers stream { }) + (let [h1 (string.format "%s %d" (month-name month) year) + after (os.time {: year : month :day -2 }) + before (os.time {: year :month (+ month 1) :day 2 }) + params { + :filter {:older before :newer after} + :order {:date :ascending} + :offset 0 + } + posts (post-index:search params)] + (page-header stream h1) + (send-search-results stream :posts posts) + (sidebar post-index stream) + (page-footer stream) + (stream:write_chunk "" true ))) + +(fn send-post-page [stream slug] + (let [post (post-index:get slug) + path (. post :full-path)] + (server.headers stream { }) + (page-header stream post.title) + (send-post post stream) + (sidebar post-index stream) + (page-footer stream) + (stream:write_chunk "" true))) + +(fn send-topic-page [stream slug] + (let [post (post-index:get slug) + results (post-index:search {:filter {:topic slug}}) + s { :write #(stream:write_chunk $2) }] + (print (view results)) + (server.headers stream { }) + (page-header stream (.. "Topic: " slug)) + (if post + (send-post post stream) + (to-html [:h1 slug] s)) + + (to-html + [:div + [:h2 "In this topic"] + (prepend :ul + (icollect [_ p (ipairs results)] + [:li [[:a { :href p.url-path}] p.title]]))] + s) + (sidebar post-index stream) + (page-footer stream) + (stream:write_chunk "" true))) (fn dispatch [route stream] - (case route.command - :show - (let [post (post-index:get route.slug) - path (. post :full-path)] - (server.headers stream { }) - (page-header stream post.title) - (send-post post stream) - (sidebar post-index stream) - (page-footer stream) - (stream:write_chunk "" true)) - :sendfile - (with-open [f (io.open route.pathname :r)] - (server.headers stream { :content-type (content-type-for-path route.pathname) }) - (stream:write_body_from_file f)) - :search - (search-posts route stream) + (print (view route)) + (case route + [:show { : slug }] + (send-post-page stream slug) + [:month { : month : year }] + (send-month-page stream year month) + [:static { : path }] + (let [realpath (post-index:static-file path)] + (with-open [f (io.open realpath :r)] + (server.headers stream + { :content-type (content-type-for-path realpath) }) + (stream:write_body_from_file f))) + [:home { : limit }] + (send-home-page stream) + [:topic { : slug }] + (send-topic-page stream slug) + )) (fn http-handler [_ stream] (let [req-headers (assert (stream:get_headers)) path (req-headers:get ":path") method (req-headers:get ":method") - route (route-request method path)] + route (route-request method path handlers)] (server.log-request req-headers stream) (if route (dispatch route stream)