Commits

Anonymous committed 64aa80e

add an extra arity version to typed? fn to allow custom hierarchies

Comments (0)

Files changed (2)

src/main/clj/org/bituf/clj_miscutil.clj

 
 
 (defn typed?
-  "Return true if child-object is of implied-type, false otherwise."
-  [child-obj implied-type] {:post [(boolean? %)]
-                           :pre  [(verify-arg (obj? child-obj))
-                                  (verify-arg (not-nil?  implied-type))
-                                  (verify-arg (not-coll? implied-type))]}
-  (or (some #(isa? % implied-type)
-        (as-vector (type-meta child-obj)))
-    false))
+  "Return true if child-object is of implied-type, false otherwise. h is the
+  hierarchy of types (map), which defaults to global hierarchy if unspecified."
+  ([child-obj implied-type] {:post [(boolean? %)]
+                             :pre  [(verify-arg (obj? child-obj))
+                                    (verify-arg (not-nil?  implied-type))
+                                    (verify-arg (not-coll? implied-type))]}
+    (or (some #(isa? % implied-type)
+          (as-vector (type-meta child-obj)))
+      false))
+  ([h child-obj implied-type] {:post [(boolean? %)]
+                             :pre  [(verify-arg (map? h))
+                                    (verify-arg (obj? child-obj))
+                                    (verify-arg (not-nil?  implied-type))
+                                    (verify-arg (not-coll? implied-type))]}
+    (or (some #(isa? h % implied-type)
+          (as-vector (type-meta child-obj)))
+      false)))
 
 
 (defn typed

src/test/clj/org/bituf/test_clj_miscutil.clj

       (is (typed? t :def))
       (is (typed? t :ghi))))
   (testing "hierarchy-test for typed?"
+    (let [e (make-hierarchy)
+          g (derive e ::employee ::salaried)
+          h (derive g ::salaried ::person)]
+      (is (every? #(typed? h (typed {} ::employee) %) [::salaried ::person]))
+      (is (some #(typed? h (typed {} ::employee) %) [::freelancer ::person])))
     (derive ::employee ::salaried)
     (derive ::salaried ::person)
     (is (every? #(typed? (typed {} ::employee) %) [::salaried ::person]))