add navigation system

This commit is contained in:
Adam Jeniski 2025-07-18 17:45:18 -09:00
parent 8a3f9fee9a
commit 2f04ea6d49
2 changed files with 103 additions and 47 deletions

View File

@ -1,14 +1,10 @@
<!-- This is auto-generated by Datastar. DO NOT EDIT. -->
<!DOCTYPE html>
<html lang="en">
<head>
<title>hello world d*</title>
<script src="https://unpkg.com/@tailwindcss/browser@4"></script>
<script type="module" src="https://cdn.jsdelivr.net/gh/starfederation/datastar@main/bundles/datastar.js"></script>
<!-- put css here -->
</head>
<body style="outline: solid; 1px; red">
<body>
%%content%%
</body>
</html>

View File

@ -12,7 +12,12 @@
[starfederation.datastar.clojure.adapter.ring :refer [->sse-response on-open on-close] :as dr]
[clojure.data.json :as json]))
(declare conns) ;; for broadcasts
(declare conns add-elements! sse-navigate!)
;; global utils
(defn tap! [x]
(println "tap:" x)
x)
;; html utils
(defn html->str [hiccup-forms]
@ -20,32 +25,61 @@
(hc/compile
hiccup-forms)))
(defn page-template [content]
(defn html-template [content]
(-> (io/resource "public/index.html")
slurp
(string/split-lines)
(->> (drop 3)
(apply str))
(str "<div data-on-load=\"@get('connect')\"></div>")
(string/replace "%%content%%" content)))
;; fix. use replaceState api? or push some real state? back button doesn't work yet
(defn update-url-frag [url]
(html->str [:script (format "history.pushState({page:1}, 'Title', '%s')"
url)]))
;; home page
(def home-frag
(defn sse-page [request respond view url]
(respond
(->sse-response request
{on-open
(fn [sse]
(d*/with-open-sse sse
(sse-navigate! sse (view {}))
(add-elements! sse (update-url-frag url))))})))
(defn text-html-page [request respond view]
(-> (html-template (view {}))
ruresp/response
(ruresp/content-type "text/html")
respond))
(defn page [request respond url view]
(if (-> request
:headers
(get "datastar-request")
(= "true"))
(sse-page request respond view url)
(text-html-page request respond view)
))
;; views
(def home-view
(fn [_]
(html->str
[:main {:id "main"
:data-on-load "@get('/connect')"}
[:main
[:div
[:input {:data-bind "msg"}]
[:div {:data-text "$msg"}]
[:button {:data-on-click "@get('/hello-world')"} "click for text animation"]]))
[:button {:data-on-click "@get('/hello-world')"} "click for text animation"]]
[:button {:data-on-click "@get('/page2')"} "go to page 2"]])))
(def home-page
(page-template home-frag))
(defn home [request respond _]
(respond
(-> home-page
ruresp/response
(ruresp/content-type "text/html"))))
(defn page2-view [_]
(html->str
[:main
[:p "this is page2"]
[:button {:data-on-click "@get('/')"} "go back to home"]]))
;; d* api utils
@ -55,11 +89,15 @@
(defn add-elements! [sse elems]
(d*/patch-elements! sse elems #:d*.elements{:patch-mode "append"
:selector "body"}))
(defn sse-navigate! [sse elems]
(d*/patch-elements! sse elems #:d*.elements{:patch-mode "replace"
:selector "main"}))
(defn try!
[d*-f! sse & args]
(try (apply d*-f! sse args)
(catch Exception _
(println "exception occured. dropping connection")
(catch Exception e
(println "exception occured. dropping connection. error:" e)
(d*/close-sse! sse)
(swap! conns disj sse))))
@ -75,6 +113,14 @@
(doseq [conn @conns]
(apply try! f conn arg args))))
(defn connect-sse! [sse]
(swap! conns conj sse)
(println "adding connection"))
(defn disconnect-sse! [sse]
(swap! conns disj sse)
(println "dropping connection"))
(defn broadcast-signals! [data]
(broadcast! patch-signals-edn! data))
@ -89,16 +135,16 @@
(try! d*/close-sse! conn)
(swap! conns disj conn)))
(defn connect [request respond _raise]
(defn defaction-async [url on-open-f on-close-f]
(let [sse-handler
(fn [request respond raise_]
(respond
(->sse-response request
{on-open
(fn [sse] (swap! conns conj sse)
(println "adding connection"))
on-close
(fn [sse]
(swap! conns disj sse)
(println "dropping connection"))})))
(->sse-response
request
{on-open on-open-f
on-close on-close-f})))]
[[url sse-handler]
[(str "/sse" url) sse-handler]]))
;; hello world animation
@ -106,22 +152,36 @@
(def msg-count (count message))
(defn hello-world [request respond _raise]
(respond
(->sse-response request
{on-open
(fn [sse]
(d*/with-open-sse sse
(defn hello-world [sse]
(dotimes [i msg-count]
(patch-signals-edn! sse {:msg (subs message 0 (inc i))})
(Thread/sleep 500))))})))
(Thread/sleep 500)))
;; http stuffs
(defn defaction [url f]
(let [sse-handler
(fn [request respond raise_]
(respond
(->sse-response
request
{on-open #(d*/with-open-sse % (f %))})))]
[[url sse-handler]
[(str "/sse" url) sse-handler]]))
(defn defpage [endpoint view]
[[endpoint
{:handler (fn [request respond _]
(page request respond endpoint view))}]
[(str "/sse" endpoint)
{:handler (fn [request respond _]
(page request respond endpoint view))}]])
(def routes
[["/" {:handler home}]
["/connect" {:handler connect}]
["/hello-world" {:handler hello-world}]])
(concat
(defpage "/" home-view)
(defpage "/page2" page2-view)
(defaction "/hello-world" hello-world)
(defaction-async "/connect" connect-sse! disconnect-sse!)))
(def router (rr/router routes))