diff --git a/.gitignore b/.gitignore index a39745d4..a5bd7bfb 100644 --- a/.gitignore +++ b/.gitignore @@ -28,4 +28,4 @@ org_babashka*.h /bb.lib /bb.pdb /bb.stripped.pdb -.calva +/.calva diff --git a/src/babashka/impl/datafy.clj b/src/babashka/impl/datafy.clj index 89d39d92..b080bd61 100644 --- a/src/babashka/impl/datafy.clj +++ b/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)}) diff --git a/src/babashka/impl/protocols.clj b/src/babashka/impl/protocols.clj new file mode 100644 index 00000000..67d7cd51 --- /dev/null +++ b/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)}) diff --git a/src/babashka/main.clj b/src/babashka/main.clj index b5ee79f6..fc99e1ab 100644 --- a/src/babashka/main.clj +++ b/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)) diff --git a/test/babashka/classpath_test.clj b/test/babashka/classpath_test.clj index 0de24ed1..0e4c363e 100644 --- a/test/babashka/classpath_test.clj +++ b/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)))) diff --git a/test/babashka/datafy_test.clj b/test/babashka/datafy_test.clj new file mode 100644 index 00000000..3a38dc00 --- /dev/null +++ b/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))