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

All tests pass;

Browse source 
rather more satisfied with semantics of list-related-query-name
This commit is contained in:
Simon Brooke 2019-11-12 11:32:53 +00:00
parent 4a37941899
commit 35c061b519
3 changed files with 23 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/adl_support/forms_support.clj
View file

@ -92,7 +92,7 @@
"The name to which data for this `auxlist` will be bound in the "The name to which data for this `auxlist` will be bound in the
Selmer params." Selmer params."
[auxlist] [auxlist]
`(safe-name (-> ~auxlist :attrs :property) :clojure)) `(safe-name (str "auxlist-" (-> ~auxlist :attrs :property)) :clojure))
(defmacro all-keys-present? (defmacro all-keys-present?

23
src/adl_support/utils.clj
View file

@ -579,21 +579,24 @@
(defn list-related-query-name (defn list-related-query-name
"Return the canonical name of the HugSQL query to return all records on "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` which match a given record on `nearside`, where `nearide` and
`farside` are both entities." `farside` are both entities; and `property` is the nearside property on
which to join."
([property nearside farside as-symbol?] ([property nearside farside as-symbol?]
(let [unique? (= (let [unique? (=
(count (count
(filter (filter
#(= (-> % :attrs :entity)(-> property :attrs :entity)) #(= (-> % :attrs :entity)(-> property :attrs :entity))
(descendants-with-tag nearside :property))) (descendants-with-tag nearside :property)))
1) 1)
farname (if unique? (safe-name farside :sql) (safe-name property :sql)) farname (if unique? (safe-name farside :sql) (safe-name property :sql))
nearname (singularise (safe-name nearside :sql)) nearname (singularise (safe-name nearside :sql))
n (case (-> property :attrs :type) n (case (-> property :attrs :type)
;; TODO: I am deeply susicious of this. It's just improbable that "list" (str "list-" farname "-by-" nearname)
;; the same recipe should work for all three cases. "link" (s/join "-"
("link" "list") (str "list-" farname "-by-" nearname) (list
"entity" (str "list-" farname "-by-" nearname) "list"
(safe-name property :sql) "by" nearname))
"entity" (str "list-" (safe-name nearside :sql) "-by-" (safe-name property :sql))
;; default ;; default
(str "ERROR-bad-property-type-" (str "ERROR-bad-property-type-"
(-> ~property :attrs :type) "-of-" (-> ~property :attrs :type) "-of-"

18
test/adl_support/utils_test.clj
View file

@ -308,7 +308,7 @@
(deftest list-related-query-name-tests (deftest list-related-query-name-tests
(testing "list-related-query-name" (testing "list-related-query-name"
(let [e1 {:tag :entity, (let [genders-entity {:tag :entity,
:attrs {:volatility "6", :magnitude "1", :name "genders", :table "genders"}, :attrs {:volatility "6", :magnitude "1", :name "genders", :table "genders"},
:content [{:tag :documentation, :content [{:tag :documentation,
:content ["All genders which may be assigned to\n electors."]} :content ["All genders which may be assigned to\n electors."]}
@ -321,7 +321,7 @@
:content nil}]}]} :content nil}]}]}
{:tag :list, :attrs {:name "Genders", :properties "all"}} {:tag :list, :attrs {:name "Genders", :properties "all"}}
{:tag :form, :attrs {:name "Gender", :properties "all"}}]} {:tag :form, :attrs {:name "Gender", :properties "all"}}]}
e2 {:tag :entity, electors-entity {:tag :entity,
:attrs {:volatility "6", :magnitude "1", :name "electors", :table "electors"}, :attrs {:volatility "6", :magnitude "1", :name "electors", :table "electors"},
:content [{:tag :documentation, :content [{:tag :documentation,
:attrs nil, :attrs nil,
@ -366,9 +366,9 @@
[{:tag :prompt, [{:tag :prompt,
:attrs {:locale "en_GB.UTF-8", :prompt "Gender"}, :attrs {:locale "en_GB.UTF-8", :prompt "Gender"},
:content nil}]}]} :content nil}]}]}
property (child e2 #(= (-> % :attrs :name) "gender")) property (child electors-entity #(= (-> % :attrs :name) "gender"))
expected "list-electors-by-gender" expected "list-electors-by-gender"
actual (list-related-query-name property e2 e1)] actual (list-related-query-name property electors-entity genders-entity)]
(is (= expected actual) "just checking...")) (is (= expected actual) "just checking..."))
(let [e1 {:tag :entity (let [e1 {:tag :entity
:attrs {:name "dwellings"} :attrs {:name "dwellings"}
@ -394,7 +394,7 @@
expected "list-dwellings-by-address" expected "list-dwellings-by-address"
actual (list-related-query-name property e2 e1)] actual (list-related-query-name property e2 e1)]
(is (= expected actual) "List property"))) (is (= expected actual) "List property")))
(let [e1 {:tag :entity (let [team-entity {:tag :entity
:attrs {:name "teams"} :attrs {:name "teams"}
:content [{:tag :key :content [{:tag :key
:content [{:tag :property :content [{:tag :property
@ -403,7 +403,7 @@
:attrs {:name "members" :type "link" :entity "canvassers"}} :attrs {:name "members" :type "link" :entity "canvassers"}}
{:tag :property {:tag :property
:attrs {:name "organisers" :type "link" :entity "canvassers"}}]} :attrs {:name "organisers" :type "link" :entity "canvassers"}}]}
e2 {:tag :entity canvasser-entity {:tag :entity
:attrs {:name "canvassers"} :attrs {:name "canvassers"}
:content [{:tag :key :content [{:tag :key
:content [{:tag :property :content [{:tag :property
@ -413,17 +413,17 @@
(let [property {:tag :property (let [property {:tag :property
:attrs {:name "members" :type "link" :entity "canvassers"}} :attrs {:name "members" :type "link" :entity "canvassers"}}
expected "list-members-by-team" expected "list-members-by-team"
actual (list-related-query-name property e1 e2)] actual (list-related-query-name property team-entity canvasser-entity)]
(is (= actual expected) "Link property - members")) (is (= actual expected) "Link property - members"))
(let [property {:tag :property (let [property {:tag :property
:attrs {:name "organisers" :type "link" :entity "canvassers"}} :attrs {:name "organisers" :type "link" :entity "canvassers"}}
expected "list-organisers-by-team" expected "list-organisers-by-team"
actual (list-related-query-name property e1 e2)] actual (list-related-query-name property team-entity canvasser-entity)]
(is (= actual expected) "Link property - organisers")) (is (= actual expected) "Link property - organisers"))
(let [property {:tag :property (let [property {:tag :property
:attrs {:name "memberships" :type "link" :entity "teams"}} :attrs {:name "memberships" :type "link" :entity "teams"}}
expected "list-memberships-by-canvasser" expected "list-memberships-by-canvasser"
actual (list-related-query-name property e2 e1)] actual (list-related-query-name property canvasser-entity team-entity)]
(is (= actual expected) "Link property - membersips"))))) (is (= actual expected) "Link property - membersips")))))