From a7934d70b9ac7ad55819a440a25140a7ac46da40 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 4 Oct 2018 19:13:28 +0100 Subject: [PATCH] Making multi-select menus work Major changes, may be regressions. --- src/adl/to_hugsql_queries.clj | 16 ++-- src/adl/to_selmer_routes.clj | 135 ++++++++++++++++++-------------- src/adl/to_selmer_templates.clj | 27 +++++-- 3 files changed, 103 insertions(+), 75 deletions(-) diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj index 9b86ce8..b10b2bd 100644 --- a/src/adl/to_hugsql_queries.clj +++ b/src/adl/to_hugsql_queries.clj @@ -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 " %))))) diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj index 3382015..a6d9bc6 100644 --- a/src/adl/to_selmer_routes.clj +++ b/src/adl/to_selmer_routes.clj @@ -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)})) diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj index 0939b04..5f92349 100644 --- a/src/adl/to_selmer_templates.clj +++ b/src/adl/to_selmer_templates.clj @@ -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) - " %}{% endfor %}")])) + (case (-> property :attrs :type) + "entity" + [(str "{% for option in " (-> property :attrs :name) + " %}{% endfor %}")] + ("list" "link") + [(str "{% for option in " (-> property :attrs :name) + " %}{% endfor %}")]))) (defn widget-type