diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj index 6f2b1b9..9e13053 100644 --- a/src/adl/to_hugsql_queries.clj +++ b/src/adl/to_hugsql_queries.clj @@ -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) diff --git a/src/adl/to_psql.clj b/src/adl/to_psql.clj index 73a0842..f08b80e 100644 --- a/src/adl/to_psql.clj +++ b/src/adl/to_psql.clj @@ -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] - (if - (= "entity" (-> property :attrs :type)) - (str - (s/join - " ||', '|| " - (compose-convenience-entity-field property entity application)) - " AS " - (field-name property) - "_expanded"))) + ([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 table-alias)) + " AS " + (field-name property) + "_expanded")))) (defn emit-convenience-view @@ -314,7 +320,8 @@ (let [view-name (safe-name (str "lv_" (:table (:attrs entity))) :sql) entity-properties (filter #(= (:type (:attrs %)) "entity") - (properties entity))] + (properties entity)) + tn (safe-name (-> entity :attrs :table) :sql)] (s/join "\n" (remove @@ -338,14 +345,14 @@ #(if (= (:type (:attrs %)) "entity") (list - (emit-convenience-entity-field % entity application) - (str (safe-name entity) "." (field-name %))) - (str (safe-name entity) "." (field-name %))) + (emit-convenience-entity-field % entity application (field-name %)) + (str tn "." (field-name %))) + (str tn "." (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 diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj index a6d9bc6..760e22a 100644 --- a/src/adl/to_selmer_routes.clj +++ b/src/adl/to_selmer_routes.clj @@ -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) diff --git a/test/adl/to_psql_test.clj b/test/adl/to_psql_test.clj index 597bb13..1f41c81 100644 --- a/test/adl/to_psql_test.clj +++ b/test/adl/to_psql_test.clj @@ -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,114 @@ (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))))))) + +(deftest bug-10-test + (testing "Correct table names in convenience view select queries + see [bug 10](https://github.com/simon-brooke/adl/issues/10)" + (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 "3", + :name "event-type", + :table "event-type"}, + :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 {:size "80", :type "string", :name "summary"}, + :content nil} + {:tag :property, + :attrs {:type "text", :name "description"}, + :content nil} + {:tag :property, + :attrs {:default "1", :type "integer", :name "n-holdings"},} + {:tag :property, + :attrs {:default "1", :type "integer", :name "n-pastures"}} + {:tag :property, + :attrs {:default "1", :type "integer", :name "n-animals"}}]}]} + should-find #"event_type.description" + should-not-find #"event-type.description" + actual (emit-convenience-view (child app #(= (-> % :attrs :name) "event-type")) app)] + (is (re-find should-find actual)) + (is (nil? (re-find should-not-find actual))))))