Scope transit read and write handlers to pod ids

deps.edn

@@ -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"]}}}

src/babashka/pods.clj

@@ -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]
+(defn add-transit-read-handler [pod-id tag fn]
-  (jvm/add-transit-read-handler tag fn))
+  (jvm/add-transit-read-handler pod-id tag fn))
 
-(defn add-transit-write-handler [tag fn classes]
+(defn add-transit-write-handler [pod-id tag fn classes]
-  (jvm/add-transit-write-handler tag fn classes))
+  (jvm/add-transit-write-handler pod-id tag fn classes))

src/babashka/pods/impl.clj

@@ -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]

src/babashka/pods/jvm.clj

@@ -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]
+(defn add-transit-read-handler [pod-id tag fn]
-  (impl/add-transit-read-handler tag fn))
+  (impl/add-transit-read-handler pod-id tag fn))
 
-(defn add-transit-write-handler [tag fn classes]
+(defn add-transit-write-handler [pod-id tag fn classes]
-  (impl/add-transit-write-handler tag fn classes))
+  (impl/add-transit-write-handler pod-id tag fn classes))

src/babashka/pods/sci.clj

@@ -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]
+(defn add-transit-read-handler [pod-id tag fn]
-  (impl/add-transit-read-handler tag fn))
+  (impl/add-transit-read-handler pod-id tag fn))
 
-(defn add-transit-write-handler [tag fn classes]
+(defn add-transit-write-handler [pod-id tag fn classes]
-  (impl/add-transit-write-handler tag fn classes))
+  (impl/add-transit-write-handler pod-id tag fn classes))

test-pod/pod/test_pod.clj

@@ -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))"}]

test-resources/test_program.clj

@@ -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")
+           (= "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])

test/babashka/pods/test_common.clj

@@ -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