Allow for multiple distinct links between the same two entities.

src/adl/to_hugsql_queries.clj

@@ -306,7 +306,7 @@
                                     "\n\tAND " entity-name "." link-field " = :id")
                                (order-by-clause entity "lv_"))
                     "link" (let [link-table-name
-                                 (link-table-name entity far-entity)]
+                                 (link-table-name % entity far-entity)]
                              (list
                                (str "-- :name " query-name " " signature)
                                (str "-- :doc links all existing " pretty-name " records related to a given " pretty-far)

src/adl/to_json_routes.clj

@@ -37,6 +37,12 @@
 ;;; to-hugsql-queries, because essentially we need one JSON entry point to wrap
 ;;; each query.
 
+;;; TODO: memoisation of handlers probably doesn't make sense, because every request
+;;; will be different. I don't think we can memoise HugSQL, at least not without
+;;; hacking the library (might be worth doing that and contributing a patch).
+;;; So the solution may be to an intervening namespace 'cache', which has one
+;;; memoised function for each hugsql query.
+
 (defn file-header [application]
   (list
     'ns
@@ -65,21 +71,25 @@
 (defn generate-handler-body
   "Generate and return the function body for the handler for this `query`."
   [query]
-  (list
+  (let [action (list
-    [{:keys ['params 'form-params]}]
+                 (symbol (str "db/" (:name query)))
-    (list 'let
+                 'db/*db*
-          (vector
+                 (list 'support/massage-params
-            'result
+                       'params
-            (list
+                       'form-params
-              (symbol (str "db/" (:name query)))
+                       (key-names (:entity query))))]
-              'db/*db*
+    (list
-              (list 'support/massage-params
+     [{:keys ['params 'form-params]}]
-                    'params 'form-params (key-names (:entity query)))))
+     (case
-          (case
+       (:type query)
-            (:type query)
+       (:delete-1 :update-1)
-            (:delete-1 :update-1)
+       (list
-            '(response/found "/")
+         action
-            (list 'response/ok 'result)))))
+         '(response/found "/"))
+       (list
+         'let
+         (vector 'result action)
+         (list 'response/ok 'result))))))
 
 
 (defn generate-handler-src

src/adl/to_psql.clj

@@ -461,7 +461,7 @@
              #(and
                 (entity? %)
                 (= (:name (:attrs %)) (:entity (:attrs property)))))
-        link-table-name (link-table-name e1 e2)]
+        link-table-name (link-table-name property e1 e2)]
     (if
       ;; we haven't already emitted this one...
       (not (@emitted-link-tables link-table-name))

src/adl/to_selmer_templates.clj

@@ -146,15 +146,16 @@
   ([field-or-property form entity application]
    (prompt field-or-property))
   ([field-or-property]
-   (or
+   (capitalise
-     (first
+     (or
-       (children
+       (first
-         field-or-property
+         (children
-         #(and
+           field-or-property
-            (= (:tag %) :prompt)
+           #(and
-            (= (:locale :attrs %) *locale*))))
+              (= (:tag %) :prompt)
-     (:name (:attrs field-or-property))
+              (= (:locale :attrs %) *locale*))))
-     (:property (:attrs field-or-property)))))
+       (:name (:attrs field-or-property))
+       (:property (:attrs field-or-property))))))
 
 
 (defn csrf-widget