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

More work on linking

Browse source
This commit is contained in:
Simon Brooke 2018-08-05 10:12:28 +01:00
parent 0b3b3ecba1
commit 972dfd091e
3 changed files with 43 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
src/adl/to_hugsql_queries.clj
View file

@ -290,7 +290,8 @@
[entity application] [entity application]
(let [entity-name (:name (:attrs entity)) (let [entity-name (:name (:attrs entity))
pretty-name (singularise entity-name) 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 (apply
merge merge
(map (map
@ -303,10 +304,11 @@
(= (:tag x) :entity) (= (:tag x) :entity)
(= (:name (:attrs x)) far-name))))) (= (:name (:attrs x)) far-name)))))
pretty-far (singularise far-name) pretty-far (singularise far-name)
safe-far (safe-name far-entity :sql)
farkey (-> % :attrs :farkey) farkey (-> % :attrs :farkey)
link-type (-> % :attrs :type) link-type (-> % :attrs :type)
link-field (-> % :attrs :name) link-field (-> % :attrs :name)
query-name (list-related-query-name far-entity entity) query-name (list-related-query-name % entity far-entity)
signature ":? :*"] signature ":? :*"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)
@ -323,23 +325,27 @@
(case link-type (case link-type
"entity" (list "entity" (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-name " records related to a given " pretty-far) (str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name)
(str "SELECT lv_" entity-name ".* \nFROM lv_" entity-name ", " entity-name) (str "SELECT lv_" entity-safe ".* \nFROM lv_" entity-safe)
(str "WHERE lv_" entity-name "." (first (key-names entity)) " = " (str "WHERE lv_" entity-safe "." (safe-name % :sql) " = :id")
entity-name "." (first (key-names entity))
"\n\tAND " entity-name "." link-field " = :id")
(order-by-clause entity "lv_" false)) (order-by-clause entity "lv_" false))
"link" (let [link-table-name "link" (let [link-table-name
(link-table-name % entity far-entity)] (link-table-name % entity far-entity)]
(list (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc links all existing " pretty-name " records related to a given " pretty-far) (str "-- :doc links all existing " pretty-far " records related to a given " pretty-name)
(str "SELECT * \nFROM " entity-name ", " link-table-name) (str "SELECT lv_" safe-far ".* \nFROM lv_" safe-far ", " link-table-name)
(str "WHERE " entity-name "." (str "WHERE lv_" safe-far "."
(first (key-names entity)) (safe-name (first (key-names far-entity)) :sql)
" = " link-table-name "." (singularise entity-name) "_id") " = " link-table-name "." (singularise safe-far) "_id")
(str "\tAND " link-table-name "." (safe-name (singularise far-name) :sql) "_id = :id") (str "\tAND " link-table-name "." (singularise entity-safe) "_id = :id")
(order-by-clause entity))) (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 " %))))) (list (str "ERROR: unexpected type " link-type " of property " %)))))
})) }))
links)))) links))))

10
src/adl/to_psql.clj
View file

@ -466,6 +466,7 @@
#(and #(and
(entity? %) (entity? %)
(= (:name (:attrs %)) (:entity (:attrs property))))) (= (:name (:attrs %)) (:entity (:attrs property)))))
unique? (unique-link? e1 e2)
link-table-name (link-table-name property e1 e2)] link-table-name (link-table-name property e1 e2)]
(if (if
;; we haven't already emitted this one... ;; we haven't already emitted this one...
@ -485,6 +486,13 @@
[(construct-link-property e1) [(construct-link-property e1)
(construct-link-property e2)] (construct-link-property e2)]
permissions)))}] 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 ;; mark it as emitted
(swap! emitted-link-tables conj link-table-name) (swap! emitted-link-tables conj link-table-name)
;; emit it ;; emit it
@ -498,7 +506,7 @@
(:name (:attrs e1)) (:name (:attrs e1))
" with " " with "
(:name (:attrs e2)))) (:name (:attrs e2))))
;; and immediately emit its referential integrity links ;; and immediately emit its referential integrity links
(emit-referential-integrity-links link-entity application))))))) (emit-referential-integrity-links link-entity application)))))))

18
src/adl/to_selmer_routes.clj
View file

@ -113,11 +113,17 @@
'comment 'comment
"Can't yet handle link properties") "Can't yet handle link properties")
{}) {})
"list" (list
'do
(list
'comment
"Can't yet handle link properties")
{})
(list (list
'do 'do
(list (list
'comment 'comment
(str "Unexpedted type " (-> property :atts :type))) (str "Unexpected type " (-> property :atts :type)))
{}))) {})))
@ -136,10 +142,14 @@
(hash-map (hash-map
(keyword (auxlist-data-name auxlist)) (keyword (auxlist-data-name auxlist))
(list (list
;; TODO: wrong query name being generated (symbol (str "db/" (list-related-query-name property entity farside)))
(symbol (str "db/" (list-related-query-name entity farside)))
'db/*db* 'db/*db*
{:id (list :id 'params)}))) {:id
(list
(case (-> property :attrs :type)
"link" :id
"list" (keyword (-> property :attrs :name)))
'params)})))
(do (do
(if-not (if-not
(entity? entity) (entity? entity)