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
Selmer params."
[auxlist]
`(safe-name (-> ~auxlist :attrs :property) :clojure))
`(safe-name (str "auxlist-" (-> ~auxlist :attrs :property)) :clojure))
(defmacro all-keys-present?

23
src/adl_support/utils.clj
View file

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

18
test/adl_support/utils_test.clj
View file

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