From e2aa97945801a7dd1580212c8a4dd89a39848b83 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Tue, 12 Nov 2019 15:10:26 +0000
Subject: [PATCH] All unit tests passing.

---
 src/adl/to_hugsql_queries.clj       |   5 +-
 src/adl/validator.clj               |  25 +++---
 test/adl/to_hugsql_queries_test.clj | 117 +++++++++++++++-------------
 test/adl/validator_test.clj         |   4 +-
 4 files changed, 82 insertions(+), 69 deletions(-)

diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj
index b10b2bd..6f2b1b9 100644
--- a/src/adl/to_hugsql_queries.clj
+++ b/src/adl/to_hugsql_queries.clj
@@ -101,8 +101,7 @@
                                     (insertable-properties entity))
         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.
+                    ":<!"
                     ":! :n")]
     (hash-map
       (keyword query-name)
@@ -159,7 +158,7 @@
 
 
 (defn search-query [entity application]
-  "Generate an appropriate search query for string fields of this `entity`"
+  "Generate an appropriate search query for string fields of this `entity` within this `application`"
   (let [entity-name (safe-name entity :sql)
         pretty-name (singularise entity-name)
         query-name (str "search-strings-" entity-name)
diff --git a/src/adl/validator.clj b/src/adl/validator.clj
index 6bb57dc..d47dc4e 100644
--- a/src/adl/validator.clj
+++ b/src/adl/validator.clj
@@ -10,7 +10,7 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;
-;;;; squirrel-parse.to-adl: validate Application Description Language.
+;;;; Application Description Language: validator for ADL structure
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU General Public License
@@ -55,7 +55,7 @@
           :context o} o]))
     [(str "Error: not a symbol" validation) o]))
 
-(defmacro disjunct-valid?
+(defn disjunct-valid?
   "Yes, this is a horrible hack. I should be returning the error structure
    not printing it. But I can't see how to make that work with `bouncer`.
    OK, so: most of the validators will (usually) fail, and that's OK. How
@@ -66,7 +66,6 @@
     (if (:tag ~o) (str "Tag: " (:tag ~o) "; "))
     (if (:name (:attrs ~o)) (str "Name: " (:name (:attrs ~o)) ";"))
     (if-not (or (:tag ~o) (:name (:attrs ~o))) (str "Context: " ~o))))
-
   `(empty?
      (remove :tag (remove nil? (map first (map
          #(try-validate ~o '%)
@@ -211,17 +210,21 @@
                         documentation-validations
                         reference-validations)]]})
 
+(v/defvalidator documentation-content-validator
+  {:default-message-format "%s must be a sequence containing only strings and references"}
+  [value]
+  (let
+    [no-strings (remove string? value)]
+    (and
+      (every? map? no-strings)
+      (map #(b/valid? % reference-validations) no-strings))))
 
 (def documentation-validations
   "contains documentation on the element which immediately contains it. TODO:
   should HTML markup within a documentation element be allowed? If so, are
   there restrictions?"
   {:tag [v/required [#(= % :documentation)]]
-   :content [[v/every #(disjunct-valid?
-                        %
-                        v/string
-                        reference-validations)]]
-                        })
+   :content documentation-content-validator})
 
 (def content-validations
   {:tag [v/required [#(= % :content)]]})
@@ -337,7 +340,7 @@
    [:attrs :target] [v/string v/required]
    [:attrs :value] [v/string v/required]
    [:attrs :kind] v/string
-   :content [[v/every documentation-validations]]})
+   :content [[v/every #(b/valid? % documentation-validations)]]})
 
 (def typedef-validations
   "the definition of a defined type. At this stage a defined type is either
@@ -384,7 +387,7 @@
   {:tag [v/required [#(= % :group)]]
    [:attrs :name] [v/string v/required]
    [:attrs :parent] v/string
-   :content [[v/every documentation-validations]]})
+   :content [[v/every #(b/valid? % documentation-validations)]]})
 
 (def property-validations
 	"a property (field) of an entity (table)
@@ -608,7 +611,7 @@
 
 (def key-validations
   {:tag [v/required [#(= % :key)]]
-   :content [[v/every property-validations]]})
+   :content [[v/every #(b/validate % property-validations)]]})
 
 
 (def entity-validations
diff --git a/test/adl/to_hugsql_queries_test.clj b/test/adl/to_hugsql_queries_test.clj
index 513a57e..9c46782 100644
--- a/test/adl/to_hugsql_queries_test.clj
+++ b/test/adl/to_hugsql_queries_test.clj
@@ -13,11 +13,23 @@
    (string? b))
    (let
      [pattern #"[\s]+"
-      aa (s/replace a pattern " ")
-      bb (s/replace b pattern " ")]
+      aa (s/replace (s/trim a) pattern " ")
+      bb (s/replace (s/trim b) pattern " ")]
      (= aa bb))
     (= a b)))
 
+(string-equal-ignore-whitespace?
+"-- :name create-address! :<!\n-- :doc creates a new address record\nINSERT INTO address (street,\n\ttown,\n\tpostcode)\nVALUES (:street,\n\t:town,\n\t:postcode)\nreturning postcode,\n\tid" "-- :name create-address! :<!\n            -- :doc creates a new address record\n            INSERT INTO address (street,\n              town,\n              postcode)\n            VALUES (':street',\n              ':town',\n              ':postcode')\n            returning\n            postcode,\n            id")
+(s/replace
+    "-- :name create-address! :<!\n-- :doc creates a new address record\nINSERT INTO address (street,\n\ttown,\n\tpostcode)\nVALUES (:street,\n\t:town,\n\t:postcode)\nreturning postcode,\n\tid"
+  #"[\s]+"
+  " ")
+(s/replace
+    (s/trim "-- :name update-address! :! :n\n            -- :doc updates an existing address record\n            UPDATE address\n            SET street = :street,\n              town = :town,\n              postcode = :postcode\n            WHERE address.id = :id\n              AND address.postcode = :postcode\n\n")
+  #"[\s]+"
+  " ")
+
+
 (deftest order-by-tests
   (let [application {:tag :application,
              :attrs {:version "0.1.1", :name "test-app"},
@@ -112,6 +124,7 @@
 
 
 (deftest entity-tests
+  ;; NOTE: generally identical to `complex-key-tests`, below, except that the key is not complex
   (let [application {:tag :application,
              :attrs {:version "0.1.1", :name "test-app"},
              :content
@@ -130,17 +143,6 @@
                     :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
@@ -149,6 +151,13 @@
                 {:tag :property,
                  :attrs {:size "64", :type "string", :name "town"},
                  :content nil}
+                {:tag :property,
+                 :attrs
+                 {:required "true",
+                  :distinct "user",
+                  :type "string",
+                  :size "12"
+                  :name "postcode"}}
                 ]}]}
         entity (child-with-tag application :entity)]
     (testing "keys name extraction"
@@ -164,19 +173,19 @@
             actual (has-non-key-properties? entity)]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "insert query generation"
-      (let [expected "-- :name create-address! :! :n
+      (let [expected "-- :name create-address! :<!
             -- :doc creates a new address record
             INSERT INTO address (street,
               town,
               postcode)
-            VALUES (':street',
-              ':town',
-              ':postcode')
-            returning id\n\n"
+            VALUES (:street,
+              :town,
+              :postcode)
+            returning id"
             actual (:query (first (vals (insert-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "insert query signature"
-      (let [expected ":! :n"
+      (let [expected ":<!"
             actual (:signature (first (vals (insert-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "update query generation"
@@ -186,7 +195,7 @@
             SET street = :street,
               town = :town,
               postcode = :postcode
-            WHERE address.id = :id\n\n"
+            WHERE address.id = :id"
             actual (:query (first (vals (update-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "update query signature"
@@ -194,28 +203,32 @@
             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
+      (let [expected "-- :name search-strings-address :? :*
+            -- :doc selects existing address records having any string field matching the parameter of the same name by substring match
+            SELECT DISTINCT * FROM lv_address
+            WHERE true
+            --~ (if (:street params) (str \"AND street LIKE '%\" (:street params) \"%' \"))
+            --~ (if (:town params) (str \"AND town LIKE '%\" (:town params) \"%' \"))
+            --~ (if (:postcode params) (str \"AND postcode LIKE '%\" (:postcode params) \"%' \"))
+            --~ (if (:id params) (str \"AND id = :id\"))
+            ORDER BY lv_address.street,
+              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 "search query signature"
-      (let [expected ":? :1"
-            actual (:signature (first (vals (search-query entity))))]
+      (let [expected ":? :*"
+            actual (:signature (first (vals (search-query entity application))))]
         (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"
+      (let [expected "-- :name get-address :? :1
+            -- :doc selects an existing address record
+            SELECT * FROM address\nWHERE address.id = :id
+            ORDER BY address.street,
+              address.postcode,
+              address.id"
             actual (:query (first (vals (select-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "select query signature"
@@ -224,13 +237,13 @@
         (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
+            -- :doc lists all existing address records
+            SELECT DISTINCT lv_address.* FROM lv_address
+            ORDER BY lv_address.street,
+              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 (list-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "list query signature"
@@ -241,8 +254,7 @@
       (let [expected "-- :name delete-address! :! :n
             -- :doc deletes an existing address record
             DELETE FROM address
-            WHERE address.id = :id
-            ANDaddress.postcode = :postcode"
+            WHERE address.id = :id"
             actual (:query (first (vals (delete-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "delete query signature"
@@ -279,9 +291,7 @@
                     :generator "assigned"
                     :type "string",
                     :size "12"
-                    :name "postcode"},
-                   :content
-                   [{:tag :generator, :attrs {:action "native"}, :content nil}]}
+                    :name "postcode"}}
                   ]}
                 {:tag :property,
                  :attrs
@@ -303,14 +313,14 @@
             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-address! :! :n
+      (let [expected "-- :name create-address! :<!
             -- :doc creates a new address record
             INSERT INTO address (street,
               town,
               postcode)
-            VALUES (':street',
-              ':town',
-              ':postcode')
+            VALUES (:street,
+              :town,
+              :postcode)
             returning
             postcode,
             id"
@@ -321,9 +331,10 @@
             -- :doc updates an existing address record
             UPDATE address
             SET street = :street,
-              town = :town
+              town = :town,
+              postcode = :postcode
             WHERE address.id = :id
-              AND address.postcode = ':postcode'\n\n"
+              AND address.postcode = :postcode\n\n"
             actual (:query (first (vals (update-query entity))))]
         (is (string-equal-ignore-whitespace? actual expected))))
     (testing "search query generation - user-distinct field in key"
diff --git a/test/adl/validator_test.clj b/test/adl/validator_test.clj
index cdb0fe0..2478e34 100644
--- a/test/adl/validator_test.clj
+++ b/test/adl/validator_test.clj
@@ -124,7 +124,7 @@
     (let [xml {:tag :group,
                :attrs {:name "public"},
                :content
-               [{:tag :documentation, :attrs nil, :content ["All users"]}]}
+               [{:tag :documentation, :content ["All users"]}]}
           expected true
           actual (binding [*out* (writer "/dev/null")]
                    (valid? xml group-validations))]
@@ -333,7 +333,7 @@
                    :content nil}]}]}
           expected true
           actual (binding [*out* (writer "/dev/null")]
-                   (valid? xml entity-validations))]
+                   (valid? xml property-validations))]
       (is (= actual expected)))))