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]
(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))))

10
src/adl/to_psql.clj
View file

@ -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)))))))

18
src/adl/to_selmer_routes.clj
View file

@ -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)