From 972dfd091ec0e049478f6d08715a563be75e902d Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 5 Aug 2018 10:12:28 +0100 Subject: [PATCH] More work on linking --- src/adl/to_hugsql_queries.clj | 34 ++++++++++++++++++++-------------- src/adl/to_psql.clj | 10 +++++++++- src/adl/to_selmer_routes.clj | 18 ++++++++++++++---- 3 files changed, 43 insertions(+), 19 deletions(-) diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj index 2b9b4b1..dc5b9ab 100644 --- a/src/adl/to_hugsql_queries.clj +++ b/src/adl/to_hugsql_queries.clj @@ -290,7 +290,8 @@ [entity application] (let [entity-name (:name (:attrs entity)) pretty-name (singularise entity-name) - links (filter #(#{"link" "entity"} (:type (:attrs %))) (children-with-tag entity :property))] + entity-safe (safe-name entity :sql) + links (filter #(#{"list" "link" "entity"} (:type (:attrs %))) (children-with-tag entity :property))] (apply merge (map @@ -303,10 +304,11 @@ (= (:tag x) :entity) (= (:name (:attrs x)) far-name))))) pretty-far (singularise far-name) + safe-far (safe-name far-entity :sql) farkey (-> % :attrs :farkey) link-type (-> % :attrs :type) link-field (-> % :attrs :name) - query-name (list-related-query-name far-entity entity) + query-name (list-related-query-name % entity far-entity) signature ":? :*"] (hash-map (keyword query-name) @@ -323,23 +325,27 @@ (case link-type "entity" (list (str "-- :name " query-name " " signature) - (str "-- :doc lists all existing " pretty-name " records related to a given " pretty-far) - (str "SELECT lv_" entity-name ".* \nFROM lv_" entity-name ", " entity-name) - (str "WHERE lv_" entity-name "." (first (key-names entity)) " = " - entity-name "." (first (key-names entity)) - "\n\tAND " entity-name "." link-field " = :id") + (str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name) + (str "SELECT lv_" entity-safe ".* \nFROM lv_" entity-safe) + (str "WHERE lv_" entity-safe "." (safe-name % :sql) " = :id") (order-by-clause entity "lv_" false)) "link" (let [link-table-name (link-table-name % entity far-entity)] (list (str "-- :name " query-name " " signature) - (str "-- :doc links all existing " pretty-name " records related to a given " pretty-far) - (str "SELECT * \nFROM " entity-name ", " link-table-name) - (str "WHERE " entity-name "." - (first (key-names entity)) - " = " link-table-name "." (singularise entity-name) "_id") - (str "\tAND " link-table-name "." (safe-name (singularise far-name) :sql) "_id = :id") - (order-by-clause entity))) + (str "-- :doc links all existing " pretty-far " records related to a given " pretty-name) + (str "SELECT lv_" safe-far ".* \nFROM lv_" safe-far ", " link-table-name) + (str "WHERE lv_" safe-far "." + (safe-name (first (key-names far-entity)) :sql) + " = " link-table-name "." (singularise safe-far) "_id") + (str "\tAND " link-table-name "." (singularise entity-safe) "_id = :id") + (order-by-clause far-entity "lv_" false))) + "list" (list + (str "-- :name " query-name " " signature) + (str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name) + (str "SELECT lv_" safe-far ".* \nFROM lv_" safe-far) + (str "WHERE lv_" safe-far "." (safe-name (first (key-names far-entity)) :sql) " = :id") + (order-by-clause far-entity "lv_" false)) (list (str "ERROR: unexpected type " link-type " of property " %))))) })) links)))) diff --git a/src/adl/to_psql.clj b/src/adl/to_psql.clj index 898a9ea..85b986f 100644 --- a/src/adl/to_psql.clj +++ b/src/adl/to_psql.clj @@ -466,6 +466,7 @@ #(and (entity? %) (= (:name (:attrs %)) (:entity (:attrs property))))) + unique? (unique-link? e1 e2) link-table-name (link-table-name property e1 e2)] (if ;; we haven't already emitted this one... @@ -485,6 +486,13 @@ [(construct-link-property e1) (construct-link-property e2)] permissions)))}] + (if-not unique? + (*warn* + (str "WARNING: Manually check link tables between " + (-> e1 :attrs :name) + " and " + (-> e2 :attrs :name) + " for redundancy"))) ;; mark it as emitted (swap! emitted-link-tables conj link-table-name) ;; emit it @@ -498,7 +506,7 @@ (:name (:attrs e1)) " with " (:name (:attrs e2)))) - ;; and immediately emit its referential integrity links + ;; and immediately emit its referential integrity links (emit-referential-integrity-links link-entity application))))))) diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj index 753322d..7f31bac 100644 --- a/src/adl/to_selmer_routes.clj +++ b/src/adl/to_selmer_routes.clj @@ -113,11 +113,17 @@ 'comment "Can't yet handle link properties") {}) + "list" (list + 'do + (list + 'comment + "Can't yet handle link properties") + {}) (list 'do (list 'comment - (str "Unexpedted type " (-> property :atts :type))) + (str "Unexpected type " (-> property :atts :type))) {}))) @@ -136,10 +142,14 @@ (hash-map (keyword (auxlist-data-name auxlist)) (list - ;; TODO: wrong query name being generated - (symbol (str "db/" (list-related-query-name entity farside))) + (symbol (str "db/" (list-related-query-name property entity farside))) 'db/*db* - {:id (list :id 'params)}))) + {:id + (list + (case (-> property :attrs :type) + "link" :id + "list" (keyword (-> property :attrs :name))) + 'params)}))) (do (if-not (entity? entity)