All unit tests passing.

This commit is contained in:
Simon Brooke 2019-11-12 15:10:26 +00:00
parent 5af9a7349c
commit e2aa979458
4 changed files with 82 additions and 69 deletions

View file

@ -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)

View file

@ -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

View file

@ -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"

View file

@ -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)))))