Merge branch 'develop'

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.

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.

project.clj

@@ -1,16 +1,20 @@
-(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"
             :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"]
+                 [org.clojure/tools.logging "0.4.1"]
-                 [selmer "1.10.6"]]
+                 [selmer "1.11.8"]]
 
-  :plugins [[lein-codox "0.10.3"]
+  :plugins [[lein-codox "0.10.4"]
-            [lein-release "1.0.5"]]
+            [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

src/adl_support/core.clj

@@ -1,6 +1,9 @@
 (ns adl-support.core
-  (:require [clojure.java.io :as io]
+  (:require [clojure.core.memoize :as memo]
-            [clojure.string :refer [split]]))
+            [clojure.data.json :as json]
+            [clojure.java.io :as io]
+            [clojure.string :refer [split join]]
+            [clojure.tools.logging]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;
@@ -26,71 +29,64 @@
   (fn [s] (println s)))
 
 
-(defn query-string-to-map
-  "A `query-string` - the query-part of a URL - comprises generally
-  `<name>=<value>&<name>=<value>...`; 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."
   [k m]
   (let [v (m k)
         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})))
 
 
-(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.
+  Date and time fields also need massaging."
+  ([request entity]
+   (let
+     [params (:params request)
+      form-params (:form-params request)
+      p (reduce
+         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))))))
+  ([request]
+   (raw-massage-params request nil)))
+
+
+(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."
-  [params form-params key-fields]
+  (memo/ttl raw-massage-params {} :ttl/threshold 5000))
-  (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)))))
 
 
 (defn
@@ -105,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
@@ -116,10 +149,68 @@
   `(try
      ~form
      (catch Exception any#
-       (clojure.tools.logging/error
+       (compose-reason-and-log any# ~message)
-        (str ~message
-             (with-out-str
-               (-> any# .printStackTrace))))
        ~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."
+  ([form intro]
+  `(try
+     {:result ~form}
+     (catch Exception any#
+       {:error (compose-exception-reason any# ~intro)})))
+  ([form]
+   `(do-or-return-reason ~form nil)))
+
+
+(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* (compose-reason-and-log any# ~intro ))
+        nil))))
+

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 ^:dynamic *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 "<a href='tel:" number "'>" arg "</a>")]
+      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 "<a href='mailto:" arg "'>" arg "</a>")]
+    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"})

src/adl_support/forms_support.clj

@@ -0,0 +1,115 @@
+(ns adl-support.forms-support
+  (: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]
+            [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#]})))
+
+
+(defmacro get-menu-options
+  [entity-name get-q list-q fk value]
+  `(remove
+    nil?
+    (flatten
+     (list
+      (if
+        ~value
+        (do-or-log-error
+         (apply
+          ~get-q
+          (list db/*db* {~fk ~value}))
+         :message
+         (str "Error while fetching " ~entity-name " record '" ~value "'")))
+      (do-or-log-error
+       (apply
+        ~list-q
+        (list db/*db*)
+        {})
+       :message
+       (str "Error while fetching " ~entity-name " list"))))))
+
+
+(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))
+
+
+(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))))
+
+
+(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`."
+  ;; 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))
+    ~params))
+
+
+(defn property-defaults
+  [entity]
+  (reduce
+    merge {}
+    (map
+      #(hash-map (keyword (-> % :attrs :name)) (-> % :attrs :default))
+      (descendants-with-tag entity :property #(-> % :attrs :default)))))

src/adl_support/rest_support.clj

@@ -0,0 +1,80 @@
+(ns adl-support.rest-support
+  (: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.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.
+;;;;
+;;;; 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#})))
+
+

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
@@ -83,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."
@@ -281,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))
 
 
@@ -292,25 +272,115 @@
 
 (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]
-   (if
+   (cond
      (element? o)
      (safe-name (:name (:attrs o)))
+     true
      (s/replace (str o) #"[^a-zA-Z0-9-]" "")))
   ([o convention]
-   (if
+   (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)
+     (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)
-     (let [string (str o)]
+     true
+     (let [string (str o)
+           capitalised (capitalise string)]
        (case convention
          (:sql :c) (s/replace string #"[^a-zA-Z0-9_]" "_")
-         :c-sharp (s/replace (capitalise string) #"[^a-zA-Z0-9]" "")
+         :c-sharp (s/replace capitalised #"[^a-zA-Z0-9]" "")
          :java (let
-                 [camel (s/replace (capitalise string) #"[^a-zA-Z0-9]" "")]
+                 [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)
+
+
+(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
+                                     #(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)))
+
+
+(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))]
+      (str "list-"
+           (safe-name (first ordered) :sql)
+           "-by-"
+           (safe-name (nth ordered 1) :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)
+     (link-table-name e1 e2)
+     (s/join
+       "_" (cons "ln" (map #(:name (:attrs %)) (list property e1)))))))
+
+
+(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."
+  [property nearside farside]
+  (if
+     (and
+      (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)))
+       "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)))
+
 
 (defn property-for-field
   "Return the property within this `entity` which matches this `field`."
@@ -396,13 +466,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 (#{"link" "list"} (:type (:attrs property))))
-    (not (= (:distinct (:attrs property)) "system"))))
+    (not (system-generated? property))))
 
 
 (defmacro all-properties
@@ -426,6 +506,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"
@@ -435,6 +523,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))

test/adl_support/core_test.clj

@@ -2,43 +2,60 @@
   (: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}
-          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})]
+          actual (massage-params {:params {:id "67" :offset "0" :limit "50"} :form-params {}})]
-      (is (= expected actual) "Limit and offset in 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"))
+    (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
+  (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"))
+    (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?
+;; (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"))
+;;     ))

test/adl_support/forms_support_test.clj

@@ -0,0 +1,34 @@
+(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..."))))
+
+
+(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")))

test/adl_support/rest_support_test.clj

@@ -0,0 +1,38 @@
+(ns adl-support.rest-support-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 {}}))]
+      (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")))

test/adl_support/utils_test.clj

@@ -1,9 +1,17 @@
 (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.
 
+(deftest singularise-tests
+  (testing "Singularise"
+    (is (= "address" (singularise "addresses")))
+    (is (= "address" (singularise "address")))
+    (is (= "expertise" (singularise "expertise")))))
+
+
 (deftest child-with-tag-tests
   (testing "child-with-tag"
     (let [expected {:tag :prompt
@@ -297,3 +305,296 @@
           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}]}]}
+          property (child e2 #(= (-> % :attrs :name) "gender"))
+          expected "list-electors-by-gender"
+          actual (list-related-query-name property e2 e1)]
+      (is (= expected actual) "just checking..."))
+    (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")))))
+
+
+(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"))))
+
+(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"))))
+
+
+(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})))))
+