[#33] Allow pods to register transit handlers for reading and writing

script/test

@@ -1,5 +1,7 @@
 #!/usr/bin/env bash
 
+set -eou pipefail
+
 export BABASHKA_POD_TEST_FORMAT
 export BABASHKA_POD_TEST_SOCKET
 

src/babashka/pods.clj

@@ -14,3 +14,9 @@
 (defn invoke
   ([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-write-handler [tag fn classes]
+  (jvm/add-transit-write-handler tag fn classes))

src/babashka/pods/impl.clj

@@ -39,14 +39,29 @@
 (defn next-id []
   (str (java.util.UUID/randomUUID)))
 
+(defonce transit-read-handlers (atom {}))
+
 (defn transit-json-read [^String s]
   (with-open [bais (java.io.ByteArrayInputStream. (.getBytes s "UTF-8"))]
-    (let [r (transit/reader bais :json)]
+    (let [r (transit/reader bais :json {:handlers @transit-read-handlers})]
       (transit/read r))))
 
+;; https://www.cognitect.com/blog/2015/9/10/extending-transit
+(defn add-transit-read-handler [tag fn]
+  (let [rh (transit/read-handler fn)]
+    (swap! transit-read-handlers assoc tag rh)))
+
+(defonce transit-write-handlers (atom {}))
+
+;; https://www.cognitect.com/blog/2015/9/10/extending-transit
+(defn add-transit-write-handler [tag fn classes]
+  (let [rh (transit/write-handler tag fn)]
+    (doseq [class classes]
+      (swap! transit-write-handlers assoc class rh))))
+
 (defn transit-json-write [^String s]
   (with-open [baos (java.io.ByteArrayOutputStream. 4096)]
-    (let [w (transit/writer baos :json)]
+    (let [w (transit/writer baos :json {:handlers @transit-write-handlers})]
       (transit/write w s)
       (str baos))))
 

src/babashka/pods/jvm.clj

@@ -69,3 +69,9 @@
 (defn invoke
   ([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-write-handler [tag fn classes]
+  (impl/add-transit-write-handler tag fn classes))

src/babashka/pods/sci.clj

@@ -79,3 +79,9 @@
 (defn invoke
   ([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-write-handler [tag fn classes]
+  (impl/add-transit-write-handler tag fn classes))

test-pod/pod/test_pod.clj

@@ -36,12 +36,20 @@
 
 (defn transit-json-read [^String s]
   (with-open [bais (java.io.ByteArrayInputStream. (.getBytes s "UTF-8"))]
-    (let [r (transit/reader bais :json)]
+    (let [r (transit/reader bais :json {:handlers
+                                        {"pod.test-pod/local-date-time"
+                                         (transit/read-handler
+                                          (fn [s]
+                                            (java.time.LocalDateTime/parse s)))}})]
       (transit/read r))))
 
-(defn transit-json-write [^String s]
+(defn transit-json-write [s]
   (with-open [baos (java.io.ByteArrayOutputStream. 4096)]
-    (let [w (transit/writer baos :json)]
+    (let [w (transit/writer baos :json {:handlers
+                                        {java.time.LocalDateTime
+                                         (transit/write-handler
+                                          "pod.test-pod/local-date-time"
+                                          str)}})]
       (transit/write w s)
       (str baos))))
 
@@ -111,7 +119,16 @@
                                                 {"name" "other-tag"}
                                                 ;; reads thing with other tag
                                                 {"name" "read-other-tag"
-                                                 "code" "(defn read-other-tag [x] [x x])"}]
+                                                 "code" "(defn read-other-tag [x] [x x])"}
+                                                {"name" "-local-date-time"}
+                                                {"name" "local-date-time"
+                                                 "code" "
+(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\"
+  str #{java.time.LocalDateTime})
+(defn local-date-time [x]
+  (-local-date-time x))"}]
                                                dependents)}
                                  {"name" "pod.test-pod.loaded"
                                   "defer" "true"}
@@ -193,7 +210,12 @@
                             (write out
                              {"status" ["done"]
                               "id" id
-                              "value" "#my/other-tag[1]"}))
+                              "value" "#my/other-tag[1]"})
+                            pod.test-pod/-local-date-time
+                            (write out
+                                   {"status" ["done"]
+                                    "id" id
+                                    "value" (write-fn (first args))}))
                           (recur))
                 :shutdown (System/exit 0)
                 :load-ns (let [ns (-> (get message "ns")

test-resources/test_program.clj

@@ -64,6 +64,12 @@
 
 (def fn-called (pod.test-pod/fn-call inc 2))
 
+;; (.println System/err (str :fmt " " fmt))
+(def local-date-time
+  (if (= "transit+json" fmt)
+    (instance? java.time.LocalDateTime (pod.test-pod/local-date-time (java.time.LocalDateTime/now)))
+    true))
+
 (require '[pod.test-pod.only-code :as only-code])
 (def should-be-1 (only-code/foo))
 
@@ -90,4 +96,5 @@
  other-tagged
  loaded
  fn-called
+ local-date-time
  should-be-1]

test/babashka/pods/sci_test.clj

@@ -13,8 +13,11 @@
                                     {'load-pod (fn [& args]
                                                  (apply pods/load-pod @ctx-ref args))
                                      'invoke pods/invoke
-                                     'unload-pod pods/unload-pod}}
+                                     'unload-pod pods/unload-pod
-                       :classes {'System System}})
+                                     'add-transit-read-handler  pods/add-transit-read-handler
+                                     'add-transit-write-handler pods/add-transit-write-handler}}
+                       :classes {'System System
+                                 'java.time.LocalDateTime java.time.LocalDateTime}})
         _ (vreset! ctx-ref ctx)
         ret (sci/binding [sci/out out
                           sci/err err]

test/babashka/pods/test_common.clj

@@ -23,6 +23,7 @@
                         [[1] [1]]
                         2
                         3
+                        true
                         1]
                (concat ret (repeat ::nil)))]
     (if (instance? java.util.regex.Pattern expected)