[#468] Add clojure.core.protocols w Datafiable and Navigable

.gitignore

@@ -28,4 +28,4 @@ org_babashka*.h
 /bb.lib
 /bb.pdb
 /bb.stripped.pdb
-.calva
+/.calva

src/babashka/impl/datafy.clj

@@ -1,8 +1,12 @@
 (ns babashka.impl.datafy
   {:no-doc true}
+  (:refer-clojure :exclude [create-ns])
   (:require [babashka.impl.common :refer [ctx]]
+            [babashka.impl.protocols :as protocols]
             [clojure.core.protocols :as p]
-            [clojure.datafy :as datafy]
+            [clojure.datafy] ;; ensure datafy is loaded, we're going to override
+                             ;; its clojure.lang.Namespace implementation for
+                             ;; datafy
             [clojure.reflect]
             [sci.core :as sci :refer [copy-var]]
             [sci.impl.namespaces :refer [sci-ns-name sci-ns-publics sci-ns-imports sci-ns-interns]]
@@ -41,5 +45,5 @@
 (def datafy-ns (sci/create-ns 'clojure.datafy nil))
 
 (def datafy-namespace
-  {'datafy (copy-var datafy/datafy datafy-ns)
-   'nav (copy-var datafy/nav datafy-ns)})
+  {'datafy (copy-var protocols/datafy datafy-ns)
+   'nav (copy-var protocols/nav datafy-ns)})

src/babashka/impl/protocols.clj

@@ -0,0 +1,38 @@
+(ns babashka.impl.protocols
+  (:require [clojure.datafy :as d]
+            [sci.core :as sci :refer [copy-var]]
+            [sci.impl.types :as types]))
+
+;;;; datafy
+
+(defmulti datafy types/type-impl)
+
+(defmethod datafy :sci.impl.protocols/reified [x]
+  (let [methods (types/getMethods x)]
+    ((get methods 'datafy) x)))
+
+(defmethod datafy :default [x]
+  ;; note: Clojure itself will handle checking metadata for impls
+  (d/datafy x))
+
+;;;; nav
+(defmulti nav types/type-impl)
+
+(defmethod nav :sci.impl.protocols/reified [coll k v]
+  (let [methods (types/getMethods coll)]
+    ((get methods 'nav) coll k v)))
+
+(defmethod nav :default [coll k v]
+  ;; note: Clojure itself will handle checking metadata for impls
+  (d/nav coll k v))
+
+;;;; sci namespace
+(def protocols-ns (sci/create-ns 'clojure.core.protocols nil))
+
+(def protocols-namespace
+  {'Datafiable (sci/new-var 'clojure.core.protocols/Datafiable {:methods #{'datafy}
+                                                                :ns protocols-ns})
+   'datafy (copy-var datafy protocols-ns)
+   'Navigable (sci/new-var 'clojure.core.protocols/Navigable {:methods #{'nav}
+                                                              :ns protocols-ns})
+   'nav (copy-var nav protocols-ns)})

src/babashka/main.clj

@@ -19,6 +19,7 @@
    [babashka.impl.datafy :refer [datafy-namespace]]
    [babashka.impl.features :as features]
    [babashka.impl.pods :as pods]
+   [babashka.impl.protocols :refer [protocols-namespace]]
    [babashka.impl.repl :as repl]
    [babashka.impl.socket-repl :as socket-repl]
    [babashka.impl.test :as t]
@@ -370,7 +371,8 @@ If neither -e, -f, or --socket-repl are specified, then the first argument that
        'babashka.pods pods/pods-namespace
        'bencode.core bencode-namespace
        'clojure.java.browse browse-namespace
-       'clojure.datafy datafy-namespace}
+       'clojure.datafy datafy-namespace
+       'clojure.core.protocols protocols-namespace}
     features/xml?  (assoc 'clojure.data.xml @(resolve 'babashka.impl.xml/xml-namespace))
     features/yaml? (assoc 'clj-yaml.core @(resolve 'babashka.impl.yaml/yaml-namespace)
                           'flatland.ordered.map @(resolve 'babashka.impl.ordered/ordered-map-ns))

test/babashka/classpath_test.clj

@@ -3,8 +3,8 @@
    [babashka.test-utils :as tu]
    [clojure.edn :as edn]
    [clojure.java.io :as io]
-   [clojure.test :as t :refer [deftest is testing]]
-   [clojure.string :as str]))
+   [clojure.string :as str]
+   [clojure.test :as t :refer [deftest is testing]]))
 
 (defn bb [input & args]
   (edn/read-string (apply tu/bb (when (some? input) (str input)) (map str args))))

test/babashka/datafy_test.clj

@@ -0,0 +1,75 @@
+(ns babashka.datafy-test
+  (:require [babashka.test-utils :as tu]
+            [clojure.edn :as edn]
+            [clojure.test :as t :refer [deftest is testing]]))
+
+(defn bb [& args]
+  (edn/read-string (apply tu/bb nil (map str args))))
+
+(deftest datafy-test
+  (testing "default implementation of datafy works"
+    (is (= #{:public} (bb "(require '[clojure.datafy :as d]) (:flags (d/datafy Exception))"))))
+  (testing "custom implementation of datafy works"
+    (is (= {:number 1} (bb "
+(require '[clojure.datafy :as d]
+         '[clojure.core.protocols :as p])
+
+(extend-type Number
+  p/Datafiable
+  (datafy [x]
+    {:number x}))
+
+(d/datafy 1)
+"))))
+  (testing "implement datafy via metadata"
+    (is (= {:datafied []} (bb "
+(require '[clojure.datafy :as d]
+         '[clojure.core.protocols :as p])
+
+(def x (with-meta [] {`p/datafy (fn [this] {:datafied this})}))
+(d/datafy x)
+"))))
+  (testing "reify Datafiable"
+    (let [prog "
+(require '[clojure.datafy :as d]
+         '[clojure.core.protocols :as p])
+
+(def x (reify p/Datafiable (datafy [_] [:data])))
+(d/datafy x)"]
+      (is (= [:data] (bb prog)))))
+  
+  (testing "default implementation of nav works"
+    (is (= 1 (bb "(require '[clojure.datafy :as d]) (d/nav {:a 1} :a 1)"))))
+  (testing "custom implementation of nav works"
+    (is (= \f (bb "
+(require '[clojure.datafy :as d]
+         '[clojure.core.protocols :as p])
+
+(extend-type String
+  p/Navigable
+  (nav [coll k v]
+    (.charAt coll k)))
+
+(d/nav \"foo\" 0 nil)
+"))))
+  (testing "implement nav via metadata"
+    (is (= {:nav [[] :k :v]} (bb "
+(require '[clojure.datafy :as d]
+         '[clojure.core.protocols :as p])
+
+(def x (with-meta [] {`p/nav (fn [this k v] {:nav [this k v]})}))
+(d/nav x :k :v)
+"))))
+  (testing "reify Navigable"
+    (let [prog "
+(require '[clojure.datafy :as d]
+         '[clojure.core.protocols :as p])
+
+(def x (reify p/Navigable (nav [_ _ _] [:data])))
+(d/nav x nil nil)"]
+      (is (= [:data] (bb prog))))))
+
+;;;; Scratch
+(comment
+  (t/run-tests *ns*)
+  (datafy-test))