Two more tests pass; fifteen still fail

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.5"]
+  :dependencies [[adl-support "0.1.6-SNAPSHOT"]
                  [bouncer "1.0.1"]
                  [clojure-saxon "0.9.4"]
                  [environ "1.1.0"]
@@ -37,9 +37,7 @@
                   ["codox"]
                   ["change" "version" "leiningen.release/bump-version" "release"]
                   ["vcs" "commit"]
-                  ;; ["vcs" "tag"] -- not working, problems with secret key
                   ["uberjar"]
                   ["install"]
-                  ;; ["deploy" "clojars"] -- also not working
                   ["change" "version" "leiningen.release/bump-version"]
                   ["vcs" "commit"]])

src/adl/to_hugsql_queries.clj

@@ -50,7 +50,7 @@
        (str
         "WHERE "
         (s/join
-         "\n\tAND"
+         "\n\tAND "
          (map
           #(str entity-name "." (safe-name % :sql) " = :" %)
           property-names)))))))
@@ -66,7 +66,7 @@
   (let
     [entity-name (safe-name entity :sql)
      preferred (filter #(#{"user" "all"} (-> % :attrs :distinct))
-                         (children entity #(= (:tag %) :property)))]
+                         (descendants-with-tag entity :property))]
     (if
       (empty? preferred)
       ""
@@ -79,7 +79,10 @@
                (and expanded? (= "entity" (-> % :attrs :type)))
                (str (safe-name % :sql) expanded-token)
                (safe-name % :sql))
-            (flatten (cons preferred (key-properties entity))))))))))
+            (order-preserving-set
+              (concat
+                preferred
+                (key-properties entity))))))))))
 
 ;; (def a (x/parse "../youyesyet/youyesyet.adl.xml"))
 ;; (def e (child-with-tag a :entity #(= "dwellings" (-> % :attrs :name))))
@@ -99,7 +102,7 @@
         query-name (str "create-" pretty-name "!")
         signature (if (has-primary-key? entity)
                     ":? :1" ;; bizarrely, if you want to return the keys,
-                            ;; you have to use a query signature.
+                    ;; you have to use a query signature.
                     ":! :n")]
     (hash-map
       (keyword query-name)
@@ -122,7 +125,7 @@
                      ",\n\t"
                      (map
                        #(safe-name % :sql)
-                           (key-names entity))))))})))
+                       (key-names entity))))))})))
 
 
 (defn update-query

test/adl/to_hugsql_queries_test.clj

@@ -18,6 +18,99 @@
      (= aa bb))
     (= a b)))
 
+(deftest order-by-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 entity)]
+        (is (string-equal-ignore-whitespace? actual expected))))))
+
+
+(deftest keys-name-extraction-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 "keys name extraction"
+      (let [expected #{"id" "postcode"}
+            actual (key-names entity)]
+        (is (= actual expected))))))
+
+
 (deftest entity-tests
   (let [application {:tag :application,
              :attrs {:version "0.1.1", :name "test-app"},
@@ -58,13 +151,6 @@
                  :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)]
@@ -152,10 +238,11 @@
             actual (:signature (first (vals (list-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "delete query generation"
-      (let [expected "-- :name delete-addres! :! :n
+      (let [expected "-- :name delete-address! :! :n
-            -- :doc updates an existing addres record
+            -- :doc deletes an existing address record
             DELETE FROM address
-            WHERE address.id = :id\n\n"
+            WHERE address.id = :id
+            ANDaddress.postcode = :postcode"
             actual (:query (first (vals (delete-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "delete query signature"
@@ -224,8 +311,9 @@
             VALUES (':street',
               ':town',
               ':postcode')
-            returning id,
+            returning
-            postcode\n\n"
+            postcode,
+            id"
             actual (:query (first (vals (insert-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "update query generation - compound key"
@@ -239,25 +327,27 @@
             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
+      (let [expected  "-- :name search-strings-address :? :*
-            -- :doc selects existing address records having any string field matching `:pattern` by substring match
+            -- :doc selects existing address records having any string field matching the parameter of the same name by substring match
-            SELECT * FROM address
+            SELECT DISTINCT * FROM lv_address\nWHERE true
-            WHERE street LIKE '%:pattern%'
+            --~ (if (:street params) (str \"AND street LIKE '%\" (:street params) \"%' \"))
-              OR town LIKE '%:pattern%'
+            --~ (if (:town params) (str \"AND town LIKE '%\" (:town params) \"%' \"))
-              OR postcode LIKE '%:pattern%'
+            --~ (if (:id params) (str \"AND id = :id\"))
-            ORDER BY address.street,
+            --~ (if (:postcode params) (str \"AND postcode LIKE '%\" (:postcode params) \"%' \"))
-              address.postcode,
+            ORDER BY lv_address.street,
-              address.id
+            lv_address.postcode,
+            lv_address.id
             --~ (if (:offset params) \"OFFSET :offset \")
-            --~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
+            --~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
             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
+      (let [expected "-- :name delete-address! :! :n
-            -- :doc updates an existing addres record
+            -- :doc deletes an existing address record
-            DELETE FROM address
+            DELETE FROM address\nWHERE address.id = :id
-            WHERE address.id = :id
+            AND address.postcode = :postcode"
-              AND address.postcode = ':postcode'\n\n"
             actual (:query (first (vals (delete-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))))
 
+;; "-- :name delete-address! :! :n\n-- :doc deletes an existing address record\nDELETE FROM address\nWHERE address.id = :id\n\tAND address.postcode = :postcode"
+;; "-- :name delete-address! :! :n\n-- :doc deletes an existing address record\nDELETE FROM address\nWHERE address.id = :id\n AND address.postcode = :postcode\n\n"))