155 lines
4.2 KiB
Clojure
155 lines
4.2 KiB
Clojure
(ns example.utils
|
|
(:require
|
|
[clojure.java.io :as io]
|
|
[clojure.string :as string]
|
|
[dev.onionpancakes.chassis.compiler :as hc]
|
|
[dev.onionpancakes.chassis.core :as h]
|
|
[reitit.ring.middleware.parameters :as rmparams]
|
|
[reitit.ring :as rr]
|
|
[ring.util.response :as ruresp]
|
|
[starfederation.datastar.clojure.api :as d*]
|
|
[starfederation.datastar.clojure.adapter.ring :refer [->sse-response on-open on-close] :as dr]
|
|
[clojure.data.json :as json]))
|
|
|
|
(declare conns add-elements! sse-navigate!)
|
|
|
|
;; global utils
|
|
(defn tap! [x]
|
|
(println "tap:" x)
|
|
x)
|
|
|
|
;; html utils
|
|
(defn html->str [hiccup-forms]
|
|
(h/html
|
|
(hc/compile
|
|
hiccup-forms)))
|
|
|
|
(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)))
|
|
|
|
(defn at-get [page-or-action]
|
|
(format "@get('%s')" (:url page-or-action)))
|
|
|
|
;; 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)]))
|
|
|
|
(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)))
|
|
|
|
;; d* api utils
|
|
(defn patch-signals-edn! [sse edn]
|
|
(d*/patch-signals! sse (json/write-str edn)))
|
|
|
|
(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"}))
|
|
|
|
;; broadcast utils
|
|
(defn try!
|
|
[d*-f! sse & args]
|
|
(try (when (not (apply d*-f! sse args))
|
|
(disconnect-sse! sse))
|
|
(catch Exception e
|
|
(println "exception occured. dropping connection. error:" e)
|
|
(disconnect-sse! sse))))
|
|
|
|
(defonce conns (atom #{}))
|
|
|
|
(defn broadcast!
|
|
([f]
|
|
(doseq [conn @conns]
|
|
(try! f conn)))
|
|
([f arg & args]
|
|
(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))
|
|
|
|
(defn broadcast-js! [js-src]
|
|
(broadcast! add-elements! (html->str [:script js-src])))
|
|
|
|
(defn broadcast-reload! []
|
|
(broadcast-js! "location.reload()"))
|
|
|
|
(defn kill-broadcast! []
|
|
(doseq [conn @conns]
|
|
(try! d*/close-sse! conn)
|
|
(swap! conns disj conn)))
|
|
|
|
;; http stuffs
|
|
(defn defpage
|
|
([page]
|
|
(defpage (:url page) (:view page)))
|
|
([endpoint view]
|
|
[[endpoint
|
|
{:handler (fn [request respond _]
|
|
(page request respond endpoint view))}]
|
|
[(str "/sse" endpoint)
|
|
{:handler (fn [request respond _]
|
|
(page request respond endpoint view))}]]))
|
|
|
|
(defn defaction
|
|
([action]
|
|
(defaction (:url action) (:fn action)))
|
|
([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 defaction-async [url on-open-f on-close-f]
|
|
(let [sse-handler
|
|
(fn [request respond raise_]
|
|
(respond
|
|
(->sse-response
|
|
request
|
|
{on-open on-open-f
|
|
on-close on-close-f})))]
|
|
[[url sse-handler]
|
|
[(str "/sse" url) sse-handler]]))
|
|
|