simon/adl-support
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Still wrestling with naming links - genuinely tricky

Browse source
This commit is contained in:
Simon Brooke 2018-08-02 08:21:43 +01:00
parent 3b539c6ec8
commit 37d56321b3
2 changed files with 54 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

86
src/adl_support/utils.clj
View file

@ -90,33 +90,6 @@
(sort #(compare (:name (:attrs %1)) (:name (:attrs %2))) elements))
(defn link-table-name
"Canonical name of a link table between entity `e1` and entity `e2`. However, there
may be different links between the same two tables with different semantics; if
`property` is specified, and if more than one property in `e1` links to `e2`, generate
a more specific link name."
([e1 e2]
(s/join
"_"
(cons
"ln"
(sort
(list
(:name (:attrs e1)) (:name (:attrs e2)))))))
([property e1 e2]
(if (count
(descendants
e1
#(and
(= (-> % :attrs :type) "link")
(=
(-> % :attrs :entity)
(-> property :attrs :entity)))))
(s/join
"_" (cons "ln" (map #(:name (:attrs %)) (list property e1 e2))))
(link-table-name e1 e2))))
(defn children
"Return the children of this `element`; if `predicate` is passed, return only those
children satisfying the predicate."
@ -328,7 +301,53 @@
;; (safe-name {:tag :property :attrs {:name "address-id"}} :sql)
(defmacro list-related-query-name
(defn unique-link?
"True if there is exactly one link between entities `e1` and `e2`."
[e1 e2]
(let [n1 (count (children-with-tag e1 :property #(= (-> % :attrs :name)(-> e2 :attrs :name))))
n2 (count (children-with-tag e2 :property #(= (-> % :attrs :name)(-> e1 :attrs :name))))]
(= (max n1 n2) 1)))
(defn link-related-property-name
"link is tricky. If there's exactly than one link between the two
entities, we need to generate the same name from both
ends of the link"
[property nearside farside]
(if (unique-link? nearside farside)
(let [ordered (sort-by (-> % :attrs :name) (list nearside farside))
e1 (first ordered)
e2 (nth ordered 1)]
(str "list-"
(safe-name e1 :sql)
"-by-"
(safe-name e2 :sql))
(str "list-"
(safe-name ~property :sql) "-by-"
(singularise (safe-name ~nearside :sql))))))
(defn link-table-name
"Canonical name of a link table between entity `e1` and entity `e2`. However, there
may be different links between the same two tables with different semantics; if
`property` is specified, and if more than one property in `e1` links to `e2`, generate
a more specific link name."
([e1 e2]
(s/join
"_"
(cons
"ln"
(sort
(list
(:name (:attrs e1)) (:name (:attrs e2)))))))
([property e1 e2]
(if (unique-link? e1 e2)
(s/join
"_" (cons "ln" (map #(:name (:attrs %)) (list property e1 e2))))
(link-table-name e1 e2))))
(defn list-related-query-name
"Return the canonical name of the HugSQL query to return all records on
`farside` which match a given record on `nearside`, where `nearide` and
`farside` are both entities."
@ -339,15 +358,16 @@
(entity? ~nearside)
(entity? ~farside))
(case (-> ~property :attrs :type)
"link" (str "list-"
(safe-name ~property :sql) "-by-"
(singularise (safe-name ~nearside :sql)))
;; link is tricky. If there's exactly than one link between the two
;; entities, we need to generate the same name from both
;; ends of the link
"link" (link-related-query-name)
"list" (str "list-"
(safe-name ~farside :sql) "-by-"
(singularise (safe-name ~nearside :sql)))
"entity" (str "list-"
(safe-name ~nearside :sql) "-by-"
(singularise (safe-name ~farside :sql)))
(safe-name ~farside :sql) "-by-"
(singularise (safe-name ~nearside :sql)))
;; default
(str "ERROR-bad-property-type-"
(-> ~property :attrs :type) "-of-"

6
test/adl_support/utils_test.clj
View file

@ -369,11 +369,7 @@
property (child e1 #(= (-> % :attrs :name) "gender"))
expected "list-electors-by-gender"
actual (list-related-query-name property e2 e1)]
(is (= expected actual) "just checking..."))))
(deftest list-related-query-name-tests
(testing "list-related-query-name"
(is (= expected actual) "just checking..."))
(let [e1 {:tag :entity
:attrs {:name "dwellings"}
:content [{:tag :key