diff --git a/src/adl_support/core.clj b/src/adl_support/core.clj index 141fe3c..609a659 100644 --- a/src/adl_support/core.clj +++ b/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)))) diff --git a/src/adl_support/forms_support.clj b/src/adl_support/forms_support.clj index 88c9279..a2d1522 100644 --- a/src/adl_support/forms_support.clj +++ b/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`." diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index b132c82..0aed4bf 100644 --- a/src/adl_support/utils.clj +++ b/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 diff --git a/test/adl_support/core_test.clj b/test/adl_support/core_test.clj index 0a8ea05..d1b3087 100644 --- a/test/adl_support/core_test.clj +++ b/test/adl_support/core_test.clj @@ -52,7 +52,10 @@ (is (= expected actual) "No exception thrown")) (let [expected {:error "java.lang.ArithmeticException: Divide by zero"} actual (do-or-return-reason (/ 1 0))] - (is (= expected actual) "Exception thrown")))) + (is (= expected actual) "Exception thrown")) + (let [expected {:error "Hello: java.lang.ArithmeticException: Divide by zero"} + actual (do-or-return-reason (/ 1 0) "Hello")] + (is (= expected actual) "Exception thrown, with intro")))) ;; These work in REPL, but break in tests. Why? diff --git a/test/adl_support/forms_support_test.clj b/test/adl_support/forms_support_test.clj new file mode 100644 index 0000000..96b5755 --- /dev/null +++ b/test/adl_support/forms_support_test.clj @@ -0,0 +1,16 @@ + +(ns adl-support.forms-support-test + (:require [clojure.test :refer :all] + [adl-support.forms-support :refer :all])) + + +(deftest auxlist-data-name-test + (testing "auxlist-data-name" + (let [auxlist {:tag :auxlist, + :attrs {:property "dwellings"}, + :content [{:tag :field, + :attrs {:name "sub-address"}, + :content nil}]} + expected "auxlist-dwellings" + actual (auxlist-data-name auxlist)] + (is (= expected actual) "Just checking...")))) diff --git a/test/adl_support/rest_support_test.clj b/test/adl_support/rest_support_test.clj index 97f2ed0..2f51709 100644 --- a/test/adl_support/rest_support_test.clj +++ b/test/adl_support/rest_support_test.clj @@ -1,6 +1,6 @@ -(ns adl-support.core-test +(ns adl-support.rest-support-test (:require [clojure.test :refer :all] - [adl-support.rest_support :refer :all])) + [adl-support.rest-support :refer :all])) (deftest if-valid-user-tests @@ -19,7 +19,7 @@ actual (valid-user-or-forbid "hello" {:session {:user {:id 4}}})] (is (= expected actual) "User in session")) (let [expected 403 - actual (:status (valid-user-or-forbid "hello" {:session {:user {:id 4}}}))] + actual (:status (valid-user-or-forbid "hello" {:session {}}))] (is (= expected actual) "No user in session")))) diff --git a/test/adl_support/utils_test.clj b/test/adl_support/utils_test.clj index 0ad3d8e..3aebc2c 100644 --- a/test/adl_support/utils_test.clj +++ b/test/adl_support/utils_test.clj @@ -1,5 +1,6 @@ (ns adl-support.utils-test (:require [clojure.test :refer :all] + [adl-support.core :refer [*warn*]] [adl-support.utils :refer :all])) ;; Yes, there's MASSES in utils which ought to be tested. I'll add more tests over time. @@ -304,3 +305,69 @@ with appropriate property with prompt in current locale")) )) + +(deftest list-related-query-name-tests + (testing "list-related-query-name" + (let [e1 {:tag :entity, + :attrs {:volatility "6", :magnitude "1", :name "genders", :table "genders"}, + :content [{:tag :documentation, + :content ["All genders which may be assigned to\n electors."]} + {:tag :key, :attrs nil, + :content [{:tag :property, + :attrs {:distinct "all", :size "32", :type "string", :name "id"}, + :content [{:tag :prompt, + :attrs {:locale "en_GB.UTF-8", + :prompt "Gender"}, + :content nil}]}]} + {:tag :list, :attrs {:name "Genders", :properties "all"}} + {:tag :form, :attrs {:name "Gender", :properties "all"}}]} + e2 {:tag :entity, + :attrs {:volatility "6", :magnitude "1", :name "electors", :table "electors"}, + :content [{:tag :documentation, + :attrs nil, + :content + ["All electors known to the system; electors are + people believed to be entitled to vote in the current + campaign."]} + {:tag :key, + :attrs nil, + :content + [{:tag :property, + :attrs + {:distinct "system", + :immutable "true", + :column "id", + :name "id", + :type "integer", + :required "true"}, + :content + [{:tag :generator, :attrs {:action "native"}, :content nil}]}]} + {:tag :property, + :attrs + {:distinct "user", + :column "name", + :name "name", + :type "string", + :required "true", + :size "64"}, + :content + [{:tag :prompt, + :attrs {:locale "en_GB.UTF-8", :prompt "Name"}, + :content nil}]} + {:tag :property, + :attrs + {:default "Unknown", + :farkey "id", + :entity "genders", + :column "gender", + :type "entity", + :name "gender"}, + :content + [{:tag :prompt, + :attrs {:locale "en_GB.UTF-8", :prompt "Gender"}, + :content nil}]}]} + expected "list-electors-by-gender" + actual (list-related-query-name e1 e2)] + (is (= expected actual) "just checking...")))) + +