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

Making multi-select menus work

Browse source 
Major changes, may be regressions.
This commit is contained in:
Simon Brooke 2018-10-04 19:13:28 +01:00
parent 43d46ca9e5
commit a7934d70b9
3 changed files with 103 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
src/adl/to_hugsql_queries.clj
View file

@ -295,7 +295,7 @@
(let [entity-name (:name (:attrs entity))
pretty-name (singularise entity-name)
entity-safe (safe-name entity :sql)
links (filter #(#{"list" "link" "entity"} (:type (:attrs %))) (children-with-tag entity :property))]
links (filter #(:entity (:attrs %)) (children-with-tag entity :property))]
(apply
merge
(map
@ -312,7 +312,7 @@
farkey (-> % :attrs :farkey)
link-type (-> % :attrs :type)
link-field (-> % :attrs :name)
query-name (list-related-query-name % entity far-entity)
query-name (list-related-query-name % entity far-entity false)
signature ":? :*"]
(hash-map
(keyword query-name)
@ -330,24 +330,24 @@
"entity" (list
(str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name)
(str "SELECT lv_" entity-safe ".* \nFROM lv_" entity-safe)
(str "SELECT DISTINCT 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" (let [ltn
(link-table-name % entity far-entity)]
(list
(str "-- :name " query-name " " signature)
(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 "SELECT DISTINCT lv_" safe-far ".* \nFROM lv_" safe-far ", " ltn)
(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")
" = " ltn "." (singularise safe-far) "_id")
(str "\tAND " ltn "." (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 "SELECT DISTINCT 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 " %)))))

135
src/adl/to_selmer_routes.clj
View file

@ -66,70 +66,85 @@
(defn compose-fetch-record
"Compose Clojure code to retrieve a single record of entity `e`."
[e]
"Compose Clojure code to retrieve a single record of entity `e` in application `a`; in addition
to the fields of the record in the database, the record should also contain the values of
the `link` and `list` properties of the entity, retrieved from their tables.
TODO: what about `entity` properties?."
[e a]
(let
[entity-name (singularise (:name (:attrs e)))
warning (str
"Error while fetching "
entity-name
" record")]
"Error while fetching "
entity-name
" record")]
(list
'if
(list
'all-keys-present?
'params (set (map #(keyword (safe-name % :sql)) (key-names e))))
(list
'support/do-or-log-error
'if
(list
(query-name e :get)
(symbol "db/*db*")
'params)
:message warning
:error-return {:warnings [warning]})
'params)))
'all-keys-present?
'params (set (map #(keyword (safe-name % :sql)) (key-names e))))
(list
'support/do-or-log-error
(cons
'merge
(cons
(list
(query-name e :get)
(symbol "db/*db*")
'params)
(map
#(let [farside (entity-for-property % a)
farkey (keyword (or (:farkey %) (first (key-names farside))))]
{(keyword (-> % :attrs :name))
(list
'map
(keyword (first (key-names farside)))
(list
(symbol
(str "db/" (list-related-query-name % e farside)))
'db/*db*
{farkey (list (keyword (first (key-names e))) 'params)}))})
(filter
#(#{"link" "list"} (-> % :attrs :type))
(properties e)))))
:message warning
:error-return {:warnings [warning]})
'params)))
(defn compose-get-menu-options
"Compose Clojure code to fetch from the database menu options for this
`property` within this `application`."
[property application]
;; TODO: doesn't handle the case of type="link"
(case (-> property :attrs :type)
("entity" "link" "list")
(if-let [e (child-with-tag
application
:entity
#(= (-> % :attrs :name)
(-> property :attrs :entity)))]
(hash-map
(keyword (-> property :attrs :name))
[property nearside application]
(if-let [farside (entity-for-property property application)]
(hash-map
(keyword (-> property :attrs :name))
(list
'sort-by
(keyword (first (user-distinct-property-names farside)))
(list
'get-menu-options
(singularise (-> e :attrs :name))
(query-name e :search-strings)
(query-name e :search-strings)
(keyword (-> property :attrs :farkey))
(list (keyword (-> property :attrs :name)) 'record)))
{})
;; "link" (list
;; 'do
;; (list
;; 'comment
;; "Can't yet handle link properties")
;; {})
;; "list" (list
;; 'do
;; (list
;; 'comment
;; "Can't yet handle link properties")
;; {})
(list
'do
(list
'comment
(str "Unexpected type " (-> property :atts :type)))
{})))
'set
(list
'get-menu-options
(singularise (-> farside :attrs :name))
(case
(-> property :attrs :type)
("list" "link")
(list-related-query-name property nearside farside true)
"entity"
(query-name farside :get))
(query-name farside :search-strings)
(keyword (or (-> property :attrs :farkey)
(first (key-names farside))))
(list
(keyword
(case
(-> property :attrs :type)
("link" "list")
(first (key-names nearside))
"entity"
(-> property :attrs :name)))
'record)))))
(throw (Exception. (str "Unexpected type " (-> property :atts :type))))))
(defn compose-fetch-auxlist-data
@ -147,7 +162,7 @@
(hash-map
(keyword (auxlist-data-name auxlist))
(list
(symbol (str "db/" (list-related-query-name property entity farside)))
(list-related-query-name property entity farside true)
'db/*db*
{:id
(list
@ -182,7 +197,7 @@
(list
'let
(vector
'record (compose-fetch-record e))
'record (compose-fetch-record e a))
(list
'reduce
'merge
@ -201,9 +216,11 @@
'list
(concat
(map
#(compose-get-menu-options % a)
(filter #(:entity (:attrs %))
(descendants-with-tag e :property)))
#(compose-get-menu-options % e a)
(descendants-with-tag
e
:property
#(#{"link" "list" "entity"} (-> % :attrs :type))))
(map
#(compose-fetch-auxlist-data % e a)
(descendants-with-tag f :auxlist))
@ -221,7 +238,7 @@
(list
'let
(vector
'record (compose-fetch-record e))
'record (compose-fetch-record e a))
{:warnings (list :warnings 'record)
:record (list 'assoc 'record :warnings nil)}))

27
src/adl/to_selmer_templates.clj
View file

@ -273,14 +273,25 @@
;; Yes, I know it looks BONKERS generating this as an HTML string. But
;; there is a reason. We don't know whether the `selected` attribute
;; should be present or absent until rendering.
[(str "{% for option in " (-> property :attrs :name)
" %}<option value='{{option."
farkey
"}}' {% ifequal record."
(-> property :attrs :name)
" option." farkey "%}selected='selected'{% endifequal %}>"
"{{option." (select-field-name farside)
"}}</option>{% endfor %}")]))
(case (-> property :attrs :type)
"entity"
[(str "{% for option in " (-> property :attrs :name)
" %}<option value='{{option."
farkey
"}}' {% ifequal record."
(-> property :attrs :name)
" option." farkey "%}selected='selected'{% endifequal %}>"
"{{option." (select-field-name farside)
"}}</option>{% endfor %}")]
("list" "link")
[(str "{% for option in " (-> property :attrs :name)
" %}<option value='{{option."
farkey
"}}' {% ifcontains record."
(-> property :attrs :name)
" option." farkey " %}selected='selected'{% endifcontains %}>"
"{{option." (select-field-name farside)
"}}</option>{% endfor %}")])))
(defn widget-type