Small improvements. More and more works.

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]

src/adl/to_selmer_routes.clj

@@ -182,28 +182,49 @@
             (list
               'l/render
               (list 'support/resolve-template (str n ".html"))
-              '(:session r)
+              (list :session 'r)
-              (merge
+              (list 'merge
                     {:title (capitalise (:name (:attrs f)))
                      :params  'p}
                     (case (:tag f)
                       (:form :page)
-                  (reduce
+                      (list
-                    merge
+                        '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))}
+                                       '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))))
+                                        (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

src/adl/to_selmer_templates.clj

@@ -114,7 +114,6 @@
      "\n"
      (flatten
        (list
-         "{% endblock %}"
          (emit-content filename spec entity application :foot))))))
 
 
@@ -238,20 +237,23 @@
         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?
+         (flatten
            (list
              (if
                async?
+               (list
                  {:tag :input
                   :attrs
                   {:name (str widget-name "_search_box")
-               :onchange (str "$.getJSON(\"/auto/json/seach-strings-" (-> farside :attrs :name)
+                   :onchange (str "$.getJSON(\"/auto/json/seach-strings-"
+                                  (-> farside :attrs :name)
                                   "?"
                                   (s/join (str "=\" + " widget-name "_search_box.text + \"&")
                                           (user-distinct-property-names farside))
@@ -261,7 +263,8 @@
                                   (first (key-names farside))
                                   "\", [\""
                                   (s/join "\", \"" (user-distinct-property-names farside))
-                              "\"], data);})")}})
+                                  "\"], data);})")}}
+                 {:tag :br}))
              {:tag :select
               :attrs (merge
                        {:id widget-name
@@ -269,7 +272,7 @@
                        (if
                          (= (:type (:attrs property)) "link")
                          {:multiple "multiple"}))
-            :content (apply vector (get-options property form entity application))})))}))
+              :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"}
     :content
-    [(slurp "resources/js/select-widget-support.js")]}
+    [(slurp "resources/js/select-widget-support.js")]})
-   "{% endblock %}"])
 
 
 (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
+     (conj
        (apply
          vector
          (map
            #(hash-map
               :content [(prompt %)]
               :tag :th)
-         (children-with-tag list-spec :field)))}
+           (children-with-tag list-spec :field)))
+       {:tag :th :content [" "]})}
     {:tag :tr
      :content
      (apply