Work on ADL issue #3, auxlists.

src/adl_support/core.clj

@@ -101,6 +101,43 @@
 (def resolve-template (memoize raw-resolve-template))
 
 
+(defmacro compose-exception-reason
+  "Compose and return a sensible reason message for this `exception`."
+  ([exception intro]
+   `(str
+     ~intro
+     (if ~intro ": ")
+     (join
+      "\n\tcaused by: "
+      (reverse
+       (loop [ex# ~exception result# ()]
+         (if-not (nil? ex#)
+           (recur
+            (.getCause ex#)
+            (cons (str
+                   (.getName (.getClass ex#))
+                   ": "
+                   (.getMessage ex#)) result#))
+           result#))))))
+  ([exception]
+   `(compose-exception-reason ~exception nil)))
+
+
+(defmacro compose-reason-and-log
+  "Compose a reason message for this `exception`, log it (with its
+  stacktrace), and return the reason message."
+  ([exception intro]
+   `(let [reason# (compose-exception-reason ~exception ~intro)]
+      (clojure.tools.logging/error
+       reason#
+       "\n"
+       (with-out-str
+         (-> ~exception .printStackTrace)))
+      reason#))
+  ([exception]
+   `(compose-reason-and-log ~exception nil)))
+
+
 (defmacro do-or-log-error
   "Evaluate the supplied `form` in a try/catch block. If the
   keyword param `:message` is supplied, the value will be used
@@ -112,54 +149,23 @@
   `(try
      ~form
      (catch Exception any#
-       (clojure.tools.logging/error
-        (str ~message
-             (with-out-str
-               (-> any# .printStackTrace))))
+       (compose-reason-and-log any# ~message)
        ~error-return)))
 
 
-(defmacro compose-exception-reason
-  "Compose and return a sensible reason message for this `exception`."
-  [exception]
-  `(join
-    "\n\tcaused by: "
-    (reverse
-     (loop [ex# ~exception result# ()]
-       (if-not (nil? ex#)
-         (recur
-          (.getCause ex#)
-          (cons (str
-                 (.getName (.getClass ex#))
-                 ": "
-                 (.getMessage ex#)) result#))
-         result#)))))
-
-
-(defmacro compose-reason-and-log
-  "Compose a reason message for this `exception`, log it (with its
-  stacktrace), and return the reason message."
-  [exception]
-  `(let [reason# (compose-exception-reason ~exception)]
-     (clojure.tools.logging/error
-      (str reason#
-           "\n"
-           (with-out-str
-             (-> ~exception .printStackTrace))))
-     reason#))
-
-
 (defmacro do-or-return-reason
   "Clojure stacktraces are unreadable. We have to do better; evaluate
   this `form` in a try-catch block; return a map. If the evaluation
   succeeds, the map will have a key `:result` whose value is the result;
   otherwise it will have a key `:error` which will be bound to the most
   sensible error message we can construct."
-  [form]
+  ([form intro]
   `(try
      {:result ~form}
      (catch Exception any#
-       {:error (compose-exception-reason any#)})))
+       {:error (compose-exception-reason any# ~intro)})))
+  ([form]
+   `(do-or-return-reason ~form nil)))
 
 
 (defmacro do-or-log-and-return-reason
@@ -205,6 +211,6 @@
    `(try
       ~form
       (catch Exception any#
-        (*warn* (str ~intro ":\n\t" (compose-reason-and-log any#)))
+        (*warn* (compose-reason-and-log any# ~intro ))
         nil))))
 

src/adl_support/forms_support.clj

@@ -57,13 +57,9 @@
       :message message#
       :error-return {:warnings [message#]})))
 
-;; (macroexpand '(get-current-value str {:foo "bar" :ban 2} "addresses"))
-
 
 (defmacro get-menu-options
-  ;; TODO: constructing these query-method names at runtime is madness.
-  ;; we definitely need to construct them at compile time.
-  [entity-name fk value]
+  [entity-name get-q list-q fk value]
   `(remove
     nil?
     (flatten
@@ -72,45 +68,25 @@
         ~value
         (do-or-log-error
          (apply
-          (symbol (str "db/" (query-name ~entity-name :get)))
+          ~get-q
           (list db/*db* {~fk ~value}))
          :message
          (str "Error while fetching " ~entity-name " record '" ~value "'")))
       (do-or-log-error
        (apply
-        (symbol (str "db/" (query-name ~entity-name :list)))
-        (list db/*db*))
+        ~list-q
+        (list db/*db*)
+        {})
        :message
        (str "Error while fetching " ~entity-name " list"))))))
 
 
-;; (macroexpand '(get-menu-options "addresses" :address-id 7))
+(defmacro auxlist-data-name
+  "The name to which data for this `auxlist` will be bound in the
+  Selmer params."
+ [auxlist]
+ `(safe-name (str "auxlist-" (-> ~auxlist :attrs :property)) :clojure))
 
-;; (clojure.core/remove
-;;  clojure.core/nil?
-;;  (clojure.core/flatten
-;;   (clojure.core/list
-;;    (if
-;;      7
-;;      (adl-support.core/do-or-log-error
-;;       (clojure.core/apply
-;;        (clojure.core/symbol
-;;         (clojure.core/str
-;;          "db/"
-;;          (adl-support.forms-support/query-name "addresses" :get)))
-;;        (clojure.core/list
-;;         db/*db*
-;;         {:address-id 7}))
-;;       :message
-;;       (clojure.core/str "Error while fetching " "addresses" " record '" 7 "'")))
-;;    (adl-support.core/do-or-log-error
-;;     (clojure.core/apply
-;;      (clojure.core/symbol
-;;       (clojure.core/str "db/"
-;;                         (adl-support.forms-support/query-name "addresses" :list)))
-;;      (clojure.core/list db/*db*))
-;;     :message
-;;     (clojure.core/str "Error while fetching " "addresses" " list")))))
 
 (defmacro all-keys-present?
   "Return true if all the keys in `keys` are present in the map `m`."

src/adl_support/utils.clj

@@ -1,7 +1,8 @@
 (ns ^{:doc "Application Description Language support library - utility functions."
       :author "Simon Brooke"}
   adl-support.utils
-  (:require [clojure.math.numeric-tower :refer [expt]]
+  (:require [adl-support.core :refer [*warn*]]
+            [clojure.math.numeric-tower :refer [expt]]
             [clojure.pprint :as p]
             [clojure.string :as s]))
 
@@ -42,6 +43,12 @@
   (and (map? o) (:tag o) (:attrs o)))
 
 
+(defmacro entity?
+  "True if `o` is a Clojure representation of an ADL entity."
+  [o]
+  `(= (:tag ~o) :entity))
+
+
 (defn wrap-lines
   "Wrap lines in this `text` to this `width`; return a list of lines."
   ;; Shamelessly adapted from https://www.rosettacode.org/wiki/Word_wrap#Clojure
@@ -294,22 +301,45 @@
   "Return a safe name for the object `o`, given the specified `convention`.
   `o` is expected to be either a string or an element."
   ([o]
-   (if
-     (element? o)
-     (safe-name (:name (:attrs o)))
-     (s/replace (str o) #"[^a-zA-Z0-9-]" "")))
+   (cond
+    (element? o)
+    (safe-name (:name (:attrs o)))
+    true
+    (s/replace (str o) #"[^a-zA-Z0-9-]" "")))
   ([o convention]
-   (if
-     (element? o)
-     (safe-name (:name (:attrs o)) convention)
-     (let [string (str o)]
-       (case convention
-         (:sql :c) (s/replace string #"[^a-zA-Z0-9_]" "_")
-         :c-sharp (s/replace (capitalise string) #"[^a-zA-Z0-9]" "")
-         :java (let
-                 [camel (s/replace (capitalise string) #"[^a-zA-Z0-9]" "")]
-                 (apply str (cons (Character/toLowerCase (first camel)) (rest camel))))
-         (safe-name string))))))
+   (cond
+    (and (entity? o) (= convention :sql))
+    ;; if it's an entity, it's permitted to have a different table name
+    ;; from its entity name. This isn't actually likely, but...
+    (safe-name (or (-> o :attrs :table) (-> o :attrs :name)) :sql)
+    (element? o)
+    (safe-name (:name (:attrs o)))
+    true
+    (let [string (str o)]
+      (case convention
+        (:sql :c) (s/replace string #"[^a-zA-Z0-9_]" "_")
+        :c-sharp (s/replace (capitalise string) #"[^a-zA-Z0-9]" "")
+        :java (let
+                [camel (s/replace (capitalise string) #"[^a-zA-Z0-9]" "")]
+                (apply str (cons (Character/toLowerCase (first camel)) (rest camel))))
+        (safe-name string))))))
+
+
+(defmacro list-related-query-name
+  "Return the canonical name of the HugSQL query to return all records on
+  `farside` which match a given record on `nearside`, where `nearide` and
+  `farside` are both entities."
+  [nearside farside]
+  `(if
+     (and (entity? ~nearside) (entity? ~farside))
+     (str
+      "list-"
+      (safe-name ~farside :sql)
+      "-by-"
+      (singularise (safe-name ~nearside :sql)))
+     (do
+       (*warn* "Argument passed to `list-related-query-name` was a non-entity")
+       nil)))
 
 
 (defn property-for-field