Skip to content

Commit

Permalink
bring back alias tests, implement keyword syntax, #23
Browse files Browse the repository at this point in the history
  • Loading branch information
carbon-hvze committed Sep 2, 2022
1 parent 07a10f3 commit e4f18b9
Showing 4 changed files with 144 additions and 16 deletions.
11 changes: 5 additions & 6 deletions pkg/zen.edn
Original file line number Diff line number Diff line change
@@ -4,15 +4,14 @@
{:zen/tags #{schema}
:zen/desc "Schema for namespace"
:type map
;; :key {:type symbol}
:key {:type case
:case [{:when {:type symbol}}
{:when {:type keyword}}]}
;; TODO add values validation
:values {:type zen/any}
:keys {:ns {:type symbol}
:imports {:type set :every {:type symbol}}
;; TODO add alias
:require {:type map
:key {:type symbol}
;; TODO impl namespaced check
:values {:type symbol #_:namespaced #_true}}}}
:alias {:type symbol}}}

schema
{:zen/tags #{schema tag}
13 changes: 7 additions & 6 deletions src/zen/store.clj
Original file line number Diff line number Diff line change
@@ -81,7 +81,7 @@
(swap! ctx update :aliases zen.utils/disj-set-union-push alias-dest alias))

(defn symbol-definition? [[k v]]
(and (symbol? k) (map? v))) ;; TODO:
(and (symbol? k) (map? v)))

(defn symbol-alias? [[k v]]
(and (symbol? k) (qualified-symbol? v)))
@@ -101,15 +101,16 @@
(swap! ctx update :symbols (partial merge this-ns-symbols))))

(defn load-ns [ctx nmsps & [opts]]
(let [ns-name (or (get nmsps 'ns) (get nmsps :ns))]
(let [ns-name (or (get nmsps 'ns) (get nmsps :ns))
aliased-ns (or (get nmsps 'alias) (get nmsps :alias))]
(when (not (get-in @ctx [:ns ns-name]))
(swap! ctx (fn [ctx] (assoc-in ctx [:ns ns-name] (assoc nmsps :zen/file (:zen/file opts)))))

(pre-load-ns! ctx nmsps)

(doseq [imp (cond->> (or (get nmsps 'import)
(get nmsps :import))
(contains? nmsps 'alias) (cons (get nmsps 'alias)))]
(symbol? aliased-ns) (cons aliased-ns))]
(cond
(get-in @ctx [:ns imp])
:already-imported
@@ -120,16 +121,16 @@
:else
(read-ns ctx imp {:ns ns-name})))

(when-let [aliased-ns (get nmsps 'alias)]
(doseq [[aliased-sym alias-v :as kv] (get-in @ctx [:ns aliased-ns])]
(when (symbol? aliased-ns)
(doseq [[aliased-sym _ :as kv] (get-in @ctx [:ns aliased-ns])]
(when (symbol-definition? kv)
(let [shadowed-here? (contains? nmsps aliased-sym)]
(when (not shadowed-here?)
(load-alias ctx
(zen.utils/mk-symbol aliased-ns aliased-sym)
(zen.utils/mk-symbol ns-name aliased-sym)))))))

(->> (dissoc nmsps ['ns 'import 'alias :ns :import])
(->> (dissoc nmsps ['ns 'import 'alias :ns :import :alias])
(mapv (fn [[k v :as kv]]
(cond (symbol-definition? kv) (load-symbol ctx nmsps k (merge v opts))
(symbol-alias? kv) (load-alias ctx v (zen.utils/mk-symbol ns-name k))
8 changes: 4 additions & 4 deletions src/zen/v2_validation.clj
Original file line number Diff line number Diff line change
@@ -184,9 +184,9 @@

(defn *validate-schema
"internal, use validate function"
[ztx vtx schema data & [opts]]
[ztx vtx schema data {:keys [sch-symbol] :as opts}]
(-> vtx
(assoc :schema [(:zen/name schema)])
(assoc :schema [(or sch-symbol (:zen/name schema))])
(assoc :path [])
(assoc-in [::confirmed [] (:zen/name schema)] true)
((get-cached ztx schema true) data opts)))
@@ -211,10 +211,10 @@
(if (empty? schemas)
(dissoc (unknown-errs vtx) :visited :unknown-keys ::confirmed)
(if-let [schema (utils/get-symbol ztx (first schemas))]
(if (true? (get-in vtx [::confirmed [] (:zen/name schema)]))
(if (true? (get-in vtx [::confirmed [] (first schemas)]))
(recur (rest schemas) vtx)
(recur (rest schemas)
(*validate-schema ztx vtx schema data opts)))
(*validate-schema ztx vtx schema data (assoc opts :sch-symbol (first schemas)))))
(recur (rest schemas)
(update vtx :errors conj
{:message (str "Could not resolve schema '" (first schemas))
128 changes: 128 additions & 0 deletions test/zen/alias_test.clj
Original file line number Diff line number Diff line change
@@ -0,0 +1,128 @@
(ns zen.alias-test
(:require
[zen.core :as zen]
[matcho.core :as matcho]
[clojure.test :refer [deftest is testing]]))

(deftest alias-test
#"TODO: add alias remove test"
(def test-namespaces
'{ns1 {:ns ns1
sym1 {:foo :bar}

tag1 {:zen/tags #{zen/tag}}

sch1
{:zen/tags #{zen/schema}
:type zen/map
:keys {:a {:type zen/string}}}}

ns2 {:ns ns2
sym21 {:foo1 :bar2}
sym22 {:foo2 :bar2}

tag21 {:zen/tags #{zen/tag}}
tag22 {:zen/tags #{zen/tag}}

tagged-sym1 {:zen/tags #{tag21}}
tagged-sym2 {:zen/tags #{tag22}}

sch2
{:zen/tags #{zen/schema}
:type zen/map
:keys {:a {:type zen/string}}}}

myns {:ns myns
:import #{ns1}
:alias ns2

sym1 ns1/sym1
sch1 ns1/sch1
sym22 {:baz :quux}

tag1 ns1/tag1
tagged-sym1 {:zen/tags #{tag1}}
tagged-sym2 {:zen/tags #{ns1/tag1}}

tag22 {:zen/tags #{zen/tag}}
tagged-sym21 {:zen/tags #{tag21}}
tagged-sym221 {:zen/tags #{tag22}}
tagged-sym222 {:zen/tags #{ns2/tag22}}}})

(def ztx (zen/new-context {:unsafe true :memory-store test-namespaces}))

(zen/load-ns ztx (get test-namespaces 'myns))

(is (empty? (zen/errors ztx)))

(testing "symbol alias"
(matcho/match
(zen/get-symbol ztx 'myns/sym1)
'{:zen/name ns1/sym1}))

(testing "ns alias"
(matcho/match
(zen/get-symbol ztx 'myns/sym21)
'{:zen/name ns2/sym21})

(testing "monkey patch"
(matcho/match
(zen/get-symbol ztx 'myns/sym22)
'{:zen/name myns/sym22})))

(testing "tags alias"
(testing "symbol alias"
(is (= #{'myns/tagged-sym1 'myns/tagged-sym2}
(zen/get-tag ztx 'myns/tag1)))

(is (= #{'myns/tagged-sym1 'myns/tagged-sym2}
(zen/get-tag ztx 'ns1/tag1))))

(testing "ns alias"
(is (= #{'myns/tagged-sym21 'ns2/tagged-sym1}
(zen/get-tag ztx 'myns/tag21)))

(is (= #{'myns/tagged-sym21 'ns2/tagged-sym1}
(zen/get-tag ztx 'ns2/tag21)))

(testing "monkey patch"
(is (= #{'myns/tagged-sym221}
(zen/get-tag ztx 'myns/tag22)))

(is (= #{'myns/tagged-sym222 'ns2/tagged-sym2}
(zen/get-tag ztx 'ns2/tag22))))))

(testing "validate with alias"
(is (zen/get-symbol ztx 'myns/sch1))

(matcho/match
(zen/validate ztx #{'ns1/sch1} {:a 1})
'{:errors
[{:message "Expected type of 'string, got 'long",
:type "string.type",
:path [:a],
:schema [ns1/sch1 :a]}]})

(matcho/match
(zen/validate ztx #{'myns/sch1} {:a 1})
'{:errors
[{:message "Expected type of 'string, got 'long"
:type "string.type"
:path [:a]
:schema [myns/sch1 :a :type]}]})

(matcho/match
(zen/validate ztx #{'ns2/sch2} {:a 1})
'{:errors
[{:message "Expected type of 'string, got 'long",
:type "string.type",
:path [:a],
:schema [ns2/sch2 :a]}]})

(matcho/match
(zen/validate ztx #{'myns/sch2} {:a 1})
'{:errors
[{:message "Expected type of 'string, got 'long"
:type "string.type"
:path [:a]
:schema [myns/sch2 :a :type]}]})))

0 comments on commit e4f18b9

Please sign in to comment.