From 6921ca99e4b3f5ba092a48eecab5b860ae47127a Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 20 Jul 2018 14:07:33 +0100 Subject: [PATCH 01/25] Added *warn* --- src/adl_support/core.clj | 8 ++++++++ src/adl_support/utils.clj | 4 +--- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/src/adl_support/core.clj b/src/adl_support/core.clj index ccfee77..328ff6c 100644 --- a/src/adl_support/core.clj +++ b/src/adl_support/core.clj @@ -18,6 +18,14 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def ^:dynamic *warn* + "The idea here is to have a function with which to show warnings to the user, + which can be dynamically bound. Any binding should be a function of one + argument, which it should print, log, or otherwise display." + (fn [s] (println s))) + + (defn query-string-to-map "A `query-string` - the query-part of a URL - comprises generally `=&=...`; reduce such a string to a map. diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index 91cec89..191961d 100644 --- a/src/adl_support/utils.clj +++ b/src/adl_support/utils.clj @@ -3,9 +3,7 @@ adl-support.utils (:require [clojure.math.numeric-tower :refer [expt]] [clojure.pprint :as p] - [clojure.string :as s] - [clojure.tools.logging :as log] - [clojure.xml :as x])) + [clojure.string :as s])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; From 90a46ab32d12da0ee023e9e725711e7604e9d97d Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 20 Jul 2018 15:39:44 +0100 Subject: [PATCH 02/25] Really just messing around I know I'll have version control hell when I merge this back to Fletcher... But it now supports the leiningen plugin. --- LICENSE.md | 8 ++++---- project.clj | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/LICENSE.md b/LICENSE.md index e1c3eab..d87eac8 100644 --- a/LICENSE.md +++ b/LICENSE.md @@ -1,7 +1,7 @@ -The MIT License (MIT) +# The MIT License (MIT) -Copyright (c) 2018 +## Copyright (c) Simon Brooke 2018 Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal @@ -13,10 +13,10 @@ furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +**THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. +SOFTWARE.** diff --git a/project.clj b/project.clj index c0e28ce..7b3b8cd 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject adl-support "0.1.0" +(defproject adl-support "0.1.1-SNAPSHOT" :description "A small library of functions called by generated ADL code." :url "http://example.com/FIXME" :license {:name "MIT License" From 938e36eabba2bd5112af300789aa56a2e5694b4d Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 20 Jul 2018 17:34:08 +0100 Subject: [PATCH 03/25] Updated CHANGELOG to remove boilerplate --- CHANGELOG.md | 15 +-------------- 1 file changed, 1 insertion(+), 14 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 94f2b99..c469dda 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,23 +2,10 @@ All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/). ## [Unreleased] -### Changed -- Add a new arity to `make-widget-async` to provide a different widget shape. - -## [0.1.1] - 2018-06-17 -### Changed -- Documentation on how to make the widgets. - -### Removed -- `make-widget-sync` - we're all async, all the time. - -### Fixed -- Fixed widget maker to keep working when daylight savings switches over. ## 0.1.0 - 2018-06-17 ### Added -- Files from the new template. -- Widget maker public API - `make-widget-sync`. +Initial release. [Unreleased]: https://github.com/your-name/adl-support/compare/0.1.1...HEAD [0.1.1]: https://github.com/your-name/adl-support/compare/0.1.0...0.1.1 From 267f3cf874321c6e486016b3509926f038feb5b8 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 21 Jul 2018 10:48:35 +0100 Subject: [PATCH 04/25] Upversion to 0.1.4-SNAPSHOT --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 6b7163c..5e75697 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject adl-support "0.1.3" +(defproject adl-support "0.1.4-SNAPSHOT" :description "A small library of functions called by generated ADL code." :url "https://github.com/simon-brooke/adl-support" :license {:name "MIT License" From 710bfbef81a866d0dd548a272e71182416b2f8a2 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 21 Jul 2018 19:05:04 +0100 Subject: [PATCH 05/25] Updated README, and added clojars badge. --- README.md | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index a6d5430..61793e1 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,15 @@ # adl-support -A Clojure library designed to support auto-generated ADL code. This library should normally be included into projects generated by ADL, and consequently is licenced under the MIT license, which is less restrictive than the GNU General Public License which I normally use. +A Clojure library designed to support auto-generated [ADL](https://github.com/simon-brooke/adl) code. This library should normally be included into projects generated by ADL, and consequently is licenced under the MIT license, which is less restrictive than the GNU General Public License which I normally use. + +[![Clojars Project](https://img.shields.io/clojars/v/adl-support.svg)](https://clojars.org/adl-support) ## Usage -FIXME +You don't really use this; code auto-generated by ADL does. ## License -Copyright © 2018 FIXME +Copyright © 2018 Simon Brooke Distributed under the MIT License. From e17a79e7c7a03bec7d0f5fbd0c64d84c1beab5c0 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 24 Jul 2018 17:53:58 +0100 Subject: [PATCH 06/25] Improved massage-params --- project.clj | 1 + src/adl_support/core.clj | 56 +++++++++++++++++++++++++--------------- 2 files changed, 36 insertions(+), 21 deletions(-) diff --git a/project.clj b/project.clj index 5e75697..f867a49 100644 --- a/project.clj +++ b/project.clj @@ -5,6 +5,7 @@ :url "https://opensource.org/licenses/MIT"} :dependencies [[org.clojure/clojure "1.8.0"] + [org.clojure/core.memoize "0.7.1"] [org.clojure/math.numeric-tower "0.0.4"] [org.clojure/tools.logging "0.3.1"] [selmer "1.10.6"]] diff --git a/src/adl_support/core.clj b/src/adl_support/core.clj index 328ff6c..34f7bb4 100644 --- a/src/adl_support/core.clj +++ b/src/adl_support/core.clj @@ -1,5 +1,6 @@ (ns adl-support.core - (:require [clojure.java.io :as io] + (:require [clojure.core.memoize :as memo] + [clojure.java.io :as io] [clojure.string :refer [split]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -66,31 +67,44 @@ {(keyword k) v}))) -(defn massage-params +(defn raw-massage-params "Sending empty strings, or numbers as strings, to the database often isn't helpful. Massage these `params` and `form-params` to eliminate these problems. We must take key field values out of just params, but we should take all other values out of form-params - because we need the key to load the form in the first place, but just accepting values of other params would allow spoofing." - [params form-params key-fields] - (let - [ks (set (map keyword key-fields))] - (reduce - merge - ;; do the keyfields first, from params - (reduce - merge - {} - (map - #(massage-value % params) - (filter - #(ks (keyword %)) - (keys params)))) - ;; then merge in everything from form-params, potentially overriding what - ;; we got from params. - (map - #(massage-value % form-params) - (keys form-params))))) + ([params form-params key-fields] + (let + [ks (set (map keyword key-fields))] + (reduce + merge + ;; do the keyfields first, from params + (reduce + merge + {} + (map + #(massage-value % params) + (filter + #(ks (keyword %)) + (keys params)))) + ;; then merge in everything from form-params, potentially overriding what + ;; we got from params. + (map + #(massage-value % form-params) + (keys form-params))))) + ([request key-fields] + (raw-massage-params (:params request) (:form-params request) key-fields)) + ([request] + (raw-massage-params (:params request) (:form-params request) #{}))) + + +(def massage-params + "Sending empty strings, or numbers as strings, to the database often isn't + helpful. Massage these `params` and `form-params` to eliminate these problems. + We must take key field values out of just params, but we should take all other + values out of form-params - because we need the key to load the form in + the first place, but just accepting values of other params would allow spoofing." + (memo/ttl raw-massage-params {} :ttl/threshold 5000)) (defn From 3e64062dcc54b72d9cb86f47adf30a38c0095fbd Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 27 Jul 2018 09:10:28 +0100 Subject: [PATCH 07/25] Updated massage-params to use params when form-params are not present. --- src/adl_support/core.clj | 56 +++++++++++++++++++++------------------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/src/adl_support/core.clj b/src/adl_support/core.clj index 34f7bb4..b7caaab 100644 --- a/src/adl_support/core.clj +++ b/src/adl_support/core.clj @@ -70,32 +70,36 @@ (defn raw-massage-params "Sending empty strings, or numbers as strings, to the database often isn't helpful. Massage these `params` and `form-params` to eliminate these problems. - We must take key field values out of just params, but we should take all other - values out of form-params - because we need the key to load the form in - the first place, but just accepting values of other params would allow spoofing." - ([params form-params key-fields] - (let - [ks (set (map keyword key-fields))] - (reduce - merge - ;; do the keyfields first, from params - (reduce - merge - {} - (map - #(massage-value % params) - (filter - #(ks (keyword %)) - (keys params)))) - ;; then merge in everything from form-params, potentially overriding what - ;; we got from params. - (map - #(massage-value % form-params) - (keys form-params))))) - ([request key-fields] - (raw-massage-params (:params request) (:form-params request) key-fields)) - ([request] - (raw-massage-params (:params request) (:form-params request) #{}))) + We must take key field values out of just params, but if form-params are present + we should take all other values out of form-params - because we need the key to + load the form in the first place. `form-params` always override `params`" + ([params form-params key-fields] + (let + [ks (set (map keyword key-fields)) + p (reduce + merge + {} + (map + #(massage-value % params) + (filter + #(ks (keyword %)) + (keys params))))] + (if + (empty? form-params) + p + (reduce + merge + ;; do the keyfields first, from params + p + ;; then merge in everything from form-params, potentially overriding what + ;; we got from params. + (map + #(massage-value % form-params) + (keys form-params)))))) + ([request key-fields] + (raw-massage-params (:params request) (:form-params request) key-fields)) + ([request] + (raw-massage-params (:params request) (:form-params request) #{}))) (def massage-params From 28e58ea03d479fa782249f482ae76c0479fa4e91 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 27 Jul 2018 16:50:33 +0100 Subject: [PATCH 08/25] Added rest-support --- src/adl_support/core.clj | 70 ++++++++++++++++------- src/adl_support/rest_support.clj | 78 ++++++++++++++++++++++++++ test/adl_support/core_test.clj | 9 ++- test/adl_support/rest_support_test.clj | 38 +++++++++++++ 4 files changed, 175 insertions(+), 20 deletions(-) create mode 100644 src/adl_support/rest_support.clj create mode 100644 test/adl_support/rest_support_test.clj diff --git a/src/adl_support/core.clj b/src/adl_support/core.clj index b7caaab..45348e2 100644 --- a/src/adl_support/core.clj +++ b/src/adl_support/core.clj @@ -52,6 +52,8 @@ (defn massage-value + "Return a map with one key, this `k` as a keyword, whose value is the binding of + `k` in map `m`, as read by read." [k m] (let [v (m k) vr (if @@ -72,30 +74,29 @@ helpful. Massage these `params` and `form-params` to eliminate these problems. We must take key field values out of just params, but if form-params are present we should take all other values out of form-params - because we need the key to - load the form in the first place. `form-params` always override `params`" + load the form in the first place. `form-params` always override `params`. + + **NOTE THAT** the parameter `key-fields` is deprecated and ignored." ([params form-params key-fields] (let - [ks (set (map keyword key-fields)) - p (reduce - merge - {} - (map - #(massage-value % params) - (filter - #(ks (keyword %)) - (keys params))))] + [p (reduce + merge + {} + (map + #(massage-value % params) + (keys params)))] (if - (empty? form-params) + (empty? (keys form-params)) p (reduce - merge - ;; do the keyfields first, from params - p - ;; then merge in everything from form-params, potentially overriding what - ;; we got from params. - (map - #(massage-value % form-params) - (keys form-params)))))) + merge + ;; do the keyfields first, from params + p + ;; then merge in everything from form-params, potentially overriding what + ;; we got from params. + (map + #(massage-value % form-params) + (keys form-params)))))) ([request key-fields] (raw-massage-params (:params request) (:form-params request) key-fields)) ([request] @@ -141,3 +142,34 @@ ~error-return))) +(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." + ;; TODO: candidate for moving to adl-support.core + [form] + `(try + {:result ~form} + (catch Exception any# + (clojure.tools.logging/error + (str (.getName (.getClass any#)) + ": " + (.getMessage any#) + (with-out-str + (-> any# .printStackTrace)))) + {:error + (s/join + "\n\tcaused by: " + (reverse + (loop [ex# any# result# ()] + (if-not (nil? ex#) + (recur + (.getCause ex#) + (cons (str + (.getName (.getClass ex#)) + ": " + (.getMessage ex#)) result#)) + result#))))}))) + diff --git a/src/adl_support/rest_support.clj b/src/adl_support/rest_support.clj new file mode 100644 index 0000000..4a9a39f --- /dev/null +++ b/src/adl_support/rest_support.clj @@ -0,0 +1,78 @@ +(ns adl-support.rest-support + (:require [clojure.core.memoize :as memo] + [clojure.data.json :as json] + [clojure.java.io :as io] + [clojure.string :refer [split]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; adl-support.core: functions used by ADL-generated code: REST support. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the MIT-style licence provided; see LICENSE. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; License for more details. +;;;; +;;;; Copyright (C) 2018 Simon Brooke +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(defmacro if-valid-user + "Evaluate this `form` only if there is a valid user in the session of + this `request`; otherwise return the `error-return` value." + ;; TODO: candidate for moving to adl-support.core + ([form request error-return] + `(log/debug "if-valid-user: " (-> ~request :session :user)) + `(if + (-> ~request :session :user) + ~form + ~error-return)) + ([form request] + (if-valid-user form request nil))) + + +(defmacro valid-user-or-forbid + "Evaluate this `form` only if there is a valid user in the session of + this `request`; otherwise return an HTTP forbidden response." + ;; TODO: candidate for moving to adl-support.core + [form request] + `(if-valid-user + ~form + ~request + {:status 403 + :body (json/write-str "You must be logged in to do that")})) + + +(defmacro with-params-or-error + "Evaluate this `form` only if these `params` contain all these `required` keys; + otherwise return an HTTP 400 response." + ;; TODO: candidate for moving to adl-support.core + [form params required] + `(if-not + (some #(not (% ~params)) ~required) + ~form + {:status 400 + :body (json/write-str (str "The following params are required: " ~required))})) + + +;; (with-params-or-error (/ 1 0) {:a 1 :b 2} #{:a :b :c}) +;; (with-params-or-error "hello" {:a 1 :b 2} #{:a :b }) + +(defmacro do-or-server-fail + "Evaluate this `form`; if it succeeds, return an HTTP response with this + status code and the JSON-formatted result as body; if it fails, return an + HTTP 500 response." + [form status] + `(let [r# (do-or-return-reason ~form)] + (if + (some #(= :result %) (keys r#)) ;; :result might legitimately be bound to nil + {:status ~status + :body (:result r#)} + {:status 500 + :body r#}))) + + diff --git a/test/adl_support/core_test.clj b/test/adl_support/core_test.clj index b86e00e..2527d0d 100644 --- a/test/adl_support/core_test.clj +++ b/test/adl_support/core_test.clj @@ -40,5 +40,12 @@ (is (= expected actual) "params and form-params differ")) (let [expected {:id 67 :offset 0 :limit 50} actual (massage-params {:id 60} {:id "67" :offset "0" :limit "50"} #{:id})] - (is (= expected actual) "Limit and offset in form-params")) + (is (= expected actual) "prefer values from form-params")) + (let [expected {:id 67 :offset 0 :limit 50} + actual (massage-params {:params {:id "67" :offset "0" :limit "50"} :form-params {}})] + (is (= expected actual) "Request with no form params")) + (let [expected {:id 67 :offset 0 :limit 50} + actual (massage-params {:params {:id "0" :offset "1000" :limit "150"} + :form-params {:id "67" :offset "0" :limit "50"}})] + (is (= expected actual) "Request with form params, params and form params differ")) )) diff --git a/test/adl_support/rest_support_test.clj b/test/adl_support/rest_support_test.clj new file mode 100644 index 0000000..97f2ed0 --- /dev/null +++ b/test/adl_support/rest_support_test.clj @@ -0,0 +1,38 @@ +(ns adl-support.core-test + (:require [clojure.test :refer :all] + [adl-support.rest_support :refer :all])) + + +(deftest if-valid-user-tests + (testing "correct handling of if-valid-user" + (let [expected "hello" + actual (if-valid-user "hello" {:session {:user {:id 4}}} "goodbye")] + (is (= expected actual) "User in session")) + (let [expected "goodbye" + actual (if-valid-user "hello" {:session {}} "goodbye")] + (is (= expected actual) "No user in session")))) + + +(deftest valid-user-or-forbid-tests + (testing "valid-user-or-forbid" + (let [expected "hello" + 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}}}))] + (is (= expected actual) "No user in session")))) + + +(deftest with-params-or-error-tests + (let [expected "hello" + actual (with-params-or-error "hello" {:a 1 :b 2} #{:a :b})] + (is (= expected actual) "All requirements satisfied")) + (let [expected "hello" + actual (with-params-or-error "hello" {:a 1 :b 2 :c 3} #{:a :b})] + (is (= expected actual) "Unrequired parameter present")) + (let [expected 400 + actual (:status (with-params-or-error "hello" {:a 1 :b 2} #{:a :b :c}))] + (is (= expected actual) "Some requirements unsatisfied")) + (let [expected 400 + actual (:status (with-params-or-error (/ 1 0) {:a 1 :b 2} #{:a :b :c}))] + (is (= expected actual) "Exception should not be throwen"))) From 387c15b8a1c3afcc5295e01adedf9b1bf27ced44 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 29 Jul 2018 00:37:57 +0100 Subject: [PATCH 09/25] Much progress --- project.clj | 8 +- src/adl_support/core.clj | 151 ++++++++++++++++++------------ src/adl_support/forms_support.clj | 118 +++++++++++++++++++++++ src/adl_support/rest_support.clj | 6 +- src/adl_support/utils.clj | 28 ++++-- test/adl_support/core_test.clj | 63 ++++++++----- 6 files changed, 279 insertions(+), 95 deletions(-) create mode 100644 src/adl_support/forms_support.clj diff --git a/project.clj b/project.clj index f867a49..b193d12 100644 --- a/project.clj +++ b/project.clj @@ -7,11 +7,11 @@ :dependencies [[org.clojure/clojure "1.8.0"] [org.clojure/core.memoize "0.7.1"] [org.clojure/math.numeric-tower "0.0.4"] - [org.clojure/tools.logging "0.3.1"] - [selmer "1.10.6"]] + [org.clojure/tools.logging "0.4.1"] + [selmer "1.11.8"]] - :plugins [[lein-codox "0.10.3"] - [lein-release "1.0.5"]] + :plugins [[lein-codox "0.10.4"] + [lein-release "1.1.3"]] ;; `lein release` doesn't work with `git flow release`. To use ;; `lein release`, first merge `develop` into `master`, and then, in branch diff --git a/src/adl_support/core.clj b/src/adl_support/core.clj index 45348e2..141fe3c 100644 --- a/src/adl_support/core.clj +++ b/src/adl_support/core.clj @@ -1,7 +1,8 @@ (ns adl-support.core (:require [clojure.core.memoize :as memo] [clojure.java.io :as io] - [clojure.string :refer [split]])) + [clojure.string :refer [split join]] + [clojure.tools.logging])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -27,30 +28,6 @@ (fn [s] (println s))) -(defn query-string-to-map - "A `query-string` - the query-part of a URL - comprises generally - `=&=...`; reduce such a string to a map. - If `query-string` is nil or empty return an empty map." - [query-string] - (if - (empty? query-string) - {} - (reduce - merge - (map - #(let [pair (split % #"=")] - (if (= (count pair) 2) - (let - [v (try - (read-string (nth pair 1)) - (catch Exception _ - (nth pair 1))) - value (if (number? v) v (str v))] - (hash-map (keyword (first pair)) value)) - {})) - (split query-string #"\&"))))) - - (defn massage-value "Return a map with one key, this `k` as a keyword, whose value is the binding of `k` in map `m`, as read by read." @@ -80,23 +57,23 @@ ([params form-params key-fields] (let [p (reduce - merge - {} - (map - #(massage-value % params) - (keys params)))] + merge + {} + (map + #(massage-value % params) + (keys params)))] (if (empty? (keys form-params)) p (reduce - merge - ;; do the keyfields first, from params - p - ;; then merge in everything from form-params, potentially overriding what - ;; we got from params. - (map - #(massage-value % form-params) - (keys form-params)))))) + merge + ;; do the keyfields first, from params + p + ;; then merge in everything from form-params, potentially overriding what + ;; we got from params. + (map + #(massage-value % form-params) + (keys form-params)))))) ([request key-fields] (raw-massage-params (:params request) (:form-params request) key-fields)) ([request] @@ -142,34 +119,92 @@ ~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." - ;; TODO: candidate for moving to adl-support.core [form] `(try {:result ~form} (catch Exception any# - (clojure.tools.logging/error - (str (.getName (.getClass any#)) - ": " - (.getMessage any#) - (with-out-str - (-> any# .printStackTrace)))) - {:error - (s/join - "\n\tcaused by: " - (reverse - (loop [ex# any# result# ()] - (if-not (nil? ex#) - (recur - (.getCause ex#) - (cons (str - (.getName (.getClass ex#)) - ": " - (.getMessage ex#)) result#)) - result#))))}))) + {:error (compose-exception-reason any#)}))) + + +(defmacro do-or-log-and-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. Additionally, log the exception" + [form] + `(try + {:result ~form} + (catch Exception any# + {:error (compose-reason-and-log any#)}))) + + +(defmacro do-or-warn + "Evaluate this `form`; if any exception is thrown, show it to the user + via the `*warn*` mechanism." + ([form] + `(try + ~form + (catch Exception any# + (*warn* (compose-exception-reason any#)) + nil))) + ([form intro] + `(try + ~form + (catch Exception any# + (*warn* (str ~intro ":\n\t" (compose-exception-reason any#))) + nil)))) + + +(defmacro do-or-warn-and-log + "Evaluate this `form`; if any exception is thrown, log the reason and + show it to the user via the `*warn*` mechanism." + ([form] + `(try + ~form + (catch Exception any# + (*warn* (compose-reason-and-log any#)) + nil))) + ([form intro] + `(try + ~form + (catch Exception any# + (*warn* (str ~intro ":\n\t" (compose-reason-and-log any#))) + nil)))) diff --git a/src/adl_support/forms_support.clj b/src/adl_support/forms_support.clj new file mode 100644 index 0000000..88c9279 --- /dev/null +++ b/src/adl_support/forms_support.clj @@ -0,0 +1,118 @@ +(ns adl-support.forms-support + (:require [adl-support.core :refer [do-or-log-error do-or-return-reason]] + [adl-support.utils :refer [safe-name singularise]] + [clojure.core.memoize :as memo] + [clojure.data.json :as json] + [clojure.java.io :as io] + [clojure.string :refer [lower-case]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; adl-support.forms-support: functions used by ADL-generated code: +;;;; support functions for HTML forms. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the MIT-style licence provided; see LICENSE. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; License for more details. +;;;; +;;;; Copyright (C) 2018 Simon Brooke +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(defn query-name + "Generate a query name for the query of type `q-type` (expected to be one + of `:create`, `:delete`, `:get`, `:list`, `:search-strings`, `:update`) of + the entity `entity-or-name` NOTE: if `entity-or-name` is passed as a string, + it should be the full, unaltered name of the entity." + [entity-or-name q-type] + (symbol + (str + "db/" + (lower-case (name q-type)) + "-" + (let [n (safe-name + (if + (string? entity-or-name) + entity-or-name + (:name (:attrs entity-or-name))) :sql)] + (case q-type + (:list :search-strings) n + (singularise n))) + (case q-type + (:create :delete :update) "!" + nil)))) + + +(defmacro get-current-value + [f params entity-name] + `(let + [message# (str "Error while fetching " ~entity-name " record " ~params)] + (support/do-or-log-error + (~f db/*db* ~params) + :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] + `(remove + nil? + (flatten + (list + (if + ~value + (do-or-log-error + (apply + (symbol (str "db/" (query-name ~entity-name :get))) + (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*)) + :message + (str "Error while fetching " ~entity-name " list")))))) + + +;; (macroexpand '(get-menu-options "addresses" :address-id 7)) + +;; (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`." + [m keys] + `(clojure.set/subset? (set ~keys) (set (keys ~m)))) diff --git a/src/adl_support/rest_support.clj b/src/adl_support/rest_support.clj index 4a9a39f..dc3ee93 100644 --- a/src/adl_support/rest_support.clj +++ b/src/adl_support/rest_support.clj @@ -1,12 +1,14 @@ (ns adl-support.rest-support - (:require [clojure.core.memoize :as memo] + (:require [adl-support.core :refer [do-or-log-error do-or-return-reason]] + [clojure.core.memoize :as memo] [clojure.data.json :as json] [clojure.java.io :as io] [clojure.string :refer [split]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; -;;;; adl-support.core: functions used by ADL-generated code: REST support. +;;;; adl-support.rest-support: functions used by ADL-generated code: support +;;;; functions for REST routes. ;;;; ;;;; This program is free software; you can redistribute it and/or ;;;; modify it under the terms of the MIT-style licence provided; see LICENSE. diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index 191961d..b132c82 100644 --- a/src/adl_support/utils.clj +++ b/src/adl_support/utils.clj @@ -396,13 +396,23 @@ elements)))) +(defn system-generated? + "True if the value of the `property` is system generated, and + should not be set by the user." + [property] + (child-with-tag + property + :generator + #(#{"native" "guid"} (-> % :attrs :action)))) + + (defn insertable? "Return `true` it the value of this `property` may be set from user-supplied data." [property] (and - (= (:tag property) :property) - (not (#{"link"} (:type (:attrs property)))) - (not (= (:distinct (:attrs property)) "system")))) + (= (:tag property) :property) + (not (#{"link"} (:type (:attrs property)))) + (not (system-generated? property)))) (defmacro all-properties @@ -523,14 +533,14 @@ first child of the `entity` of the specified type will be used." [form entity application] (cond - (and (map? form) (#{:list :form :page} (:tag form))) - (s/join + (and (map? form) (#{:list :form :page} (:tag form))) + (s/join "-" (flatten - (list - (name (:tag form)) (:name (:attrs entity)) (s/split (:name (:attrs form)) #"[ \n\r\t]+")))) - (keyword? form) - (path-part (first (children-with-tag entity form)) entity application))) + (list + (name (:tag form)) (:name (:attrs entity)) (s/split (:name (:attrs form)) #"[ \n\r\t]+")))) + (keyword? form) + (path-part (first (children-with-tag entity form)) entity application))) (defn editor-name diff --git a/test/adl_support/core_test.clj b/test/adl_support/core_test.clj index 2527d0d..0a8ea05 100644 --- a/test/adl_support/core_test.clj +++ b/test/adl_support/core_test.clj @@ -2,28 +2,6 @@ (:require [clojure.test :refer :all] [adl-support.core :refer :all])) -(deftest query-string-to-map-tests - (testing "conversion of query strings to maps" - (let [expected {} - actual (query-string-to-map nil)] - (is (= expected actual) "Nil arg")) - (let [expected {} - actual (query-string-to-map "")] - (is (= expected actual) "Empty string arg")) - (let [expected {:id 1} - actual (query-string-to-map "id=1")] - (is (= expected actual) "One integer value")) - (let [expected {:name "simon"} - actual (query-string-to-map "name=simon")] - (is (= expected actual) "One string value.")) - (let [expected {:name "simon" :id 1} - actual (query-string-to-map "id=1&name=simon")] - (is (= expected actual) "One string value, one integer. Order of pairs might be reversed, and that's OK")) - (let [expected {:address_id_expanded "AIRDS"} - actual (query-string-to-map "id=&address_id_expanded=AIRDS&sub-address=")] - (is (= expected actual) "Yeys with no values should not be included in the map")) - )) - (deftest massage-params-tests (testing "Massaging of params" (let [expected {:id 67} @@ -49,3 +27,44 @@ :form-params {:id "67" :offset "0" :limit "50"}})] (is (= expected actual) "Request with form params, params and form params differ")) )) + +(deftest compose-exception-reason-tests + (testing "Compose exception reason" + (let [expected "java.lang.Exception: hello" + actual (compose-exception-reason + (Exception. "hello"))] + (is (= expected actual) "Exception with no cause")) + (let [expected "java.lang.Exception: Top-level exception\n\tcaused by: java.lang.Exception: cause" + actual (compose-exception-reason + (Exception. + "Top-level exception" + (Exception. "cause")))] + (is (= expected actual) "Exception with cause")) + (let [expected "" + actual (compose-exception-reason nil)] + (is (= expected actual) "Exception with no cause")))) + + +(deftest do-or-return-reason-tests + (testing "do-or-return-reason" + (let [expected {:result 1} + actual (do-or-return-reason (/ 1 1))] + (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")))) + + +;; These work in REPL, but break in tests. Why? +;; (deftest "do-or-warn-tests" +;; (testing "do-or-warn" +;; (let [expected 1 +;; actual (do-or-warn (/ 1 1))] +;; (is (= expected actual) "No exception thrown")) +;; (let [expected nil +;; actual (do-or-warn (/ 1 0))] +;; (is (= expected actual) "Exception thrown")) +;; (let [expected nil +;; actual (do-or-warn (/ 1 0) "hello")] +;; (is (= expected actual) "Exception thrown")) +;; )) From d0d3c24e5cb0fab79ee8d60be44e1fbe883c1a54 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 30 Jul 2018 00:40:10 +0100 Subject: [PATCH 10/25] Work on ADL issue #3, auxlists. --- src/adl_support/core.clj | 80 +++++++++++++------------ src/adl_support/forms_support.clj | 44 ++++---------- src/adl_support/utils.clj | 62 ++++++++++++++----- test/adl_support/core_test.clj | 5 +- test/adl_support/forms_support_test.clj | 16 +++++ test/adl_support/rest_support_test.clj | 6 +- test/adl_support/utils_test.clj | 67 +++++++++++++++++++++ 7 files changed, 189 insertions(+), 91 deletions(-) create mode 100644 test/adl_support/forms_support_test.clj 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...")))) + + From 3b539c6ec8ae556be42e9c507297b55f6525758e Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 1 Aug 2018 22:22:12 +0100 Subject: [PATCH 11/25] More unit tests. Sigh. --- src/adl_support/utils.clj | 31 ++++++++++++----- test/adl_support/utils_test.clj | 62 ++++++++++++++++++++++++++++++++- 2 files changed, 84 insertions(+), 9 deletions(-) diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index 0aed4bf..be5436c 100644 --- a/src/adl_support/utils.clj +++ b/src/adl_support/utils.clj @@ -313,7 +313,7 @@ ;; 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))) + (safe-name (:name (:attrs o)) convention) true (let [string (str o)] (case convention @@ -324,19 +324,34 @@ (apply str (cons (Character/toLowerCase (first camel)) (rest camel)))) (safe-name string)))))) +;; (safe-name "address-id" :sql) +;; (safe-name {:tag :property :attrs {:name "address-id"}} :sql) + (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] + [property nearside farside] `(if - (and (entity? ~nearside) (entity? ~farside)) - (str - "list-" - (safe-name ~farside :sql) - "-by-" - (singularise (safe-name ~nearside :sql))) + (and + (property? ~property) + (entity? ~nearside) + (entity? ~farside)) + (case (-> ~property :attrs :type) + "link" (str "list-" + (safe-name ~property :sql) "-by-" + (singularise (safe-name ~nearside :sql))) + "list" (str "list-" + (safe-name ~farside :sql) "-by-" + (singularise (safe-name ~nearside :sql))) + "entity" (str "list-" + (safe-name ~nearside :sql) "-by-" + (singularise (safe-name ~farside :sql))) + ;; default + (str "ERROR-bad-property-type-" + (-> ~property :attrs :type) "-of-" + (-> ~property :attrs :name))) (do (*warn* "Argument passed to `list-related-query-name` was a non-entity") nil))) diff --git a/test/adl_support/utils_test.clj b/test/adl_support/utils_test.clj index 3aebc2c..ab92d96 100644 --- a/test/adl_support/utils_test.clj +++ b/test/adl_support/utils_test.clj @@ -366,8 +366,68 @@ [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Gender"}, :content nil}]}]} + property (child e1 #(= (-> % :attrs :name) "gender")) expected "list-electors-by-gender" - actual (list-related-query-name e1 e2)] + actual (list-related-query-name property e2 e1)] (is (= expected actual) "just checking...")))) +(deftest list-related-query-name-tests + (testing "list-related-query-name" + (let [e1 {:tag :entity + :attrs {:name "dwellings"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}}]} + {:tag :property + :attrs {:name "address" :type "entity" :entity "addresses"}}]} + e2 {:tag :entity + :attrs {:name "addresses"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}}]} + {:tag :property + :attrs {:name "dwellings" :type "list" :entity "dwellings"}}]}] + (let [property {:tag :property + :attrs {:name "address" :type "entity" :entity "addresses"}} + expected "list-dwellings-by-address" + actual (list-related-query-name property e1 e2)] + (is (= expected actual) "Entity property")) + (let [property {:tag :property + :attrs {:name "dwellings" :type "list" :entity "dwellings"}} + expected "list-dwellings-by-address" + actual (list-related-query-name property e2 e1)] + (is (= expected actual) "List property"))) + (let [e1 {:tag :entity + :attrs {:name "teams"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}}]} + {:tag :property + :attrs {:name "members" :type "link" :entity "canvassers"}} + {:tag :property + :attrs {:name "organisers" :type "link" :entity "canvassers"}}]} + e2 {:tag :entity + :attrs {:name "canvassers"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}}]} + {:tag :property + :attrs {:name "memberships" :type "link" :entity "teams"}}]}] + (let [property {:tag :property + :attrs {:name "members" :type "link" :entity "canvassers"}} + expected "list-members-by-team" + actual (list-related-query-name property e1 e2)] + (is (= actual expected) "Link property - members")) + (let [property {:tag :property + :attrs {:name "organisers" :type "link" :entity "canvassers"}} + expected "list-organisers-by-team" + actual (list-related-query-name property e1 e2)] + (is (= actual expected) "Link property - organisers")) + (let [property {:tag :property + :attrs {:name "memberships" :type "link" :entity "teams"}} + expected "list-memberships-by-canvasser" + actual (list-related-query-name property e2 e1)] + (is (= actual expected) "Link property - membersips"))))) + + From 37d56321b362b3025f4a1d69f763297154bfa77f Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 2 Aug 2018 08:21:43 +0100 Subject: [PATCH 12/25] Still wrestling with naming links - genuinely tricky --- src/adl_support/utils.clj | 86 ++++++++++++++++++++------------- test/adl_support/utils_test.clj | 6 +-- 2 files changed, 54 insertions(+), 38 deletions(-) diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index be5436c..f21bceb 100644 --- a/src/adl_support/utils.clj +++ b/src/adl_support/utils.clj @@ -90,33 +90,6 @@ (sort #(compare (:name (:attrs %1)) (:name (:attrs %2))) elements)) -(defn link-table-name - "Canonical name of a link table between entity `e1` and entity `e2`. However, there - may be different links between the same two tables with different semantics; if - `property` is specified, and if more than one property in `e1` links to `e2`, generate - a more specific link name." - ([e1 e2] - (s/join - "_" - (cons - "ln" - (sort - (list - (:name (:attrs e1)) (:name (:attrs e2))))))) - ([property e1 e2] - (if (count - (descendants - e1 - #(and - (= (-> % :attrs :type) "link") - (= - (-> % :attrs :entity) - (-> property :attrs :entity))))) - (s/join - "_" (cons "ln" (map #(:name (:attrs %)) (list property e1 e2)))) - (link-table-name e1 e2)))) - - (defn children "Return the children of this `element`; if `predicate` is passed, return only those children satisfying the predicate." @@ -328,7 +301,53 @@ ;; (safe-name {:tag :property :attrs {:name "address-id"}} :sql) -(defmacro list-related-query-name +(defn unique-link? + "True if there is exactly one link between entities `e1` and `e2`." + [e1 e2] + (let [n1 (count (children-with-tag e1 :property #(= (-> % :attrs :name)(-> e2 :attrs :name)))) + n2 (count (children-with-tag e2 :property #(= (-> % :attrs :name)(-> e1 :attrs :name))))] + (= (max n1 n2) 1))) + + +(defn link-related-property-name + "link is tricky. If there's exactly than one link between the two + entities, we need to generate the same name from both + ends of the link" + [property nearside farside] + (if (unique-link? nearside farside) + (let [ordered (sort-by (-> % :attrs :name) (list nearside farside)) + e1 (first ordered) + e2 (nth ordered 1)] + (str "list-" + (safe-name e1 :sql) + "-by-" + (safe-name e2 :sql)) + (str "list-" + (safe-name ~property :sql) "-by-" + (singularise (safe-name ~nearside :sql)))))) + + +(defn link-table-name + "Canonical name of a link table between entity `e1` and entity `e2`. However, there + may be different links between the same two tables with different semantics; if + `property` is specified, and if more than one property in `e1` links to `e2`, generate + a more specific link name." + ([e1 e2] + (s/join + "_" + (cons + "ln" + (sort + (list + (:name (:attrs e1)) (:name (:attrs e2))))))) + ([property e1 e2] + (if (unique-link? e1 e2) + (s/join + "_" (cons "ln" (map #(:name (:attrs %)) (list property e1 e2)))) + (link-table-name e1 e2)))) + + +(defn 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." @@ -339,15 +358,16 @@ (entity? ~nearside) (entity? ~farside)) (case (-> ~property :attrs :type) - "link" (str "list-" - (safe-name ~property :sql) "-by-" - (singularise (safe-name ~nearside :sql))) + ;; link is tricky. If there's exactly than one link between the two + ;; entities, we need to generate the same name from both + ;; ends of the link + "link" (link-related-query-name) "list" (str "list-" (safe-name ~farside :sql) "-by-" (singularise (safe-name ~nearside :sql))) "entity" (str "list-" - (safe-name ~nearside :sql) "-by-" - (singularise (safe-name ~farside :sql))) + (safe-name ~farside :sql) "-by-" + (singularise (safe-name ~nearside :sql))) ;; default (str "ERROR-bad-property-type-" (-> ~property :attrs :type) "-of-" diff --git a/test/adl_support/utils_test.clj b/test/adl_support/utils_test.clj index ab92d96..7784dd5 100644 --- a/test/adl_support/utils_test.clj +++ b/test/adl_support/utils_test.clj @@ -369,11 +369,7 @@ property (child e1 #(= (-> % :attrs :name) "gender")) expected "list-electors-by-gender" actual (list-related-query-name property e2 e1)] - (is (= expected actual) "just checking...")))) - - -(deftest list-related-query-name-tests - (testing "list-related-query-name" + (is (= expected actual) "just checking...")) (let [e1 {:tag :entity :attrs {:name "dwellings"} :content [{:tag :key From e93368c6754b18ea63bf8817ab7c3370bffefd97 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 2 Aug 2018 21:36:28 +0100 Subject: [PATCH 13/25] All tests pass. Is this the end of the link table naming issue? --- src/adl_support/utils.clj | 33 +++++++++++++++------------------ test/adl_support/utils_test.clj | 22 +++++++++++++++++++++- 2 files changed, 36 insertions(+), 19 deletions(-) diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index f21bceb..f035c7c 100644 --- a/src/adl_support/utils.clj +++ b/src/adl_support/utils.clj @@ -309,22 +309,22 @@ (= (max n1 n2) 1))) -(defn link-related-property-name +(defn link-related-query-name "link is tricky. If there's exactly than one link between the two entities, we need to generate the same name from both ends of the link" [property nearside farside] (if (unique-link? nearside farside) - (let [ordered (sort-by (-> % :attrs :name) (list nearside farside)) + (let [ordered (sort-by #(-> % :attrs :name) (list nearside farside)) e1 (first ordered) e2 (nth ordered 1)] (str "list-" (safe-name e1 :sql) "-by-" - (safe-name e2 :sql)) + (safe-name e2 :sql))) (str "list-" - (safe-name ~property :sql) "-by-" - (singularise (safe-name ~nearside :sql)))))) + (safe-name property :sql) "-by-" + (singularise (safe-name nearside :sql))))) (defn link-table-name @@ -352,22 +352,19 @@ `farside` which match a given record on `nearside`, where `nearide` and `farside` are both entities." [property nearside farside] - `(if + (if (and - (property? ~property) - (entity? ~nearside) - (entity? ~farside)) - (case (-> ~property :attrs :type) - ;; link is tricky. If there's exactly than one link between the two - ;; entities, we need to generate the same name from both - ;; ends of the link - "link" (link-related-query-name) + (property? property) + (entity? nearside) + (entity? farside)) + (case (-> property :attrs :type) + "link" (link-related-query-name property nearside farside) "list" (str "list-" - (safe-name ~farside :sql) "-by-" - (singularise (safe-name ~nearside :sql))) + (safe-name farside :sql) "-by-" + (singularise (safe-name nearside :sql))) "entity" (str "list-" - (safe-name ~farside :sql) "-by-" - (singularise (safe-name ~nearside :sql))) + (safe-name nearside :sql) "-by-" + (singularise (safe-name farside :sql))) ;; default (str "ERROR-bad-property-type-" (-> ~property :attrs :type) "-of-" diff --git a/test/adl_support/utils_test.clj b/test/adl_support/utils_test.clj index 7784dd5..b6747d6 100644 --- a/test/adl_support/utils_test.clj +++ b/test/adl_support/utils_test.clj @@ -366,7 +366,7 @@ [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Gender"}, :content nil}]}]} - property (child e1 #(= (-> % :attrs :name) "gender")) + property (child e2 #(= (-> % :attrs :name) "gender")) expected "list-electors-by-gender" actual (list-related-query-name property e2 e1)] (is (= expected actual) "just checking...")) @@ -426,4 +426,24 @@ actual (list-related-query-name property e2 e1)] (is (= actual expected) "Link property - membersips"))))) +;; (def e1 {:tag :entity +;; :attrs {:name "teams"} +;; :content [{:tag :key +;; :content [{:tag :property +;; :attrs {:name "id" :type "integer" :distinct "system"}}]} +;; {:tag :property +;; :attrs {:name "members" :type "link" :entity "canvassers"}} +;; {:tag :property +;; :attrs {:name "organisers" :type "link" :entity "canvassers"}}]}) +;; (def e2 {:tag :entity +;; :attrs {:name "canvassers"} +;; :content [{:tag :key +;; :content [{:tag :property +;; :attrs {:name "id" :type "integer" :distinct "system"}}]} +;; {:tag :property +;; :attrs {:name "memberships" :type "link" :entity "teams"}}]}) +;; (def property {:tag :property +;; :attrs {:name "members" :type "link" :entity "canvassers"}}) + +;; (list-related-query-name property e1 e2) From 8fbe32c5c249cb40783b5d88a2ee561d34f94d4e Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 2 Aug 2018 22:02:24 +0100 Subject: [PATCH 14/25] More unit tests... --- src/adl_support/utils.clj | 20 ++++--- test/adl_support/utils_test.clj | 97 ++++++++++++++++++++++++++------- 2 files changed, 89 insertions(+), 28 deletions(-) diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index f035c7c..45a3a2b 100644 --- a/src/adl_support/utils.clj +++ b/src/adl_support/utils.clj @@ -304,8 +304,12 @@ (defn unique-link? "True if there is exactly one link between entities `e1` and `e2`." [e1 e2] - (let [n1 (count (children-with-tag e1 :property #(= (-> % :attrs :name)(-> e2 :attrs :name)))) - n2 (count (children-with-tag e2 :property #(= (-> % :attrs :name)(-> e1 :attrs :name))))] + (let [n1 (count (children-with-tag e1 :property + #(and (= (-> % :attrs :type) "link") + (= (-> % :attrs :entity)(-> e2 :attrs :name))))) + n2 (count (children-with-tag e2 :property + #(and (= (-> % :attrs :type) "link") + (= (-> % :attrs :entity)(-> e1 :attrs :name)))))] (= (max n1 n2) 1))) @@ -315,13 +319,11 @@ ends of the link" [property nearside farside] (if (unique-link? nearside farside) - (let [ordered (sort-by #(-> % :attrs :name) (list nearside farside)) - e1 (first ordered) - e2 (nth ordered 1)] + (let [ordered (sort-by #(-> % :attrs :name) (list nearside farside))] (str "list-" - (safe-name e1 :sql) + (safe-name (first ordered) :sql) "-by-" - (safe-name e2 :sql))) + (safe-name (nth ordered 1) :sql))) (str "list-" (safe-name property :sql) "-by-" (singularise (safe-name nearside :sql))))) @@ -342,9 +344,9 @@ (:name (:attrs e1)) (:name (:attrs e2))))))) ([property e1 e2] (if (unique-link? e1 e2) + (link-table-name e1 e2) (s/join - "_" (cons "ln" (map #(:name (:attrs %)) (list property e1 e2)))) - (link-table-name e1 e2)))) + "_" (cons "ln" (map #(:name (:attrs %)) (list property e1))))))) (defn list-related-query-name diff --git a/test/adl_support/utils_test.clj b/test/adl_support/utils_test.clj index b6747d6..1d76979 100644 --- a/test/adl_support/utils_test.clj +++ b/test/adl_support/utils_test.clj @@ -426,24 +426,83 @@ actual (list-related-query-name property e2 e1)] (is (= actual expected) "Link property - membersips"))))) -;; (def e1 {:tag :entity -;; :attrs {:name "teams"} -;; :content [{:tag :key -;; :content [{:tag :property -;; :attrs {:name "id" :type "integer" :distinct "system"}}]} -;; {:tag :property -;; :attrs {:name "members" :type "link" :entity "canvassers"}} -;; {:tag :property -;; :attrs {:name "organisers" :type "link" :entity "canvassers"}}]}) -;; (def e2 {:tag :entity -;; :attrs {:name "canvassers"} -;; :content [{:tag :key -;; :content [{:tag :property -;; :attrs {:name "id" :type "integer" :distinct "system"}}]} -;; {:tag :property -;; :attrs {:name "memberships" :type "link" :entity "teams"}}]}) -;; (def property {:tag :property -;; :attrs {:name "members" :type "link" :entity "canvassers"}}) +(deftest link-table-name-tests + (testing "link-table-name" + (let [e1 {:tag :entity + :attrs {:name "teams"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}}]} + {:tag :property + :attrs {:name "members" :type "link" :entity "canvassers"}} + {:tag :property + :attrs {:name "organisers" :type "link" :entity "canvassers"}}]} + e2 {:tag :entity + :attrs {:name "canvassers"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}}]} + {:tag :property + :attrs {:name "memberships" :type "link" :entity "teams"}} + {:tag :property + :attrs {:name "roles" :type "link" :entity "roles"}}]} + e3 {:tag :entity + :attrs {:name "roles"} + :content [{:tag :key + :content [{:tag :property + :type "string" + :distinct "all" + :name "id"}]}]}] + (let [property {:tag :property + :attrs {:name "members" :type "link" :entity "canvassers"}} + expected "ln_members_teams" + actual (link-table-name property e1 e2)] + (is (= actual expected) "Link property - members")) + (let [property {:tag :property + :attrs {:name "organisers" :type "link" :entity "canvassers"}} + expected "ln_organisers_teams" + actual (link-table-name property e1 e2)] + (is (= actual expected) "Link property - organisers")) + (let [property {:tag :property + :attrs {:name "memberships" :type "link" :entity "teams"}} + expected "ln_memberships_canvassers" + actual (link-table-name property e2 e1)] + (is (= actual expected) "Link property - membersips")) + (let [property {:tag :property + :attrs {:name "roles" :type "link" :entity "roles"}} + expected "ln_canvassers_roles" + actual (link-table-name property e2 e3)] + (is (= actual expected) "Link property - roles"))))) + + +(deftest unique-link-tests + (testing "unique-link?" + (let [e1 {:tag :entity + :attrs {:name "teams"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}}]} + {:tag :property + :attrs {:name "members" :type "link" :entity "canvassers"}} + {:tag :property + :attrs {:name "organisers" :type "link" :entity "canvassers"}}]} + e2 {:tag :entity + :attrs {:name "canvassers"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}}]} + {:tag :property + :attrs {:name "memberships" :type "link" :entity "teams"}} + {:tag :property + :attrs {:name "roles" :type "link" :entity "roles"}}]} + e3 {:tag :entity + :attrs {:name "roles"} + :content [{:tag :key + :content [{:tag :property + :type "string" + :distinct "all" + :name "id"}]}]}] + (is (= false (unique-link? e1 e2)) "There are two logical links, three link properties, between e1 and e2") + (is (= true (unique-link? e2 e3)) "There is only one link between e2 and e3")))) -;; (list-related-query-name property e1 e2) From 8fbeaa55e30de647327847adb82f07a06c6c7865 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 5 Aug 2018 14:52:26 +0100 Subject: [PATCH 15/25] Working through getting record creation going --- src/adl_support/utils.clj | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index 45a3a2b..f692422 100644 --- a/src/adl_support/utils.clj +++ b/src/adl_support/utils.clj @@ -474,9 +474,9 @@ "Return `true` it the value of this `property` may be set from user-supplied data." [property] (and - (= (:tag property) :property) - (not (#{"link"} (:type (:attrs property)))) - (not (system-generated? property)))) + (= (:tag property) :property) + (not (#{"link" "list"} (:type (:attrs property)))) + (not (system-generated? property)))) (defmacro all-properties @@ -509,6 +509,17 @@ (all-properties ~entity))) +(defn required-properties + "Return the properties of this `entity` which are required and are not + system generated." + [entity] + (filter + #(and + (= (:required (:attrs %)) "true") + (not (system-generated? %))) + (descendants-with-tag entity :property))) + + (defmacro key-properties [entity] `(children-with-tag (first (children-with-tag ~entity :key)) :property)) From ba1be5dc2ecf99bfe7feaf22368c46e42f515bb3 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 5 Aug 2018 17:17:57 +0100 Subject: [PATCH 16/25] Create and Update now work. --- src/adl_support/forms_support.clj | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/src/adl_support/forms_support.clj b/src/adl_support/forms_support.clj index a2d1522..550fd3c 100644 --- a/src/adl_support/forms_support.clj +++ b/src/adl_support/forms_support.clj @@ -92,3 +92,14 @@ "Return true if all the keys in `keys` are present in the map `m`." [m keys] `(clojure.set/subset? (set ~keys) (set (keys ~m)))) + + +(defmacro prepare-insertion-params + "Params for insertion into the database must have keys for all fields in the + insert query, even if the value of some of those keys is nil. Massage these + `params` to have a value for each field in these `fields`." + [params fields] + `(merge + (reduce {} (map #(hash-map (keyword %) nil) ~fields)) + ~params)) + From 7280c6f41be33f78df1aabe4666df4b49862accd Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 6 Aug 2018 09:32:42 +0100 Subject: [PATCH 17/25] Safety commit Ran out of electricity last night when I'd almost but not quite got creation working properly. Frustrating! I don't have much electricity this morning so I'm pushing this up to GitHub for safety. --- src/adl_support/forms_support.clj | 9 ++++++++- test/adl_support/forms_support_test.clj | 20 +++++++++++++++++++- 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/src/adl_support/forms_support.clj b/src/adl_support/forms_support.clj index 550fd3c..b7c2e3f 100644 --- a/src/adl_support/forms_support.clj +++ b/src/adl_support/forms_support.clj @@ -1,6 +1,6 @@ (ns adl-support.forms-support (:require [adl-support.core :refer [do-or-log-error do-or-return-reason]] - [adl-support.utils :refer [safe-name singularise]] + [adl-support.utils :refer [descendants-with-tag safe-name singularise]] [clojure.core.memoize :as memo] [clojure.data.json :as json] [clojure.java.io :as io] @@ -103,3 +103,10 @@ (reduce {} (map #(hash-map (keyword %) nil) ~fields)) ~params)) +(defn property-defaults + [entity] + (reduce + merge {} + (map + #(hash-map (keyword (-> % :attrs :name)) (-> % :attrs :default)) + (descendants-with-tag entity :property #(-> % :attrs :default))))) diff --git a/test/adl_support/forms_support_test.clj b/test/adl_support/forms_support_test.clj index 96b5755..20f94c4 100644 --- a/test/adl_support/forms_support_test.clj +++ b/test/adl_support/forms_support_test.clj @@ -1,4 +1,3 @@ - (ns adl-support.forms-support-test (:require [clojure.test :refer :all] [adl-support.forms-support :refer :all])) @@ -14,3 +13,22 @@ expected "auxlist-dwellings" actual (auxlist-data-name auxlist)] (is (= expected actual) "Just checking...")))) + + +(deftest prepare-insertion-params-tests + (testing "prepare-insertion-params" + (is (= {:test1 nil :test2 nil} + (prepare-insertion-params {} #{:test1 :test2})) + "Empty params; set") + (is (= {:test1 nil :test2 nil} + (prepare-insertion-params {} '(:test1 :test2))) + "Empty params; list") + (is (= {:test1 nil :test2 nil :test3 6} + (prepare-insertion-params {:test3 6} #{:test1 :test2})) + "Unlisted param; set") + (is (= {:test1 "foo" :test2 nil} + (prepare-insertion-params {:test1 "foo"} '(:test1 :test2))) + "Listed param; list") + (is (= {:test1 "foo" :test2 6} + (prepare-insertion-params {:test1 "foo" :test2 6} '(:test1 :test2))) + "Listed params; list"))) From d6991b5f09d6a1757db6fc4b8ec6a557e575aad4 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 6 Aug 2018 12:00:39 +0100 Subject: [PATCH 18/25] Improved create and update --- src/adl_support/core.clj | 16 ++++++---------- src/adl_support/forms_support.clj | 5 +++-- test/adl_support/core_test.clj | 19 ++----------------- 3 files changed, 11 insertions(+), 29 deletions(-) diff --git a/src/adl_support/core.clj b/src/adl_support/core.clj index 609a659..4b0f8c2 100644 --- a/src/adl_support/core.clj +++ b/src/adl_support/core.clj @@ -49,14 +49,12 @@ (defn raw-massage-params "Sending empty strings, or numbers as strings, to the database often isn't helpful. Massage these `params` and `form-params` to eliminate these problems. - We must take key field values out of just params, but if form-params are present - we should take all other values out of form-params - because we need the key to - load the form in the first place. `form-params` always override `params`. - - **NOTE THAT** the parameter `key-fields` is deprecated and ignored." - ([params form-params key-fields] + Date and time fields also need massaging." + ([request entity] (let - [p (reduce + [params (:params request) + form-params (:form-params request) + p (reduce merge {} (map @@ -74,10 +72,8 @@ (map #(massage-value % form-params) (keys form-params)))))) - ([request key-fields] - (raw-massage-params (:params request) (:form-params request) key-fields)) ([request] - (raw-massage-params (:params request) (:form-params request) #{}))) + (raw-massage-params request nil))) (def massage-params diff --git a/src/adl_support/forms_support.clj b/src/adl_support/forms_support.clj index b7c2e3f..d51ffa7 100644 --- a/src/adl_support/forms_support.clj +++ b/src/adl_support/forms_support.clj @@ -1,5 +1,5 @@ (ns adl-support.forms-support - (:require [adl-support.core :refer [do-or-log-error do-or-return-reason]] + (:require [adl-support.core :refer :all] [adl-support.utils :refer [descendants-with-tag safe-name singularise]] [clojure.core.memoize :as memo] [clojure.data.json :as json] @@ -100,9 +100,10 @@ `params` to have a value for each field in these `fields`." [params fields] `(merge - (reduce {} (map #(hash-map (keyword %) nil) ~fields)) + (reduce merge {} (map #(hash-map (keyword %) nil) ~fields)) ~params)) + (defn property-defaults [entity] (reduce diff --git a/test/adl_support/core_test.clj b/test/adl_support/core_test.clj index d1b3087..0d72d0c 100644 --- a/test/adl_support/core_test.clj +++ b/test/adl_support/core_test.clj @@ -4,29 +4,14 @@ (deftest massage-params-tests (testing "Massaging of params" - (let [expected {:id 67} - actual (massage-params {:id 67} {} #{:id})] - (is (= expected actual) "numeric param")) - (let [expected {:id 67} - actual (massage-params {:id "67"} {} #{:id})] - (is (= expected actual) "string param")) - (let [expected {:id 67} - actual (massage-params {"id" "67"} {} #{:id})] - (is (= expected actual) "string keyword")) - (let [expected {:id 67} - actual (massage-params {:id 60} {:id 67} #{:id})] - (is (= expected actual) "params and form-params differ")) - (let [expected {:id 67 :offset 0 :limit 50} - actual (massage-params {:id 60} {:id "67" :offset "0" :limit "50"} #{:id})] - (is (= expected actual) "prefer values from form-params")) (let [expected {:id 67 :offset 0 :limit 50} actual (massage-params {:params {:id "67" :offset "0" :limit "50"} :form-params {}})] (is (= expected actual) "Request with no form params")) (let [expected {:id 67 :offset 0 :limit 50} actual (massage-params {:params {:id "0" :offset "1000" :limit "150"} :form-params {:id "67" :offset "0" :limit "50"}})] - (is (= expected actual) "Request with form params, params and form params differ")) - )) + (is (= expected actual) "Request with form params, params and form params differ")))) + (deftest compose-exception-reason-tests (testing "Compose exception reason" From 90b0bfb4a4c8d4aaeefe6913b3e2012925b5f7f9 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 7 Aug 2018 14:50:50 +0100 Subject: [PATCH 19/25] Added Selmer filters for address and email --- src/adl_support/filters.clj | 63 +++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 src/adl_support/filters.clj diff --git a/src/adl_support/filters.clj b/src/adl_support/filters.clj new file mode 100644 index 0000000..72f3576 --- /dev/null +++ b/src/adl_support/filters.clj @@ -0,0 +1,63 @@ +(ns adl-support.filters + (:require [clojure.string :as s] + [selmer.filters :as f] + [selmer.parser :as p])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; adl-support.filters: selmer filters required by ADL selmer views. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the MIT-style licence provided; see LICENSE. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; License for more details. +;;;; +;;;; Copyright (C) 2018 Simon Brooke +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(def *default-international-dialing-prefix* + "The international dialing prefix to use, if none is specified." + "44") + +(defn telephone + "If `arg` is, or appears to be, a valid telephone number, convert it into + a `tel:` link, else leave it be." + [^String arg] + (let [number + (s/replace + (s/replace + arg + #"^0" + (str "+" *default-international-dialing-prefix* "-")) + #"\s+" "-")] + (if (re-matches #"[0-9 +-]*" arg) + [:safe (str "" arg "")] + arg))) + + +;; (telephone "07768 130255") +;; (telephone "Freddy") + +(defn email + "If `arg` is, or appears to be, a valid email address, convert it into + a `mailto:` link, else leave it be." + [^String arg] + (if (re-matches #"^[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\.[A-Za-z]{2,6}$" arg) + [:safe (str "" arg "")] + arg)) + + +;; (email "simon@journeyman.cc") +;; (email "simon@journeyman") +;; (email "simon@journeyman.cc.") + +(f/add-filter! :telephone telephone) + +(f/add-filter! :email email) + +;; (p/render "{{p|telephone}}" {:p "07768 130255"}) From ad4e6ef13424e7ede29507463a1c3e41c5d6e9be Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 7 Aug 2018 14:50:50 +0100 Subject: [PATCH 20/25] Added Selmer filters for address and email --- src/adl_support/filters.clj | 63 +++++++++++++++++++++++++++++++ src/adl_support/forms_support.clj | 2 + 2 files changed, 65 insertions(+) create mode 100644 src/adl_support/filters.clj diff --git a/src/adl_support/filters.clj b/src/adl_support/filters.clj new file mode 100644 index 0000000..72f3576 --- /dev/null +++ b/src/adl_support/filters.clj @@ -0,0 +1,63 @@ +(ns adl-support.filters + (:require [clojure.string :as s] + [selmer.filters :as f] + [selmer.parser :as p])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; adl-support.filters: selmer filters required by ADL selmer views. +;;;; +;;;; This program is free software; you can redistribute it and/or +;;;; modify it under the terms of the MIT-style licence provided; see LICENSE. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; License for more details. +;;;; +;;;; Copyright (C) 2018 Simon Brooke +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(def *default-international-dialing-prefix* + "The international dialing prefix to use, if none is specified." + "44") + +(defn telephone + "If `arg` is, or appears to be, a valid telephone number, convert it into + a `tel:` link, else leave it be." + [^String arg] + (let [number + (s/replace + (s/replace + arg + #"^0" + (str "+" *default-international-dialing-prefix* "-")) + #"\s+" "-")] + (if (re-matches #"[0-9 +-]*" arg) + [:safe (str "" arg "")] + arg))) + + +;; (telephone "07768 130255") +;; (telephone "Freddy") + +(defn email + "If `arg` is, or appears to be, a valid email address, convert it into + a `mailto:` link, else leave it be." + [^String arg] + (if (re-matches #"^[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\.[A-Za-z]{2,6}$" arg) + [:safe (str "" arg "")] + arg)) + + +;; (email "simon@journeyman.cc") +;; (email "simon@journeyman") +;; (email "simon@journeyman.cc.") + +(f/add-filter! :telephone telephone) + +(f/add-filter! :email email) + +;; (p/render "{{p|telephone}}" {:p "07768 130255"}) diff --git a/src/adl_support/forms_support.clj b/src/adl_support/forms_support.clj index d51ffa7..fb7d0f1 100644 --- a/src/adl_support/forms_support.clj +++ b/src/adl_support/forms_support.clj @@ -98,6 +98,8 @@ "Params for insertion into the database must have keys for all fields in the insert query, even if the value of some of those keys is nil. Massage these `params` to have a value for each field in these `fields`." + ;; TODO: should intelligently handle dates and times, but that might imply + ;; access to ADL at runtime! [params fields] `(merge (reduce merge {} (map #(hash-map (keyword %) nil) ~fields)) From 50d50aab943343552afbd3de886c283a7220136d Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Tue, 28 Aug 2018 16:20:38 +0100 Subject: [PATCH 21/25] Fixes to the phone tag --- src/adl_support/core.clj | 8 ++++++-- src/adl_support/filters.clj | 2 +- test/adl_support/core_test.clj | 5 ++++- 3 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/adl_support/core.clj b/src/adl_support/core.clj index 4b0f8c2..c93a80a 100644 --- a/src/adl_support/core.clj +++ b/src/adl_support/core.clj @@ -1,5 +1,6 @@ (ns adl-support.core (:require [clojure.core.memoize :as memo] + [clojure.data.json :as json] [clojure.java.io :as io] [clojure.string :refer [split join]] [clojure.tools.logging])) @@ -36,12 +37,15 @@ vr (if (string? v) (try - (read-string v) + (json/read-str v) (catch Exception _ nil)))] (cond (nil? v) {} (= v "") {} - (number? vr) {(keyword k) vr} + (and + (number? vr) + ;; there's a problem that json/read-str will read "07777 888999" as 7777 + (re-matches #"^[0-9.]+$" v)) {(keyword k) vr} true {(keyword k) v}))) diff --git a/src/adl_support/filters.clj b/src/adl_support/filters.clj index 72f3576..4c5a90c 100644 --- a/src/adl_support/filters.clj +++ b/src/adl_support/filters.clj @@ -20,7 +20,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def *default-international-dialing-prefix* +(def ^:dynamic *default-international-dialing-prefix* "The international dialing prefix to use, if none is specified." "44") diff --git a/test/adl_support/core_test.clj b/test/adl_support/core_test.clj index 0d72d0c..cd0d4c8 100644 --- a/test/adl_support/core_test.clj +++ b/test/adl_support/core_test.clj @@ -10,7 +10,10 @@ (let [expected {:id 67 :offset 0 :limit 50} actual (massage-params {:params {:id "0" :offset "1000" :limit "150"} :form-params {:id "67" :offset "0" :limit "50"}})] - (is (= expected actual) "Request with form params, params and form params differ")))) + (is (= expected actual) "Request with form params, params and form params differ")) + (let [expected {:phone "07777 888999"} + actual (massage-params {:params {:phone "07777 888999"}})] + (is (= expected actual) "A phone number with a space in needs to be treated as a string")))) (deftest compose-exception-reason-tests From 1860790027d1422776cee580b4482984dfb1bbfb Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 16 Sep 2018 16:52:28 +0100 Subject: [PATCH 22/25] Added `column-name` --- src/adl_support/utils.clj | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index f692422..a5d1325 100644 --- a/src/adl_support/utils.clj +++ b/src/adl_support/utils.clj @@ -500,6 +500,14 @@ (user-distinct-properties entity)))) +(defn column-name + "Return, as a string, the name for the column which represents this `property`." + [property] + (safe-name + (or (-> property :attrs :column) (-> property :attrs :name)) + :sql)) + + (defmacro insertable-properties "Return all the properties of this `entity` (including key properties) into which user-supplied data can be inserted" From 27044d6405fe4ecc509b39396abfb4bfa5824a12 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 19 Sep 2018 14:29:42 +0100 Subject: [PATCH 23/25] Fix for a significant error in naming conventions, with tests. --- src/adl_support/utils.clj | 48 +++++++++++++----------- test/adl_support/utils_test.clj | 66 +++++++++++++++++++++++++++++++++ 2 files changed, 93 insertions(+), 21 deletions(-) diff --git a/src/adl_support/utils.clj b/src/adl_support/utils.clj index a5d1325..bab456b 100644 --- a/src/adl_support/utils.clj +++ b/src/adl_support/utils.clj @@ -261,7 +261,7 @@ " " (map #(apply str (cons (Character/toUpperCase (first %)) (rest %))) - (s/split s #"[ \t\r\n]+"))) + (s/split s #"[^a-zA-Z0-9]+"))) s)) @@ -272,30 +272,36 @@ (defn safe-name "Return a safe name for the object `o`, given the specified `convention`. - `o` is expected to be either a string or an element." + `o` is expected to be either a string or an element. Recognised values for + `convention` are: #{:c :c-sharp :java :sql}" ([o] (cond - (element? o) - (safe-name (:name (:attrs o))) - true - (s/replace (str o) #"[^a-zA-Z0-9-]" ""))) + (element? o) + (safe-name (:name (:attrs o))) + true + (s/replace (str o) #"[^a-zA-Z0-9-]" ""))) ([o convention] (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)) convention) - 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)))))) + (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) + (and (property? o) (= convention :sql)) + ;; if it's a property, it's entitle to have a different column name + ;; from its property name. + (safe-name (or (-> o :attrs :column) (-> o :attrs :name)) :sql) + (element? o) + (safe-name (:name (:attrs o)) convention) + true + (let [string (str o) + capitalised (capitalise string)] + (case convention + (:sql :c) (s/replace string #"[^a-zA-Z0-9_]" "_") + :c-sharp (s/replace capitalised #"[^a-zA-Z0-9]" "") + :java (let + [camel (s/replace capitalised #"[^a-zA-Z0-9]" "")] + (apply str (cons (Character/toLowerCase (first camel)) (rest camel)))) + (safe-name string)))))) ;; (safe-name "address-id" :sql) ;; (safe-name {:tag :property :attrs {:name "address-id"}} :sql) diff --git a/test/adl_support/utils_test.clj b/test/adl_support/utils_test.clj index 1d76979..b0db7d7 100644 --- a/test/adl_support/utils_test.clj +++ b/test/adl_support/utils_test.clj @@ -506,3 +506,69 @@ (is (= false (unique-link? e1 e2)) "There are two logical links, three link properties, between e1 and e2") (is (= true (unique-link? e2 e3)) "There is only one link between e2 and e3")))) +(deftest capitalise-tests + (testing "capitalise" + (is (= (capitalise "the quick brown fox jumped over the lazy dog") "The Quick Brown Fox Jumped Over The Lazy Dog")))) + +(deftest safe-name-tests + (testing "safe-name" + (let [e1 {:tag :entity + :attrs {:name "canvass-teams" :table "team"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}}]} + {:tag :property + :attrs {:name "members" :type "link" :entity "canvassers"}} + {:tag :property + :attrs {:name "organisers" :type "link" :entity "canvassers"}}]} + p1 {:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}} + p2 {:tag :property + :attrs {:name "with_underscore" :column "with-hyphen" :type "integer"}}] + (is + (= (safe-name "the quick brown fox jumped over the lazy dog") + "thequickbrownfoxjumpedoverthelazydog") + "absent a convention, spaces are suppressed") + (is + (= (safe-name "the quick brown fox jumped over the lazy dog" :c) + "the_quick_brown_fox_jumped_over_the_lazy_dog") + "in :c convention, spaces are replaced with underscores") + (is + (= (safe-name "the quick brown fox jumped over the lazy dog" :c-sharp) + "TheQuickBrownFoxJumpedOverTheLazyDog") + "in :c-sharp convention spaces are suppressed and all words camel cased") + (is + (= (safe-name "the quick brown fox jumped over the lazy dog" :java) + "theQuickBrownFoxJumpedOverTheLazyDog") + "in :java convention spaces are suppressed and embedded words camel cased") + (is + (= (safe-name "the quick brown fox jumped over the lazy dog" :sql) + "the_quick_brown_fox_jumped_over_the_lazy_dog") + "in :sql convention, spaces are replaced with underscores") + (is (= (safe-name e1) "canvass-teams")) + (is (= (safe-name e1 :c) "canvass_teams") + "In :c convention, hyphen is replaced by underscore") + (is (= (safe-name e1 :c-sharp) "CanvassTeams") + "In :c-sharp convention, hyphen is suppressed and words capitalised") + (is (= (safe-name e1 :java) "canvassTeams") + "In :java convention, hyphen is suppressed and embedded words capitalised") + (is (= (safe-name e1 :sql) "team") + "In :sql convention, the :table attribute is preferred") + (is (= (safe-name p1) "id")) + (is (= (safe-name p1 :c) "id")) + (is (= (safe-name p1 :c-sharp) "Id")) + (is (= (safe-name p1 :java) "id")) + (is (= (safe-name p1 :sql) "id")) + (is (= (safe-name p2) "withunderscore") + "Absent a convention, underscore is not considered safe") + (is (= (safe-name p2 :c) "with_underscore") + "In :c convention, underscore is considered safe") + (is (= (safe-name p2 :c-sharp) "WithUnderscore") + "In :c-sharp convention, initial letters are capialised and underscore is suppressed") + (is (= (safe-name p2 :java) "withUnderscore") + "In :java convention, underscore is suppressed and embedded words capitalised") + (is (= (safe-name p2 :sql) "with_hyphen") + "In :sql convention, the column-name variant is preferred, and hyphens replaced with underscores")))) + + + From 559b62f5d5c148e2a27241a2e53f3458344dd909 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 19 Sep 2018 15:13:35 +0100 Subject: [PATCH 24/25] Yet more unit tests --- test/adl_support/utils_test.clj | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/test/adl_support/utils_test.clj b/test/adl_support/utils_test.clj index b0db7d7..4499eb7 100644 --- a/test/adl_support/utils_test.clj +++ b/test/adl_support/utils_test.clj @@ -571,4 +571,30 @@ "In :sql convention, the column-name variant is preferred, and hyphens replaced with underscores")))) +(deftest key-names-tests + (testing "key-names" + (let [e1 {:tag :entity + :attrs {:name "canvass-teams" :table "team"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}}]} + {:tag :property + :attrs {:name "members" :type "link" :entity "canvassers"}} + {:tag :property + :attrs {:name "organisers" :type "link" :entity "canvassers"}}]} + e2 {:tag :entity + :attrs {:name "canvass-teams" :table "team"} + :content [{:tag :key + :content [{:tag :property + :attrs {:name "id" :type "integer" :distinct "system"}} + {:tag :property + :attrs {:name "shard" :type "string" :default "SW"}}]} + {:tag :property + :attrs {:name "members" :type "link" :entity "canvassers"}} + {:tag :property + :attrs {:name "organisers" :type "link" :entity "canvassers"}}]}] + (is (= (key-names e1) #{"id"})) + (is (= (key-names e1 true) #{:id})) + (is (= (key-names e2) #{"id" "shard"})) + (is (= (key-names e2 true) #{:id :shard}))))) From ad39fc96dc1a3458cec3a937caf2cebaf6519e0c Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 20 Sep 2018 10:58:05 +0100 Subject: [PATCH 25/25] Preparing for test release --- CHANGELOG.md | 3 +++ project.clj | 3 +++ 2 files changed, 6 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index c469dda..1af348d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,9 @@ All notable changes to this project will be documented in this file. This change ## [Unreleased] +## 0.1.4 - 2018-09-20 +This is not anticipated to be the actual Beta release; it's a dummy run to test the release and deployment process. Some required features are still missing. + ## 0.1.0 - 2018-06-17 ### Added Initial release. diff --git a/project.clj b/project.clj index b193d12..1cea1b9 100644 --- a/project.clj +++ b/project.clj @@ -13,6 +13,9 @@ :plugins [[lein-codox "0.10.4"] [lein-release "1.1.3"]] + :deploy-repositories [["releases" :clojars] + ["snapshots" :clojars]] + ;; `lein release` doesn't work with `git flow release`. To use ;; `lein release`, first merge `develop` into `master`, and then, in branch ;; `master`, run `lein release`