More unit tests.

src/adl/to_hugsql_queries.clj

@@ -31,22 +31,23 @@
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+
 (defn key-names [entity-map]
+  (let [k (first (filter #(= (:tag %) :key) (:content entity-map)))]
   (remove
     nil?
     (map
       #(:name (:attrs %))
-      (vals (:content (:key (:content entity-map)))))))
+      (filter #(= (:tag %) :property) (:content k))))))
 
 
 (defn has-primary-key? [entity-map]
-  (> (count (key-names entity-map)) 0))
+  (not (empty? (key-names entity-map))))
 
 
 (defn has-non-key-properties? [entity-map]
-  (>
-    (count (vals (:properties (:content entity-map))))
-    (count (key-names entity-map))))
+  (not
+   (empty? (filter #(= (:tag %) :property) (:content entity-map)))))
 
 
 (defn where-clause [entity-map]
@@ -63,22 +64,26 @@
   (let
     [entity-name (:name (:attrs entity-map))
      preferred (map
-                 #(:name (:attrs %))
-                 (filter #(= (-> % :attrs :distinct) "user")
-                         (-> entity-map :content :properties vals)))]
+                #(:name (:attrs %))
+                (filter #(and
+                          (= (-> % :attrs :distinct) "user")
+                          (= (-> % :tag) :property))
+                        (-> entity-map :content)))]
     (str
-      "ORDER BY " entity-name "."
-      (s/join
-        (str ",\n\t" entity-name ".")
-        (doall (flatten (cons preferred (key-names entity-map))))))))
+     "ORDER BY " entity-name "."
+     (s/join
+      (str ",\n\t" entity-name ".")
+      (doall (flatten (cons preferred (key-names entity-map))))))))
 
+(defn property-names [entity-map]
+  (map #(:name (:attrs %)) (filter #(= (-> % :tag) :property) (:content entity-map))))
 
 (defn insert-query [entity-map]
   (let [entity-name (:name (:attrs entity-map))
         pretty-name (singularise entity-name)
-        all-property-names (map #(:name (:attrs %)) (vals (:properties (:content entity-map))))
+        all-property-names (property-names entity-map)
         query-name (str "create-" pretty-name "!")
-        signature " :! :n"]
+        signature ":! :n"]
     (hash-map
       (keyword query-name)
       {:name query-name
@@ -106,11 +111,7 @@
       (has-non-key-properties? entity-map))
     (let [entity-name (:name (:attrs entity-map))
           pretty-name (singularise entity-name)
-          property-names (remove
-                           nil?
-                           (map
-                             #(if (= (:tag %) :property) (:name (:attrs %)))
-                             (vals (:properties (:content entity-map)))))
+          property-names (property-names entity-map)
           query-name (str "update-" pretty-name "!")
           signature ":! :n"]
       (hash-map
@@ -137,8 +138,10 @@
         query-name (str "search-strings-" pretty-name)
         signature ":? :1"
         string-fields (filter
-                       #(= (-> % :attrs :type) "string")
-                       (-> entity-map :content :properties vals))]
+                       #(and
+                         (= (-> % :attrs :type) "string")
+                         (= (:tag %) :property))
+                       (-> entity-map :content))]
     (if
       (empty? string-fields)
       {}
@@ -184,8 +187,6 @@
               "-- :doc selects an existing " pretty-name " record\n"
               "SELECT * FROM " entity-name "\n"
               (where-clause entity-map)
-              "\n"
-              (order-by-clause entity-map)
               "\n\n")}))
     {}))
 

test/adl/to_hugsql_queries_test.clj

@@ -0,0 +1,98 @@
+(ns adl.to-hugsql-queries-test
+  (:require [clojure.test :refer :all]
+            [adl.to-hugsql-queries :refer :all]))
+
+(deftest entity-tests
+  (let [xml {: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
+               {: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,\n\taddress.postcode,\n\taddress.id"
+            actual (order-by-clause xml)]
+        (is (= actual expected))))
+    (testing "keys name extraction"
+      (let [expected '("id")
+            actual (key-names xml)]
+        (is (= actual expected))))
+    (testing "primary key test"
+      (let [expected true
+            actual (has-primary-key? xml)]
+        (is (= actual expected))))
+    (testing "non-key properties test"
+      (let [expected true
+            actual (has-non-key-properties? xml)]
+        (is (= actual expected))))
+    (testing "insert query generation"
+      (let [expected "-- :name create-addres! :! :n\n-- :doc creates a new addres record\nINSERT INTO address (street,\n\ttown,\n\tpostcode)\nVALUES (:street,\n\t:town,\n\t:postcode)\nreturning id\n\n"
+            actual (:query (first (vals (insert-query xml))))]
+        (is (= actual expected))))
+    (testing "insert query signature"
+      (let [expected ":! :n"
+            actual (:signature (first (vals (insert-query xml))))]
+        (is (= actual expected))))
+    (testing "update query generation"
+      (let [expected "-- :name update-addres! :! :n\n-- :doc updates an existing addres record\nUPDATE address\nSET street = :street,\n\ttown = :town,\n\tpostcode = :postcode\nWHERE address.id = :id\n\n"
+            actual (:query (first (vals (update-query xml))))]
+        (is (= actual expected))))
+    (testing "update query signature"
+      (let [expected ":! :n"
+            actual (:signature (first (vals (update-query xml))))]
+        (is (= actual expected))))
+    (testing "search query generation"
+      (let [expected "-- :name search-strings-addres :? :1\n-- :doc selects existing address records having any string field matching `:pattern` by substring match\nSELECT * FROM address\nWHERE street LIKE '%:pattern%'\n\tOR town LIKE '%:pattern%'\n\tOR postcode LIKE '%:pattern%'\nORDER BY address.street,\n\taddress.postcode,\n\taddress.id\n--~ (if (:offset params) \"OFFSET :offset \") \n--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
+            actual (:query (first (vals (search-query xml))))]
+        (is (= actual expected))))
+    (testing "search query signature"
+      (let [expected ":? :1"
+            actual (:signature (first (vals (search-query xml))))]
+        (is (= actual expected))))
+    (testing "select query generation"
+      (let [expected "-- :name get-addres :? :1\n-- :doc selects an existing addres record\nSELECT * FROM address\nWHERE address.id = :id\n\n"
+            actual (:query (first (vals (select-query xml))))]
+        (is (= actual expected))))
+    (testing "select query signature"
+      (let [expected ":? :1"
+            actual (:signature (first (vals (select-query xml))))]
+        (is (= actual expected))))
+    (testing "list query generation"
+      (let [expected "-- :name list-address :? :*\n-- :doc lists all existing addres records\nSELECT * FROM address\nORDER BY address.street,\n\taddress.postcode,\n\taddress.id\n--~ (if (:offset params) \"OFFSET :offset \") \n--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
+            actual (:query (first (vals (list-query xml))))]
+        (is (= actual expected))))
+    (testing "list query signature"
+      (let [expected ":? :*"
+            actual (:signature (first (vals (list-query xml))))]
+        (is (= actual expected))))
+    (testing "delete query generation"
+      (let [expected "-- :name delete-addres! :! :n\n-- :doc updates an existing addres record\nDELETE FROM address\nWHERE address.id = :id\n\n"
+            actual (:query (first (vals (delete-query xml))))]
+        (is (= actual expected))))
+    (testing "delete query signature"
+      (let [expected ":! :n"
+            actual (:signature (first (vals (delete-query xml))))]
+        (is (= actual expected))))
+
+  ))
+