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)) (let [entity-name (:name (:attrs entity))
pretty-name (singularise entity-name) pretty-name (singularise entity-name)
entity-safe (safe-name entity :sql) 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 (apply
merge merge
(map (map
@ -312,7 +312,7 @@
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 % entity far-entity) query-name (list-related-query-name % entity far-entity false)
signature ":? :*"] signature ":? :*"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)
@ -330,24 +330,24 @@
"entity" (list "entity" (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name) (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") (str "WHERE lv_" entity-safe "." (safe-name % :sql) " = :id")
(order-by-clause entity "lv_" false)) (order-by-clause entity "lv_" false))
"link" (let [link-table-name "link" (let [ltn
(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-far " records related to a given " pretty-name) (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 "." (str "WHERE lv_" safe-far "."
(safe-name (first (key-names far-entity)) :sql) (safe-name (first (key-names far-entity)) :sql)
" = " link-table-name "." (singularise safe-far) "_id") " = " ltn "." (singularise safe-far) "_id")
(str "\tAND " link-table-name "." (singularise entity-safe) "_id = :id") (str "\tAND " ltn "." (singularise entity-safe) "_id = :id")
(order-by-clause far-entity "lv_" false))) (order-by-clause far-entity "lv_" false)))
"list" (list "list" (list
(str "-- :name " query-name " " signature) (str "-- :name " query-name " " signature)
(str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name) (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") (str "WHERE lv_" safe-far "." (safe-name (first (key-names far-entity)) :sql) " = :id")
(order-by-clause far-entity "lv_" false)) (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 " %)))))

135
src/adl/to_selmer_routes.clj
View file

@ -66,70 +66,85 @@
(defn compose-fetch-record (defn compose-fetch-record
"Compose Clojure code to retrieve a single record of entity `e`." "Compose Clojure code to retrieve a single record of entity `e` in application `a`; in addition
[e] 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 (let
[entity-name (singularise (:name (:attrs e))) [entity-name (singularise (:name (:attrs e)))
warning (str warning (str
"Error while fetching " "Error while fetching "
entity-name entity-name
" record")] " record")]
(list (list
'if 'if
(list
'all-keys-present?
'params (set (map #(keyword (safe-name % :sql)) (key-names e))))
(list
'support/do-or-log-error
(list (list
(query-name e :get) 'all-keys-present?
(symbol "db/*db*") 'params (set (map #(keyword (safe-name % :sql)) (key-names e))))
'params) (list
:message warning 'support/do-or-log-error
:error-return {:warnings [warning]}) (cons
'params))) '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 (defn compose-get-menu-options
"Compose Clojure code to fetch from the database menu options for this "Compose Clojure code to fetch from the database menu options for this
`property` within this `application`." `property` within this `application`."
[property application] [property nearside application]
;; TODO: doesn't handle the case of type="link" (if-let [farside (entity-for-property property application)]
(case (-> property :attrs :type) (hash-map
("entity" "link" "list") (keyword (-> property :attrs :name))
(if-let [e (child-with-tag (list
application 'sort-by
:entity (keyword (first (user-distinct-property-names farside)))
#(= (-> % :attrs :name)
(-> property :attrs :entity)))]
(hash-map
(keyword (-> property :attrs :name))
(list (list
'get-menu-options 'set
(singularise (-> e :attrs :name)) (list
(query-name e :search-strings) 'get-menu-options
(query-name e :search-strings) (singularise (-> farside :attrs :name))
(keyword (-> property :attrs :farkey)) (case
(list (keyword (-> property :attrs :name)) 'record))) (-> property :attrs :type)
{}) ("list" "link")
;; "link" (list (list-related-query-name property nearside farside true)
;; 'do "entity"
;; (list (query-name farside :get))
;; 'comment (query-name farside :search-strings)
;; "Can't yet handle link properties") (keyword (or (-> property :attrs :farkey)
;; {}) (first (key-names farside))))
;; "list" (list (list
;; 'do (keyword
;; (list (case
;; 'comment (-> property :attrs :type)
;; "Can't yet handle link properties") ("link" "list")
;; {}) (first (key-names nearside))
(list "entity"
'do (-> property :attrs :name)))
(list 'record)))))
'comment (throw (Exception. (str "Unexpected type " (-> property :atts :type))))))
(str "Unexpected type " (-> property :atts :type)))
{})))
(defn compose-fetch-auxlist-data (defn compose-fetch-auxlist-data
@ -147,7 +162,7 @@
(hash-map (hash-map
(keyword (auxlist-data-name auxlist)) (keyword (auxlist-data-name auxlist))
(list (list
(symbol (str "db/" (list-related-query-name property entity farside))) (list-related-query-name property entity farside true)
'db/*db* 'db/*db*
{:id {:id
(list (list
@ -182,7 +197,7 @@
(list (list
'let 'let
(vector (vector
'record (compose-fetch-record e)) 'record (compose-fetch-record e a))
(list (list
'reduce 'reduce
'merge 'merge
@ -201,9 +216,11 @@
'list 'list
(concat (concat
(map (map
#(compose-get-menu-options % a) #(compose-get-menu-options % e a)
(filter #(:entity (:attrs %)) (descendants-with-tag
(descendants-with-tag e :property))) e
:property
#(#{"link" "list" "entity"} (-> % :attrs :type))))
(map (map
#(compose-fetch-auxlist-data % e a) #(compose-fetch-auxlist-data % e a)
(descendants-with-tag f :auxlist)) (descendants-with-tag f :auxlist))
@ -221,7 +238,7 @@
(list (list
'let 'let
(vector (vector
'record (compose-fetch-record e)) 'record (compose-fetch-record e a))
{:warnings (list :warnings 'record) {:warnings (list :warnings 'record)
:record (list 'assoc 'record :warnings nil)})) :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 ;; 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 ;; there is a reason. We don't know whether the `selected` attribute
;; should be present or absent until rendering. ;; should be present or absent until rendering.
[(str "{% for option in " (-> property :attrs :name) (case (-> property :attrs :type)
" %}<option value='{{option." "entity"
farkey [(str "{% for option in " (-> property :attrs :name)
"}}' {% ifequal record." " %}<option value='{{option."
(-> property :attrs :name) farkey
" option." farkey "%}selected='selected'{% endifequal %}>" "}}' {% ifequal record."
"{{option." (select-field-name farside) (-> property :attrs :name)
"}}</option>{% endfor %}")])) " 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 (defn widget-type