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

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
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-"