diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj index 3da9fd6..0dabffd 100644 --- a/src/adl/to_hugsql_queries.clj +++ b/src/adl/to_hugsql_queries.clj @@ -114,10 +114,6 @@ (defn update-query "Generate an appropriate `update` query for this `entity`" [entity] - (if - (and - (has-primary-key? entity) - (has-non-key-properties? entity)) (let [entity-name (safe-name (:name (:attrs entity)) :sql) pretty-name (singularise entity-name) property-names (map #(:name (:attrs %)) (insertable-properties entity)) @@ -136,8 +132,7 @@ "SET " (s/join ",\n\t" (map #(str (safe-name % :sql) " = " (keyword %)) property-names)) "\n" - (where-clause entity))})) - {})) + (where-clause entity))}))) (defn search-query [entity application] diff --git a/src/adl/to_selmer_routes.clj b/src/adl/to_selmer_routes.clj index ed4fe70..e016a3f 100644 --- a/src/adl/to_selmer_routes.clj +++ b/src/adl/to_selmer_routes.clj @@ -182,28 +182,49 @@ (list 'l/render (list 'support/resolve-template (str n ".html")) - '(:session r) - (merge - {:title (capitalise (:name (:attrs f))) - :params 'p} - (case (:tag f) - (:form :page) - (reduce - merge - {:record - (list 'if (list 'empty? (list 'remove 'nil? (list 'vals 'p))) [] - (list - (symbol - (str "db/get-" (singularise (:name (:attrs e))))) - (symbol "db/*db*") - 'p))} - (map - (fn [p] - (hash-map - (keyword (-> p :attrs :entity)) - (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*")))) - (filter #(#{"entity" "link"} (:type (:attrs %))) - (descendants-with-tag e :property)))) + (list :session 'r) + (list 'merge + {:title (capitalise (:name (:attrs f))) + :params 'p} + (case (:tag f) + (:form :page) + (list + 'reduce + 'merge + (list 'merge + (list 'cond (list :save-button 'p) + (list 'try + (list 'if + (list 'some (key-names e) (list 'map 'name (list 'keys 'p))) + (list 'do + (list (symbol + (str "db/update-" (singularise (-> e :attrs :name)) "!")) + 'db/*db* + 'p) + {:message "Updated record"}) + (list 'do + (list (symbol + (str "db/create-" (singularise (-> e :attrs :name)) "!")) + 'db/*db* + 'p) + {:message "Saved record"})) + `(catch Exception any# + {:error (.getMessage any#)}))) + {:record + (list 'if (list 'empty? (list 'remove 'nil? (list 'vals 'p))) [] + (list + (symbol + (str "db/get-" (singularise (:name (:attrs e))))) + (symbol "db/*db*") + 'p))}) + (cons 'list + (map + (fn [p] + (hash-map + (keyword (-> p :attrs :entity)) + (list (symbol (str "db/list-" (:entity (:attrs p)))) (symbol "db/*db*")))) + (filter #(#{"entity" "link"} (:type (:attrs %))) + (descendants-with-tag e :property))))) :list {:records (list @@ -231,6 +252,7 @@ ;; (def e (child-with-tag a :entity)) ;; (def f (child-with-tag e :form)) ;; (def n (path-part f e a)) +;; (make-handler f e a) ;; (vector ;; 'p ;; (list 'merge diff --git a/src/adl/to_selmer_templates.clj b/src/adl/to_selmer_templates.clj index 011aad2..bd2b89d 100644 --- a/src/adl/to_selmer_templates.clj +++ b/src/adl/to_selmer_templates.clj @@ -114,7 +114,6 @@ "\n" (flatten (list - "{% endblock %}" (emit-content filename spec entity application :foot)))))) @@ -238,38 +237,42 @@ magnitude (try (read-string (:magnitude (:attrs farside))) (catch Exception _ 7)) async? (and (number? magnitude) (> magnitude 1)) widget-name (safe-name (:name (:attrs property)) :sql)] - {:tag :div + {:tag :span :attrs {:class "select-box" :farside farname :found (if farside "true" "false")} :content (apply vector (remove nil? - (list - (if - async? - {:tag :input - :attrs - {:name (str widget-name "_search_box") - :onchange (str "$.getJSON(\"/auto/json/seach-strings-" (-> farside :attrs :name) - "?" - (s/join (str "=\" + " widget-name "_search_box.text + \"&") - (user-distinct-property-names farside)) - (str "=\" + " widget-name "_search_box.text") - ", null, function (data) {updateMenuOptions(\"" - widget-name "\", \"" - (first (key-names farside)) - "\", [\"" - (s/join "\", \"" (user-distinct-property-names farside)) - "\"], data);})")}}) - {:tag :select - :attrs (merge - {:id widget-name - :name widget-name} - (if - (= (:type (:attrs property)) "link") - {:multiple "multiple"})) - :content (apply vector (get-options property form entity application))})))})) + (flatten + (list + (if + async? + (list + {:tag :input + :attrs + {:name (str widget-name "_search_box") + :onchange (str "$.getJSON(\"/auto/json/seach-strings-" + (-> farside :attrs :name) + "?" + (s/join (str "=\" + " widget-name "_search_box.text + \"&") + (user-distinct-property-names farside)) + (str "=\" + " widget-name "_search_box.text") + ", null, function (data) {updateMenuOptions(\"" + widget-name "\", \"" + (first (key-names farside)) + "\", [\"" + (s/join "\", \"" (user-distinct-property-names farside)) + "\"], data);})")}} + {:tag :br})) + {:tag :select + :attrs (merge + {:id widget-name + :name widget-name} + (if + (= (:type (:attrs property)) "link") + {:multiple "multiple"})) + :content (apply vector (get-options property form entity application))}))))})) (defn compose-if-member-of-tag @@ -378,11 +381,9 @@ (defn compose-select-script-header [entity application] - ["{% block extra-head %}" - {:tag :script :attrs {:type "text/javascript"} + {:tag :script :attrs {:type "text/javascript"} :content - [(slurp "resources/js/select-widget-support.js")]} - "{% endblock %}"]) + [(slurp "resources/js/select-widget-support.js")]}) (defn form-to-template @@ -417,7 +418,7 @@ (delete-widget form entity application)))}]}} (if (some #(= "select" (widget-type % application)) (properties entity)) - {:header (compose-select-script-header entity application)} + {:extra-head (compose-select-script-header entity application)} {}))) @@ -467,13 +468,15 @@ :content [{:tag :tr :content - (apply - vector - (map - #(hash-map - :content [(prompt %)] - :tag :th) - (children-with-tag list-spec :field)))} + (conj + (apply + vector + (map + #(hash-map + :content [(prompt %)] + :tag :th) + (children-with-tag list-spec :field))) + {:tag :th :content [" "]})} {:tag :tr :content (apply