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

#9: Fixes bug 9, all tests pass...

Browse source 
But I'm not utterly confident there won't be regressions.
This commit is contained in:
Simon Brooke 2019-12-28 12:01:35 +00:00
parent 8f24c314a1
commit b472bd4950
4 changed files with 92 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/adl/to_hugsql_queries.clj
View file

@ -311,7 +311,7 @@
farkey (-> % :attrs :farkey)
link-type (-> % :attrs :type)
link-field (-> % :attrs :name)
query-name (list-related-query-name % entity far-entity false)
query-name (list-related-query-name % entity (or far-entity far-name) false)
signature ":? :*"]
(hash-map
(keyword query-name)

36
src/adl/to_psql.clj
View file

@ -225,7 +225,9 @@
(defn compose-convenience-entity-field
[field entity application]
([field entity application]
(compose-convenience-entity-field field entity application nil))
([field entity application table-alias]
(let [property (case (:tag field)
:field (property-for-field field entity)
:property field)
@ -235,13 +237,13 @@
(fn [p]
(if
(= (:type (:attrs p)) "entity")
(compose-convenience-entity-field p farside application)
(str (safe-name (:table (:attrs farside))) "." (field-name p))))
(user-distinct-properties farside)))))
(compose-convenience-entity-field p farside application (field-name property))
(str (or table-alias (safe-name (:table (:attrs farside)))) "." (field-name p))))
(user-distinct-properties farside))))))
(defn compose-convenience-view-select-list
"Compose the body of an SQL `SELECT` statement for a convenience view of this
(defn compose-convenience-view-from-list
"Compose the FROM list of an SQL `SELECT` statement for a convenience view of this
`entity` within this `application`, recursively. `top-level?` should be set
only on first invocation."
[entity application top-level?]
@ -254,10 +256,12 @@
(fn [f]
(if
(= (:type (:attrs f)) "entity")
(compose-convenience-view-select-list
(child application #(and (entity? %) (= (:name (:attrs %))(:entity (:attrs f)))))
application
false)))
(let [farside (child application #(and (entity? %) (= (:name (:attrs %))(:entity (:attrs f)))))
tablename (safe-name (-> farside :attrs :table) :sql)
fieldname (field-name f)]
(if (= tablename fieldname)
tablename
(str tablename " AS " fieldname)))))
(if
top-level?
(all-properties entity)
@ -295,16 +299,18 @@
(defn emit-convenience-entity-field
[property entity application]
([property entity application]
(emit-convenience-entity-field property entity application (field-name property)))
([property entity application table-alias]
(if
(= "entity" (-> property :attrs :type))
(str
(s/join
" ||', '|| "
(compose-convenience-entity-field property entity application))
(compose-convenience-entity-field property entity application table-alias))
" AS "
(field-name property)
"_expanded")))
"_expanded"))))
(defn emit-convenience-view
@ -338,14 +344,14 @@
#(if
(= (:type (:attrs %)) "entity")
(list
(emit-convenience-entity-field % entity application)
(emit-convenience-entity-field % entity application (field-name %))
(str (safe-name entity) "." (field-name %)))
(str (safe-name entity) "." (field-name %)))
(remove
#(#{"link" "list"} (:type (:attrs %)))
(all-properties entity) ))))))
(str
"FROM " (s/join ", " (set (compose-convenience-view-select-list entity application true))))
"FROM " (s/join ", " (set (compose-convenience-view-from-list entity application true))))
(if-not
(empty? entity-properties)
(str

2
src/adl/to_selmer_routes.clj
View file

@ -176,7 +176,7 @@
(*warn*
(str
"Entity '"
(-> entity :attrs :name)
(or (-> entity :attrs :name) entity)
"' passed to compose-fetch-auxlist-data is a non-entity")))
(if-not
(entity? farside)

63
test/adl/to_psql_test.clj
View file

@ -423,7 +423,7 @@
(is (= actual expected))))
(testing "Convenience entity field - is an entity field, should emit"
(let [property (child-with-tag address-entity :property #(= (-> % :attrs :name) "district_id"))
expected "districts.name AS district_id_expanded"
expected "district_id.name AS district_id_expanded"
actual (emit-convenience-entity-field property address-entity application)]
(is (= actual expected))))
@ -435,3 +435,64 @@
(is (= actual expected))))
))
(deftest bug-9-test
(testing "Correct reference to aliased tables in convenience view select queries
see [bug 9](https://github.com/simon-brooke/adl/issues/9)"
(let [app
{:tag :application,
:attrs {:version "0.0.1",
:name "pastoralist",
:xmlns:adl "http://bowyer.journeyman.cc/adl/1.4.1/",
:xmlns:html "http://www.w3.org/1999/xhtml",
:xmlns "http://bowyer.journeyman.cc/adl/1.4.1/"},
:content [{:tag :documentation,
:attrs nil,
:content ["A web-app intended to be used by pastoralists in managing
pastures, grazing, and animals."]}
{:tag :entity,
:attrs {:volatility "5", :magnitude "9", :name "animal" :table "animal"},
:content
[{:tag :key,
:attrs nil,
:content
[{:tag :property,
:attrs
{:distinct "system",
:immutable "true",
:column "id",
:name "id",
:type "integer",
:required "true"},
:content
[{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
{:tag :property,
:attrs {:entity "animal", :type "entity", :name "dam"},
:content nil}
{:tag :property,
:attrs {:entity "animal", :type "entity", :name "sire"},
:content nil}
{:tag :property,
:attrs
{:required "true",
:distinct "user",
:size "64",
:type "string",
:name "animal-identifier"},
:content
[{:tag :prompt,
:attrs {:locale "en_GB.UTF-8", :prompt "Ear-tag Number"},
:content nil}]}
{:tag :property,
:attrs {:distinct "user", :size "64", :type "string", :name "name"},
:content nil}]}]}
animal (child app #(= (-> % :attrs :name) "animal"))
dam (child animal #(= (-> % :attrs :name) "dam"))]
(let [actual (emit-convenience-view animal app)
should-find #"dam.animal_identifier"
should-not-find #"animal.name AS dam_expanded"]
;; (print actual) ;; see what we've got
(is (re-find should-find actual))
(is (nil? (re-find should-not-find actual))))
)))