Refactoring in progress...

project.clj

@@ -5,7 +5,7 @@
   :license {:name "GNU Lesser General Public License, version 3.0 or (at your option) any later version"
             :url "https://www.gnu.org/licenses/lgpl-3.0.en.html"}
 
-  :dependencies [[adl-support "0.1.3"]
+  :dependencies [[adl-support "0.1.4-SNAPSHOT"]
                  [bouncer "1.0.1"]
                  [clojure-saxon "0.9.4"]
                  [environ "1.1.0"]
@@ -19,7 +19,10 @@
   :main adl.main
 
   :plugins [[lein-codox "0.10.3"]
-            [lein-release "1.0.5"]]
+            [lein-kibit "0.1.6"]
+            [lein-release "1.0.5"]
+            ;; [uncomplexor "0.1.0-SNAPSHOT"]
+            ]
 
 ;;   :lein-release {:scm :git
 ;;                  :deploy-via :clojars} ;; :deploy-via :clojars fails - with an scp error.

src/adl/main.clj

@@ -92,7 +92,6 @@
 (defn process
   "Process these parsed `options`."
   [options]
-  (do
   (let [p (:path (:options options))
         op (if (.endsWith p "/") p (str p "/"))]
     (binding [*output-path* op
@@ -110,7 +109,7 @@
              (s/to-selmer-routes application)
              (t/to-selmer-templates application))
            (*warn* (str "ERROR: File not found: " %)))
-            (-> options :arguments)))))))
+        (:arguments options))))))
 
 
 (defn -main
@@ -121,7 +120,7 @@
     (cond
       (empty? args)
       (usage options)
-      (not (empty? (:errors options)))
+      (seq (:errors options))
       (do
         (doall
           (map

src/adl/to_hugsql_queries.clj

@@ -46,8 +46,7 @@
    (let
      [entity-name (:name (:attrs entity))
       property-names (map #(:name (:attrs %)) properties)]
-     (if
+     (if-not (empty? property-names)
-       (not (empty? property-names))
        (str
         "WHERE "
         (s/join
@@ -213,8 +212,8 @@
 (defn select-query
   "Generate an appropriate `select` query for this `entity`"
   ([entity properties]
-   (if
+   (if-not
-     (not (empty? properties))
+     (empty? properties)
      (let [entity-name (safe-name (:name (:attrs entity)) :sql)
            pretty-name (singularise entity-name)
            query-name (if (= properties (key-properties entity))
@@ -384,7 +383,8 @@
   [application]
   (let [filepath (str *output-path* "resources/sql/queries.auto.sql")]
     (make-parents filepath)
-    (try
+    (do-or-warn
+     (do
        (spit
         filepath
         (s/join
@@ -396,20 +396,11 @@
            (str "autogenerated by adl.to-hugsql-queries at " (t/now))
            "See [Application Description Language](https://github.com/simon-brooke/adl).")
           (map
-              #(:query %)
+           :query
            (sort
             #(compare (:name %1) (:name %2))
             (vals
              (queries application)))))))
-      (if (> *verbosity* 0)
+       (if (pos? *verbosity*)
-        (*warn* (str "\tGenerated " filepath)))
+         (*warn* (str "\tGenerated " filepath)))))))
-      (catch
-        Exception any
-        (*warn*
-          (str
-            "ERROR: Exception "
-            (.getName (.getClass any))
-            (.getMessage any)
-            " while printing "
-            filepath))))))
 

src/adl/to_json_routes.clj

@@ -53,7 +53,8 @@
          (f/unparse (f/formatters :basic-date-time) (t/now)))
     (list
       :require
-      '[adl-support.core :as support]
+      '[adl-support.core :refer :all]
+      '[adl-support.rest-support :refer :all]
       '[clojure.core.memoize :as memo]
       '[clojure.java.io :as io]
       '[clojure.tools.logging :as log]
@@ -72,28 +73,38 @@
 (defn generate-handler-body
   "Generate and return the function body for the handler for this `query`."
   [query]
-  (let [action (list
-                 (symbol (str "db/" (:name query)))
-                 'db/*db*
-                 (list 'support/massage-params
-                       'params
-                       'form-params
-                       (key-names (:entity query))))]
   (list
-     [{:keys ['params 'form-params]}]
+   ['request]
-     (case
-       (:type query)
-       (:delete-1 :update-1)
-       (list
-         action
-         `(log/debug (str ~(:name query) " called with params " ~'params "."))
-         '(response/found "/"))
    (list
     'let
-         (vector 'result action)
+    ['params '(massage-params request)]
-         `(log/debug (~(symbol (str "db/" (:name query) "-sqlvec")) ~'params))
+    (list
-         `(log/debug (str ~(str "'" (:name query) "' with params ") ~'params " returned " (count ~'result) " records."))
+     'valid-user-or-forbid
-         (list 'response/ok 'result))))))
+     (list
+      'with-params-or-error
+      (list
+       'do-or-server-fail
+       (list
+        (symbol (str "db/" (:name query)))
+        'db/*db*
+        'params)
+       (case (:type query)
+         :insert-1 201 ;; created
+         :delete-1 204 ;; no content
+         ;; default
+         200)) ;; OK
+      'params
+      (set
+       (map
+        #(keyword (:name (:attrs %)))
+        (case (:type query)
+          (:insert-1 :update-1)
+          (-> query :entity insertable-properties)
+          (:select-1 :delete-1)
+          (-> query :entity key-properties)
+          ;; default
+          nil))))
+     'request))))
 
 
 (defn generate-handler-src
@@ -262,7 +273,7 @@
   (let [handlers-map (make-handlers-map application)
         filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto_json.clj")]
     (make-parents filepath)
-    (try
+    (do-or-warn
       (with-open [output (writer filepath)]
         (binding [*out* output]
           (pprint (file-header application))
@@ -275,16 +286,7 @@
                 h)
               (sort (keys handlers-map))))
           (pprint (defroutes handlers-map))))
-      (if (> *verbosity* 0)
+      (if (pos? *verbosity*)
-        (*warn* (str "\tGenerated " filepath)))
+        (*warn* (str "\tGenerated " filepath))))))
-      (catch
-        Exception any
-        (*warn*
-          (str
-            "ERROR: Exception "
-            (.getName (.getClass any))
-            (.getMessage any)
-            " while printing "
-            filepath))))))
 
 

src/adl/to_psql.clj

@@ -111,7 +111,12 @@
 (defn emit-field-type
   [property entity application key?]
   (case (:type (:attrs property))
-    "integer" (if key? "SERIAL" "INTEGER")
+    "integer" (if
+                (and
+                 key?
+                 (system-generated? property))
+                "SERIAL"
+                "INTEGER")
     "real" "DOUBLE PRECISION"
     ("string" "image" "uploadable")
     (str "VARCHAR(" (:size (:attrs property)) ")")
@@ -150,8 +155,8 @@
               #(if (selector (:permission (:attrs %)))
                  (safe-name (:group (:attrs %)) :sql))
               permissions)))]
-    (if
+    (if-not
-      (not (empty? group-names))
+      (empty? group-names)
       (s/join
         " "
         (list
@@ -318,12 +323,12 @@
                          (str (safe-name entity) "." (field-name %)))
                        (str (safe-name entity) "." (field-name %)))
                     (filter
-                      #(not (= (:type (:attrs %)) "link"))
+                      #(not= (:type (:attrs %)) "link")
                       (all-properties entity) )))))
             (str
               "FROM " (s/join ", " (set (compose-convenience-view-select-list entity application true))))
-            (if
+            (if-not
-              (not (empty? entity-fields))
+              (empty? entity-fields)
               (str
                 "WHERE "
                 (s/join
@@ -408,7 +413,7 @@
              (list
                doc-comment
                (map
-                 #(:content %)
+                 :content
                  (children-with-tag entity :documentation))))
            (s/join
              " "
@@ -427,7 +432,7 @@
                      (map
                        #(emit-property % entity application false)
                        (filter
-                         #(not (= (:type (:attrs %)) "link"))
+                         #(not= (:type (:attrs %)) "link")
                          (children-with-tag entity :property)))))))
              "\n);")
            (map
@@ -532,7 +537,7 @@
     (str "(https://github.com/simon-brooke/adl) at "
          (f/unparse (f/formatters :basic-date-time) (t/now)))
     (map
-      #(:content %)
+      :content
       (children-with-tag application :documentation))))
 
 
@@ -568,18 +573,10 @@
                    (:name (:attrs application))
                    ".postgres.sql")]
     (make-parents filepath)
-    (try
+    (do-or-warn
       (spit filepath (emit-application application))
-      (if (> *verbosity* 0)
+      (if
-        (*warn* (str "\tGenerated " filepath)))
+        (pos? *verbosity*)
-      (catch
+        (*warn* (str "\tGenerated " filepath))))))
-        Exception any
-        (*warn*
-          (str
-            "ERROR: Exception "
-            (.getName (.getClass any))
-            (.getMessage any)
-            " while printing "
-            filepath))))))
 
 

src/adl/to_selmer_routes.clj

@@ -50,6 +50,7 @@
         (f/unparse (f/formatters :basic-date-time) (t/now)))
    (list
     :require
+    '[adl-support.forms-support :refer :all]
     '[adl-support.core :as support]
     '[clojure.java.io :as io]
     '[clojure.set :refer [subset?]]
@@ -67,21 +68,15 @@
 
 (defn make-form-handler-content
   [f e a n]
-  (let [warning (list 'str (str "Error while fetching " (singularise (:name (:attrs e))) " record ") 'params)]
+  (let [entity-name (singularise (:name (:attrs e)))]
     ;; TODO: as yet makes no attempt to save the record
     (list 'let
           (vector
             'record (list
-                      'support/do-or-log-error
+                     'get-current-value
-                      ;;(list 'if (list 'subset? (key-names e) (list 'set (list 'keys 'params)))
+                     (symbol (str "db/get-" entity-name))
-                            (list
+                     'params
-                              (symbol
+                     entity-name))
-                                (str "db/get-" (singularise (:name (:attrs e)))))
-                              (symbol "db/*db*")
-                              'params)
-                      ;;)
-                      :message warning
-                      :error-return {:warnings [warning]}))
           (reduce
             merge
             {:error (list :warnings 'record)
@@ -199,10 +194,7 @@
       (vector 'request)
       (list 'let (vector
                    'params
-                   (list 'support/massage-params
+                   (list 'support/massage-params 'request))
-                         (list 'keywordize-keys (list :params 'request))
-                         (list 'keywordize-keys (list :form-params 'request))
-                         (key-names e true)))
             (list
               'l/render
               (list 'support/resolve-template (str n ".html"))
@@ -303,7 +295,7 @@
   [application]
   (let [filepath (str *output-path* "src/clj/" (:name (:attrs application)) "/routes/auto.clj")]
     (make-parents filepath)
-    (try
+    (do-or-warn
       (with-open [output (writer filepath)]
         (binding [*out* output]
           (pprint (file-header application))
@@ -330,15 +322,7 @@
           (println)
           (pprint (make-defroutes application))
           (println)))
-      (if (> *verbosity* 0)
+      (if
-        (*warn* (str "\tGenerated " filepath)))
+        (pos? *verbosity*)
-      (catch
+        (*warn* (str "\tGenerated " filepath))))))
-        Exception any
-        (*warn*
-         (str
-          "ERROR: Exception "
-          (.getName (.getClass any))
-          (.getMessage any)
-          " while printing "
-          filepath))))))
 

src/adl/to_selmer_templates.clj

@@ -62,7 +62,7 @@
 
 (defn emit-content
   ([content]
-   (try
+   (do-or-warn
      (cond
        (nil? content)
        nil
@@ -82,7 +82,7 @@
          "';\n"
          (-> any .getClass .getName)
          ": "
-         (-> any .getMessage)
+         (.getMessage any)
          " -->"))))
   ([filename application k]
    (emit-content filename nil nil application k))
@@ -356,46 +356,14 @@
                   "{% endif %}")))})
 
 
-(defn widget
+(defn compose-input-widget-para
-  "Generate a widget for this `field-or-property` of this `form` for this `entity`
+  "Generate an input widget for this `field-or-property` of this `form` for
-  taken from within this `application`."
+  this `entity` taken from within this `application`, in context of a para
-  [field-or-property form entity application]
+  also containing its label."
+  [property form entity application widget-name]
   (let
-    [widget-name (safe-name
+    [typedef (typedef property application)
-                   (if (= (:tag field-or-property) :property)
+     w-type (widget-type property application typedef)]
-                     (:name (:attrs field-or-property))
-                     (:property (:attrs field-or-property))) :sql)
-     property (case
-                (:tag field-or-property)
-                :property field-or-property
-                :field (property-for-field field-or-property entity)
-                ;; default
-                nil)
-     permissions (find-permissions field-or-property property form entity application)
-     typedef (typedef property application)
-     w-type (widget-type property application typedef)
-     visible-to (visible-to permissions)
-     ;; if the form isn't actually a form, no widget is writeable.
-     writeable-by (if (= (:tag form) :form) (writeable-by permissions))]
-    (if
-      property
-      (case w-type
-        "hidden"
-        {:tag :input
-         :attrs {:id widget-name
-                 :name widget-name
-                 :type "hidden"
-                 :value (str "{{record." widget-name "}}")}}
-        "select"
-        (compose-widget-para property form entity application widget-name
-                             (select-widget property form entity application))
-        "text-area"
-        (compose-widget-para
-          property form entity application widget-name
-          {:tag :textarea
-           :attrs {:rows "8" :cols "60" :id widget-name :name widget-name}
-           :content [(str "{{record." widget-name "}}")]})
-        ;; all others
     (compose-widget-para
      property form entity application widget-name
      {:tag :input
@@ -415,12 +383,51 @@
                       "60"
                       true
                       (:size (:attrs property)))}
+              ;; TODO: should match pattern from typedef
               (if
                 (:minimum (:attrs typedef))
                 {:min (:minimum (:attrs typedef))})
               (if
                 (:maximum (:attrs typedef))
-                      {:max (:maximum (:attrs typedef))}))})))))
+                {:max (:maximum (:attrs typedef))}))})))
+
+
+(defn widget
+  "Generate a widget for this `field-or-property` of this `form` for this `entity`
+  taken from within this `application`, in context of a para also containing its
+  label."
+  [field-or-property form entity application]
+  (let
+    [widget-name (safe-name
+                   (if (= (:tag field-or-property) :property)
+                     (:name (:attrs field-or-property))
+                     (:property (:attrs field-or-property))) :sql)
+     property (case
+                (:tag field-or-property)
+                :property field-or-property
+                :field (property-for-field field-or-property entity)
+                ;; default
+                nil)]
+    (if
+      property
+      (case w-type
+        "hidden"
+        {:tag :input
+         :attrs {:id widget-name
+                 :name widget-name
+                 :type "hidden"
+                 :value (str "{{record." widget-name "}}")}}
+        "select"
+        (compose-widget-para property form entity application widget-name
+                             (select-widget property form entity application))
+        "text-area"
+        (compose-widget-para
+          property form entity application widget-name
+          {:tag :textarea
+           :attrs {:rows "8" :cols "60" :id widget-name :name widget-name}
+           :content [(str "{{record." widget-name "}}")]})
+        ;; all others
+        (compose-input-widget-para property form entity application widget-name)))))
 
 
 (defn embed-script-fragment
@@ -898,7 +905,7 @@
   (let [filepath (str *output-path* "resources/templates/auto/" filename)]
     (if
       template
-      (try
+      (do-or-warn
         (do
           (make-parents filepath)
           (spit
@@ -917,7 +924,9 @@
                     "{% endblock %}"))
                    (keys template)))
               (file-footer filename application)))))
-          (if (> *verbosity* 0) (*warn* "\tGenerated " filepath)))
+          (if
+            (pos? *verbosity*)
+            (*warn* "\tGenerated " filepath)))
         (catch Exception any
           (let [report (str
                         "ERROR: Exception "
@@ -925,7 +934,7 @@
                         (.getMessage any)
                         " while printing "
                         filepath)]
-            (try
+            (do-or-warn
               (spit
                filepath
                (with-out-str
@@ -962,7 +971,7 @@
         #(if
            (templates-map %)
            (let [filename (str (name %) ".html")]
-             (try
+             (do-or-warn
                (write-template-file filename (templates-map %) application)
                (catch Exception any
                  (*warn*

test/adl/to_hugsql_queries_test.clj

@@ -19,141 +19,10 @@
     (= a b)))
 
 (deftest entity-tests
-  (let [xml {:tag :entity,
+  (let [application {:tag :application,
-             :attrs {:name "address"},
+             :attrs {:version "0.1.1", :name "test-app"},
              :content
-             [{:tag :key,
+             [{:tag :entity,
-               :attrs nil,
-               :content
-               [{:tag :property,
-                 :attrs
-                 {:immutable "true",
-                  :required "true",
-                  :distinct "system",
-                  :type "integer",
-                  :name "id"},
-                 :content
-                 [{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
-              {:tag :property,
-               :attrs
-               {:distinct "user", :size "128", :type "string", :name "street"},
-               :content nil}
-              {:tag :property,
-               :attrs {:size "64", :type "string", :name "town"},
-               :content nil}
-              {:tag :property,
-               :attrs
-               {:distinct "user", :size "12", :type "string", :name "postcode"},
-               :content nil}]}]
-    (testing "user distinct properties should provide the default ordering"
-      (let [expected
-            "ORDER BY address.street,
-            address.postcode,
-            address.id"
-            actual (order-by-clause xml)]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "keys name extraction"
-      (let [expected '("id")
-            actual (key-names xml)]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "primary key test"
-      (let [expected true
-            actual (has-primary-key? xml)]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "non-key properties test"
-      (let [expected true
-            actual (has-non-key-properties? xml)]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "insert query generation"
-      (let [expected "-- :name create-addres! :! :n
-            -- :doc creates a new addres record
-            INSERT INTO address (street,
-              town,
-              postcode)
-            VALUES (':street',
-              ':town',
-              ':postcode')
-            returning id\n\n"
-            actual (:query (first (vals (insert-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "insert query signature"
-      (let [expected ":! :n"
-            actual (:signature (first (vals (insert-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "update query generation"
-      (let [expected "-- :name update-addres! :! :n
-            -- :doc updates an existing addres record
-            UPDATE address
-            SET street = :street,
-              town = :town,
-              postcode = :postcode
-            WHERE address.id = :id\n\n"
-            actual (:query (first (vals (update-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "update query signature"
-      (let [expected ":! :n"
-            actual (:signature (first (vals (update-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "search query generation"
-      (let [expected "-- :name search-strings-addres :? :1
-            -- :doc selects existing address records having any string field matching `:pattern` by substring match
-            SELECT * FROM address
-            WHERE street LIKE '%:pattern%'
-              OR town LIKE '%:pattern%'
-              OR postcode LIKE '%:pattern%'
-            ORDER BY address.street,
-              address.postcode,
-              address.id
-            --~ (if (:offset params) \"OFFSET :offset \")
-            --~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
-            actual (:query (first (vals (search-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "search query signature"
-      (let [expected ":? :1"
-            actual (:signature (first (vals (search-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "select query generation"
-      (let [expected "-- :name get-addres :? :1
-            -- :doc selects an existing addres record
-            SELECT * FROM address
-            WHERE address.id = :id\n\n"
-            actual (:query (first (vals (select-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "select query signature"
-      (let [expected ":? :1"
-            actual (:signature (first (vals (select-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "list query generation"
-      (let [expected "-- :name list-address :? :*
-            -- :doc lists all existing addres records
-            SELECT * FROM address
-            ORDER BY address.street,
-              address.postcode,
-              address.id
-            --~ (if (:offset params) \"OFFSET :offset \")
-            --~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
-            actual (:query (first (vals (list-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "list query signature"
-      (let [expected ":? :*"
-            actual (:signature (first (vals (list-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "delete query generation"
-      (let [expected "-- :name delete-addres! :! :n
-            -- :doc updates an existing addres record
-            DELETE FROM address
-            WHERE address.id = :id\n\n"
-            actual (:query (first (vals (delete-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-    (testing "delete query signature"
-      (let [expected ":! :n"
-            actual (:signature (first (vals (delete-query xml))))]
-        (is (string-equal-ignore-whitespace? actual expected))))
-
-  ))
-
-(deftest complex-key-tests
-  (let [xml {:tag :entity,
                :attrs {:name "address"},
                :content
                [{:tag :key,
@@ -187,20 +56,168 @@
                 {:tag :property,
                  :attrs {:size "64", :type "string", :name "town"},
                  :content nil}
-              ]}]
+                ]}]}
+        entity (child-with-tag application :entity)]
+    (testing "user distinct properties should provide the default ordering"
+      (let [expected
+            "ORDER BY address.street,
+            address.postcode,
+            address.id"
+            actual (order-by-clause entity)]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "keys name extraction"
+      (let [expected #{"id"}
+            actual (key-names entity)]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "primary key test"
+      (let [expected true
+            actual (has-primary-key? entity)]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "non-key properties test"
+      (let [expected true
+            actual (has-non-key-properties? entity)]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "insert query generation"
+      (let [expected "-- :name create-address! :! :n
+            -- :doc creates a new address record
+            INSERT INTO address (street,
+              town,
+              postcode)
+            VALUES (':street',
+              ':town',
+              ':postcode')
+            returning id\n\n"
+            actual (:query (first (vals (insert-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "insert query signature"
+      (let [expected ":! :n"
+            actual (:signature (first (vals (insert-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "update query generation"
+      (let [expected "-- :name update-address! :! :n
+            -- :doc updates an existing address record
+            UPDATE address
+            SET street = :street,
+              town = :town,
+              postcode = :postcode
+            WHERE address.id = :id\n\n"
+            actual (:query (first (vals (update-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "update query signature"
+      (let [expected ":! :n"
+            actual (:signature (first (vals (update-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "search query generation"
+      (let [expected "-- :name search-strings-addres :? :1
+            -- :doc selects existing address records having any string field matching `:pattern` by substring match
+            SELECT * FROM address
+            WHERE street LIKE '%:pattern%'
+              OR town LIKE '%:pattern%'
+              OR postcode LIKE '%:pattern%'
+            ORDER BY address.street,
+              address.postcode,
+              address.id
+            --~ (if (:offset params) \"OFFSET :offset \")
+            --~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
+            actual (:query (first (vals (search-query entity application))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "search query signature"
+      (let [expected ":? :1"
+            actual (:signature (first (vals (search-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "select query generation"
+      (let [expected "-- :name get-addres :? :1
+            -- :doc selects an existing addres record
+            SELECT * FROM address
+            WHERE address.id = :id\n\n"
+            actual (:query (first (vals (select-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "select query signature"
+      (let [expected ":? :1"
+            actual (:signature (first (vals (select-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "list query generation"
+      (let [expected "-- :name list-address :? :*
+            -- :doc lists all existing addres records
+            SELECT * FROM address
+            ORDER BY address.street,
+              address.postcode,
+              address.id
+            --~ (if (:offset params) \"OFFSET :offset \")
+            --~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
+            actual (:query (first (vals (list-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "list query signature"
+      (let [expected ":? :*"
+            actual (:signature (first (vals (list-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "delete query generation"
+      (let [expected "-- :name delete-addres! :! :n
+            -- :doc updates an existing addres record
+            DELETE FROM address
+            WHERE address.id = :id\n\n"
+            actual (:query (first (vals (delete-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+    (testing "delete query signature"
+      (let [expected ":! :n"
+            actual (:signature (first (vals (delete-query entity))))]
+        (is (string-equal-ignore-whitespace? actual expected))))
+
+  ))
+
+(deftest complex-key-tests
+  (let [application {:tag :application,
+             :attrs {:version "0.1.1", :name "test-app"},
+             :content
+             [{:tag :entity,
+               :attrs {:name "address"},
+               :content
+               [{:tag :key,
+                 :attrs nil,
+                 :content
+                 [{:tag :property,
+                   :attrs
+                   {:immutable "true",
+                    :required "true",
+                    :distinct "system",
+                    :type "integer",
+                    :name "id"},
+                   :content
+                   [{:tag :generator, :attrs {:action "native"}, :content nil}]}
+                  {:tag :property,
+                   :attrs
+                   {:immutable "true",
+                    :required "true",
+                    :distinct "all",
+                    :generator "assigned"
+                    :type "string",
+                    :size "12"
+                    :name "postcode"},
+                   :content
+                   [{:tag :generator, :attrs {:action "native"}, :content nil}]}
+                  ]}
+                {:tag :property,
+                 :attrs
+                 {:distinct "user", :size "128", :type "string", :name "street"},
+                 :content nil}
+                {:tag :property,
+                 :attrs {:size "64", :type "string", :name "town"},
+                 :content nil}
+                ]}]}
+        entity (child-with-tag application :entity)]
     (testing "user distinct properties should provide the default ordering"
       (let [expected "ORDER BY address.street,
             address.postcode,
             address.id"
-            actual (order-by-clause xml)]
+            actual (order-by-clause entity)]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "keys name extraction"
-      (let [expected '("id" "postcode")
+      (let [expected #{"id" "postcode"}
-            actual (key-names xml)]
+            actual (key-names entity)]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "insert query generation - compound key, non system generated field in key"
-      (let [expected "-- :name create-addres! :! :n
+      (let [expected "-- :name create-address! :! :n
-            -- :doc creates a new addres record
+            -- :doc creates a new address record
             INSERT INTO address (street,
               town,
               postcode)
@@ -209,17 +226,17 @@
               ':postcode')
             returning id,
             postcode\n\n"
-            actual (:query (first (vals (insert-query xml))))]
+            actual (:query (first (vals (insert-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "update query generation - compound key"
-      (let [expected "-- :name update-addres! :! :n
+      (let [expected "-- :name update-address! :! :n
-            -- :doc updates an existing addres record
+            -- :doc updates an existing address record
             UPDATE address
             SET street = :street,
               town = :town
             WHERE address.id = :id
               AND address.postcode = ':postcode'\n\n"
-            actual (:query (first (vals (update-query xml))))]
+            actual (:query (first (vals (update-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "search query generation - user-distinct field in key"
       (let [expected  "-- :name search-strings-addres :? :1
@@ -233,7 +250,7 @@
               address.id
             --~ (if (:offset params) \"OFFSET :offset \")
             --~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
-            actual (:query (first (vals (search-query xml))))]
+            actual (:query (first (vals (search-query entity application))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "delete query generation - compound key"
       (let [expected "-- :name delete-addres! :! :n
@@ -241,6 +258,6 @@
             DELETE FROM address
             WHERE address.id = :id
               AND address.postcode = ':postcode'\n\n"
-            actual (:query (first (vals (delete-query xml))))]
+            actual (:query (first (vals (delete-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))))