<sigh> More unit tests...
This commit is contained in:
parent
e93368c675
commit
8fbe32c5c2
|
@ -304,8 +304,12 @@
|
||||||
(defn unique-link?
|
(defn unique-link?
|
||||||
"True if there is exactly one link between entities `e1` and `e2`."
|
"True if there is exactly one link between entities `e1` and `e2`."
|
||||||
[e1 e2]
|
[e1 e2]
|
||||||
(let [n1 (count (children-with-tag e1 :property #(= (-> % :attrs :name)(-> e2 :attrs :name))))
|
(let [n1 (count (children-with-tag e1 :property
|
||||||
n2 (count (children-with-tag e2 :property #(= (-> % :attrs :name)(-> e1 :attrs :name))))]
|
#(and (= (-> % :attrs :type) "link")
|
||||||
|
(= (-> % :attrs :entity)(-> e2 :attrs :name)))))
|
||||||
|
n2 (count (children-with-tag e2 :property
|
||||||
|
#(and (= (-> % :attrs :type) "link")
|
||||||
|
(= (-> % :attrs :entity)(-> e1 :attrs :name)))))]
|
||||||
(= (max n1 n2) 1)))
|
(= (max n1 n2) 1)))
|
||||||
|
|
||||||
|
|
||||||
|
@ -315,13 +319,11 @@
|
||||||
ends of the link"
|
ends of the link"
|
||||||
[property nearside farside]
|
[property nearside farside]
|
||||||
(if (unique-link? nearside farside)
|
(if (unique-link? nearside farside)
|
||||||
(let [ordered (sort-by #(-> % :attrs :name) (list nearside farside))
|
(let [ordered (sort-by #(-> % :attrs :name) (list nearside farside))]
|
||||||
e1 (first ordered)
|
|
||||||
e2 (nth ordered 1)]
|
|
||||||
(str "list-"
|
(str "list-"
|
||||||
(safe-name e1 :sql)
|
(safe-name (first ordered) :sql)
|
||||||
"-by-"
|
"-by-"
|
||||||
(safe-name e2 :sql)))
|
(safe-name (nth ordered 1) :sql)))
|
||||||
(str "list-"
|
(str "list-"
|
||||||
(safe-name property :sql) "-by-"
|
(safe-name property :sql) "-by-"
|
||||||
(singularise (safe-name nearside :sql)))))
|
(singularise (safe-name nearside :sql)))))
|
||||||
|
@ -342,9 +344,9 @@
|
||||||
(:name (:attrs e1)) (:name (:attrs e2)))))))
|
(:name (:attrs e1)) (:name (:attrs e2)))))))
|
||||||
([property e1 e2]
|
([property e1 e2]
|
||||||
(if (unique-link? e1 e2)
|
(if (unique-link? e1 e2)
|
||||||
|
(link-table-name e1 e2)
|
||||||
(s/join
|
(s/join
|
||||||
"_" (cons "ln" (map #(:name (:attrs %)) (list property e1 e2))))
|
"_" (cons "ln" (map #(:name (:attrs %)) (list property e1)))))))
|
||||||
(link-table-name e1 e2))))
|
|
||||||
|
|
||||||
|
|
||||||
(defn list-related-query-name
|
(defn list-related-query-name
|
||||||
|
|
|
@ -426,24 +426,83 @@
|
||||||
actual (list-related-query-name property e2 e1)]
|
actual (list-related-query-name property e2 e1)]
|
||||||
(is (= actual expected) "Link property - membersips")))))
|
(is (= actual expected) "Link property - membersips")))))
|
||||||
|
|
||||||
;; (def e1 {:tag :entity
|
|
||||||
;; :attrs {:name "teams"}
|
|
||||||
;; :content [{:tag :key
|
|
||||||
;; :content [{:tag :property
|
|
||||||
;; :attrs {:name "id" :type "integer" :distinct "system"}}]}
|
|
||||||
;; {:tag :property
|
|
||||||
;; :attrs {:name "members" :type "link" :entity "canvassers"}}
|
|
||||||
;; {:tag :property
|
|
||||||
;; :attrs {:name "organisers" :type "link" :entity "canvassers"}}]})
|
|
||||||
;; (def e2 {:tag :entity
|
|
||||||
;; :attrs {:name "canvassers"}
|
|
||||||
;; :content [{:tag :key
|
|
||||||
;; :content [{:tag :property
|
|
||||||
;; :attrs {:name "id" :type "integer" :distinct "system"}}]}
|
|
||||||
;; {:tag :property
|
|
||||||
;; :attrs {:name "memberships" :type "link" :entity "teams"}}]})
|
|
||||||
|
|
||||||
;; (def property {:tag :property
|
(deftest link-table-name-tests
|
||||||
;; :attrs {:name "members" :type "link" :entity "canvassers"}})
|
(testing "link-table-name"
|
||||||
|
(let [e1 {:tag :entity
|
||||||
|
:attrs {:name "teams"}
|
||||||
|
:content [{:tag :key
|
||||||
|
:content [{:tag :property
|
||||||
|
:attrs {:name "id" :type "integer" :distinct "system"}}]}
|
||||||
|
{:tag :property
|
||||||
|
:attrs {:name "members" :type "link" :entity "canvassers"}}
|
||||||
|
{:tag :property
|
||||||
|
:attrs {:name "organisers" :type "link" :entity "canvassers"}}]}
|
||||||
|
e2 {:tag :entity
|
||||||
|
:attrs {:name "canvassers"}
|
||||||
|
:content [{:tag :key
|
||||||
|
:content [{:tag :property
|
||||||
|
:attrs {:name "id" :type "integer" :distinct "system"}}]}
|
||||||
|
{:tag :property
|
||||||
|
:attrs {:name "memberships" :type "link" :entity "teams"}}
|
||||||
|
{:tag :property
|
||||||
|
:attrs {:name "roles" :type "link" :entity "roles"}}]}
|
||||||
|
e3 {:tag :entity
|
||||||
|
:attrs {:name "roles"}
|
||||||
|
:content [{:tag :key
|
||||||
|
:content [{:tag :property
|
||||||
|
:type "string"
|
||||||
|
:distinct "all"
|
||||||
|
:name "id"}]}]}]
|
||||||
|
(let [property {:tag :property
|
||||||
|
:attrs {:name "members" :type "link" :entity "canvassers"}}
|
||||||
|
expected "ln_members_teams"
|
||||||
|
actual (link-table-name property e1 e2)]
|
||||||
|
(is (= actual expected) "Link property - members"))
|
||||||
|
(let [property {:tag :property
|
||||||
|
:attrs {:name "organisers" :type "link" :entity "canvassers"}}
|
||||||
|
expected "ln_organisers_teams"
|
||||||
|
actual (link-table-name property e1 e2)]
|
||||||
|
(is (= actual expected) "Link property - organisers"))
|
||||||
|
(let [property {:tag :property
|
||||||
|
:attrs {:name "memberships" :type "link" :entity "teams"}}
|
||||||
|
expected "ln_memberships_canvassers"
|
||||||
|
actual (link-table-name property e2 e1)]
|
||||||
|
(is (= actual expected) "Link property - membersips"))
|
||||||
|
(let [property {:tag :property
|
||||||
|
:attrs {:name "roles" :type "link" :entity "roles"}}
|
||||||
|
expected "ln_canvassers_roles"
|
||||||
|
actual (link-table-name property e2 e3)]
|
||||||
|
(is (= actual expected) "Link property - roles")))))
|
||||||
|
|
||||||
|
|
||||||
|
(deftest unique-link-tests
|
||||||
|
(testing "unique-link?"
|
||||||
|
(let [e1 {:tag :entity
|
||||||
|
:attrs {:name "teams"}
|
||||||
|
:content [{:tag :key
|
||||||
|
:content [{:tag :property
|
||||||
|
:attrs {:name "id" :type "integer" :distinct "system"}}]}
|
||||||
|
{:tag :property
|
||||||
|
:attrs {:name "members" :type "link" :entity "canvassers"}}
|
||||||
|
{:tag :property
|
||||||
|
:attrs {:name "organisers" :type "link" :entity "canvassers"}}]}
|
||||||
|
e2 {:tag :entity
|
||||||
|
:attrs {:name "canvassers"}
|
||||||
|
:content [{:tag :key
|
||||||
|
:content [{:tag :property
|
||||||
|
:attrs {:name "id" :type "integer" :distinct "system"}}]}
|
||||||
|
{:tag :property
|
||||||
|
:attrs {:name "memberships" :type "link" :entity "teams"}}
|
||||||
|
{:tag :property
|
||||||
|
:attrs {:name "roles" :type "link" :entity "roles"}}]}
|
||||||
|
e3 {:tag :entity
|
||||||
|
:attrs {:name "roles"}
|
||||||
|
:content [{:tag :key
|
||||||
|
:content [{:tag :property
|
||||||
|
:type "string"
|
||||||
|
:distinct "all"
|
||||||
|
:name "id"}]}]}]
|
||||||
|
(is (= false (unique-link? e1 e2)) "There are two logical links, three link properties, between e1 and e2")
|
||||||
|
(is (= true (unique-link? e2 e3)) "There is only one link between e2 and e3"))))
|
||||||
|
|
||||||
;; (list-related-query-name property e1 e2)
|
|
||||||
|
|
Loading…
Reference in a new issue