Scope transit read and write handlers to pod ids

This commit is contained in:
Michiel Borkent 2021-05-19 17:20:55 +02:00
parent 1fdd8231bd
commit 05ecf97127
8 changed files with 52 additions and 38 deletions

View file

@ -18,5 +18,5 @@
{lambdaisland/kaocha {:mvn/version "1.0.632"}}
:main-opts ["-m" "kaocha.runner"]}
:test-pod
{:paths ["src" "test-pod"]
{:extra-paths ["src" "test-pod"]
:main-opts ["-m" "pod.test-pod"]}}}

View file

@ -15,8 +15,8 @@
([pod-id-or-pod sym args] (invoke pod-id-or-pod sym args {}))
([pod-id-or-pod sym args opts] (jvm/invoke pod-id-or-pod sym args opts)))
(defn add-transit-read-handler [tag fn]
(jvm/add-transit-read-handler tag fn))
(defn add-transit-read-handler [pod-id tag fn]
(jvm/add-transit-read-handler pod-id tag fn))
(defn add-transit-write-handler [tag fn classes]
(jvm/add-transit-write-handler tag fn classes))
(defn add-transit-write-handler [pod-id tag fn classes]
(jvm/add-transit-write-handler pod-id tag fn classes))

View file

@ -40,28 +40,43 @@
(str (java.util.UUID/randomUUID)))
(defonce transit-read-handlers (atom {}))
(defonce transit-read-handler-maps (atom {}))
(defn transit-json-read [^String s]
(defn update-transit-read-handler-map [pod-id]
(swap! transit-read-handler-maps assoc pod-id
(transit/read-handler-map (get @transit-read-handlers pod-id))))
(defn transit-json-read [pod-id ^String s]
(with-open [bais (java.io.ByteArrayInputStream. (.getBytes s "UTF-8"))]
(let [r (transit/reader bais :json {:handlers @transit-read-handlers})]
(let [r (transit/reader bais :json {:handlers (get @transit-read-handler-maps pod-id)})]
(transit/read r))))
;; https://www.cognitect.com/blog/2015/9/10/extending-transit
(defn add-transit-read-handler [tag fn]
(defn add-transit-read-handler [pod-id tag fn]
(let [rh (transit/read-handler fn)]
(swap! transit-read-handlers assoc tag rh)))
(swap! transit-read-handlers assoc-in [pod-id tag] rh)
(update-transit-read-handler-map pod-id)
nil))
(defonce transit-write-handlers (atom {}))
(defonce transit-write-handler-maps (atom {}))
(defn update-transit-write-handler-map [pod-id]
(swap! transit-write-handler-maps assoc pod-id
(transit/write-handler-map (get @transit-write-handlers pod-id))))
;; https://www.cognitect.com/blog/2015/9/10/extending-transit
(defn add-transit-write-handler [tag fn classes]
(defn add-transit-write-handler [pod-id tag fn classes]
(let [rh (transit/write-handler tag fn)]
(doseq [class classes]
(swap! transit-write-handlers assoc class rh))))
(swap! transit-write-handlers assoc-in [pod-id class] rh)))
(update-transit-write-handler-map pod-id)
nil)
(defn transit-json-write [^String s]
(defn transit-json-write [pod-id ^String s]
;; (.println System/err (:pod-id pod))
(with-open [baos (java.io.ByteArrayOutputStream. 4096)]
(let [w (transit/writer baos :json {:handlers @transit-write-handlers})]
(let [w (transit/writer baos :json {:handlers (get @transit-write-handler-maps pod-id)})]
(transit/write w s)
(str baos))))
@ -73,7 +88,7 @@
write-fn (case format
:edn pr-str
:json cheshire/generate-string
:transit+json transit-json-write)
:transit+json #(transit-json-write (:pod-id pod) %))
id (next-id)
chan (if handlers handlers
(promise))
@ -127,7 +142,7 @@
(throw e)))))
:transit+json
(fn [s]
(try (transit-json-read s)
(try (transit-json-read (:pod-id pod) s)
(catch Exception e
(binding [*out* *err*]
(println "Cannot read Transit JSON: " (pr-str s))
@ -285,14 +300,6 @@
(binding [*out* *err*]
(println (str/join " " (map pr-str strs)))))
;; TODO: symbol -> look up pod in local cache, invoke if present, else
;; download via package.
;; What about versions?
;; bb can package definitions of popular pods in its resources
;; but what if the resources have an error - maybe best to fetch the definitions from github
;; (load-pod 'org.babashka/postgresql)
;; (load-pod 'org.babashka/postgresql_0.0.1)
(defn load-pod
([pod-spec] (load-pod pod-spec nil))
([pod-spec opts]

View file

@ -70,8 +70,8 @@
([pod-id sym args] (invoke pod-id sym args {}))
([pod-id sym args opts] (impl/invoke-public pod-id sym args opts)))
(defn add-transit-read-handler [tag fn]
(impl/add-transit-read-handler tag fn))
(defn add-transit-read-handler [pod-id tag fn]
(impl/add-transit-read-handler pod-id tag fn))
(defn add-transit-write-handler [tag fn classes]
(impl/add-transit-write-handler tag fn classes))
(defn add-transit-write-handler [pod-id tag fn classes]
(impl/add-transit-write-handler pod-id tag fn classes))

View file

@ -80,8 +80,8 @@
([pod-id sym args] (invoke pod-id sym args {}))
([pod-id sym args opts] (impl/invoke-public pod-id sym args opts)))
(defn add-transit-read-handler [tag fn]
(impl/add-transit-read-handler tag fn))
(defn add-transit-read-handler [pod-id tag fn]
(impl/add-transit-read-handler pod-id tag fn))
(defn add-transit-write-handler [tag fn classes]
(impl/add-transit-write-handler tag fn classes))
(defn add-transit-write-handler [pod-id tag fn classes]
(impl/add-transit-write-handler pod-id tag fn classes))

View file

@ -37,7 +37,7 @@
(defn transit-json-read [^String s]
(with-open [bais (java.io.ByteArrayInputStream. (.getBytes s "UTF-8"))]
(let [r (transit/reader bais :json {:handlers
{"pod.test-pod/local-date-time"
{"local-date-time"
(transit/read-handler
(fn [s]
(java.time.LocalDateTime/parse s)))}})]
@ -48,7 +48,7 @@
(let [w (transit/writer baos :json {:handlers
{java.time.LocalDateTime
(transit/write-handler
"pod.test-pod/local-date-time"
"local-date-time"
str)}})]
(transit/write w s)
(str baos))))
@ -123,9 +123,9 @@
{"name" "-local-date-time"}
{"name" "local-date-time"
"code" "
(babashka.pods/add-transit-read-handler \"pod.test-pod/local-date-time\"
(babashka.pods/add-transit-read-handler \"pod.test-pod\" \"local-date-time\"
(fn [s] (java.time.LocalDateTime/parse s)))
(babashka.pods/add-transit-write-handler \"pod.test-pod/local-date-time\"
(babashka.pods/add-transit-write-handler \"pod.test-pod\" \"local-date-time\"
str #{java.time.LocalDateTime})
(defn local-date-time [x]
(-local-date-time x))"}]

View file

@ -5,9 +5,13 @@
(def socket (System/getenv "BABASHKA_POD_TEST_SOCKET"))
(def pod-id (:pod/id (pods/load-pod (cond-> ["clojure" "-A:test-pod"]
(def cmd (cond-> ["clojure" "-M:test-pod"]
(= "json" fmt) (conj "--json")
(= "transit+json" fmt) (conj "--transit+json"))
(= "transit+json" fmt) (conj "--transit+json")))
;; (.println System/err cmd)
(def pod-id (:pod/id (pods/load-pod cmd
{:socket (boolean socket)})))
(require '[pod.test-pod :as pod])

View file

@ -5,6 +5,9 @@
(def test-program (slurp (io/file "test-resources" "test_program.clj")))
(defn assertions [out err ret]
;; (.println System/err ret)
;; (.println System/err out)
;; (.println System/err err)
(doseq [[expected actual]
(map vector '["pod.test-pod"
pod.test-pod