simon/adl
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Queries improved, all tests in adl.to-hugsql-queries-test pass.

Browse source
This commit is contained in:
Simon Brooke 2018-03-21 10:32:02 +00:00
parent 5cf0a4cbed
commit dcbe9ee01b
4 changed files with 491 additions and 309 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
resources/schemas/adl-1.4.dtd
View file

@ -152,7 +152,7 @@ that we can allow HTML block level entities within content elements -->
to this property before it is persisted. to this property before it is persisted.
guid: The system will supply a unique GUid value to this field guid: The system will supply a unique GUid value to this field
before it is persisted. before it is persisted.
mannual: You contract to supply a generatos class in manually maintained mannual: You contract to supply a generator class in manually maintained
code. code.
native: The database will supply a unique value to this field when it native: The database will supply a unique value to this field when it
is persisted; the value will be an integer. RECOMMENDED! is persisted; the value will be an integer. RECOMMENDED!

332
src/adl/to_hugsql_queries.clj
View file

@ -6,7 +6,7 @@
[clojure.string :as s] [clojure.string :as s]
[clj-time.core :as t] [clj-time.core :as t]
[clj-time.format :as f] [clj-time.format :as f]
[adl.utils :refer [singularise is-link-table?]])) [adl.utils :refer :all]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
@ -32,32 +32,22 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn key-names [entity-map]
(let [k (first (filter #(= (:tag %) :key) (:content entity-map)))]
(remove
nil?
(map
#(:name (:attrs %))
(filter #(= (:tag %) :property) (:content k))))))
(defn has-primary-key? [entity-map]
(not (empty? (key-names entity-map))))
(defn has-non-key-properties? [entity-map]
(not
(empty? (filter #(= (:tag %) :property) (:content entity-map)))))
(defn where-clause [entity-map] (defn where-clause [entity-map]
(let (let
[entity-name (:name (:attrs entity-map))] [entity-name (:name (:attrs entity-map))]
(str (str
"WHERE " entity-name "." "WHERE " entity-name "."
(s/join (s/join
(str " AND\n\t" entity-name ".") (str " AND\n\t" entity-name ".")
(map #(str % " = " (keyword %)) (key-names entity-map)))))) (map
#(let [target (keyword (-> % :attrs :name))]
(str
(name target) " = "
(if
(quoted-type? %)
(str "'" target "'")
target)))
(key-properties entity-map))))))
(defn order-by-clause [entity-map] (defn order-by-clause [entity-map]
@ -66,69 +56,77 @@
preferred (map preferred (map
#(:name (:attrs %)) #(:name (:attrs %))
(filter #(and (filter #(and
(= (-> % :attrs :distinct) "user") (#{"all", "user"} (-> % :attrs :distinct))
(= (-> % :tag) :property)) (= (-> % :tag) :property))
(-> entity-map :content)))] (concat (properties entity-map)(key-properties entity-map))))]
(str (str
"ORDER BY " entity-name "." "ORDER BY " entity-name "."
(s/join (s/join
(str ",\n\t" entity-name ".") (str ",\n\t" entity-name ".")
(doall (flatten (cons preferred (key-names entity-map)))))))) (doall (flatten (cons preferred (filter
#(not (#{"all", "user"} %))
(key-names entity-map)))))))))
(defn property-names [entity-map]
(map #(:name (:attrs %)) (filter #(= (-> % :tag) :property) (:content entity-map))))
(defn insert-query [entity-map] (defn insert-query [entity-map]
(let [entity-name (:name (:attrs entity-map)) (let [entity-name (:name (:attrs entity-map))
pretty-name (singularise entity-name) pretty-name (singularise entity-name)
all-property-names (property-names entity-map) props (concat (properties entity-map) (insertable-key-properties entity-map))
pnames (map #(-> % :attrs :name) props)
query-name (str "create-" pretty-name "!") query-name (str "create-" pretty-name "!")
signature ":! :n"] signature ":! :n"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)
{:name query-name {:name query-name
:signature signature :signature signature
:entity entity-map :entity entity-map
:type :insert-1 :type :insert-1
:query :query
(str "-- :name " query-name " " signature "\n" (str "-- :name " query-name " " signature "\n"
"-- :doc creates a new " pretty-name " record\n" "-- :doc creates a new " pretty-name " record\n"
"INSERT INTO " entity-name " (" "INSERT INTO " entity-name " ("
(s/join ",\n\t" all-property-names) (s/join ",\n\t" pnames)
")\nVALUES (" ")\nVALUES ("
(s/join ",\n\t" (map keyword all-property-names)) (s/join ",\n\t"
")" (map
(if #(let [target (keyword (-> % :attrs :name))]
(has-primary-key? entity-map) (if
(str "\nreturning " (s/join ",\n\t" (key-names entity-map)))) (quoted-type? %)
"\n\n")}))) (str "'" target "'")
target))
props))
")"
(if
(has-primary-key? entity-map)
(str "\nreturning " (s/join ",\n\t" (key-names entity-map))))
"\n\n")})))
(defn update-query [entity-map] (defn update-query [entity-map]
(if (if
(and (and
(has-primary-key? entity-map) (has-primary-key? entity-map)
(has-non-key-properties? entity-map)) (has-non-key-properties? entity-map))
(let [entity-name (:name (:attrs entity-map)) (let [entity-name (:name (:attrs entity-map))
pretty-name (singularise entity-name) pretty-name (singularise entity-name)
property-names (property-names entity-map) property-names (property-names entity-map)
query-name (str "update-" pretty-name "!") query-name (str "update-" pretty-name "!")
signature ":! :n"] signature ":! :n"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)
{:name query-name {:name query-name
:signature signature :signature signature
:entity entity-map :entity entity-map
:type :update-1 :type :update-1
:query :query
(str "-- :name " query-name " " signature "\n" (str "-- :name " query-name " " signature "\n"
"-- :doc updates an existing " pretty-name " record\n" "-- :doc updates an existing " pretty-name " record\n"
"UPDATE " entity-name "\n" "UPDATE " entity-name "\n"
"SET " "SET "
(s/join ",\n\t" (map #(str % " = " (keyword %)) property-names)) (s/join ",\n\t" (map #(str % " = " (keyword %)) property-names))
"\n" "\n"
(where-clause entity-map) (where-clause entity-map)
"\n\n")})) "\n\n")}))
{})) {}))
@ -137,11 +135,11 @@
pretty-name (singularise entity-name) pretty-name (singularise entity-name)
query-name (str "search-strings-" pretty-name) query-name (str "search-strings-" pretty-name)
signature ":? :1" signature ":? :1"
props (concat (properties entity-map) (insertable-key-properties entity-map))
string-fields (filter string-fields (filter
#(and ;; TODO: should also allow typdefed fields which typedef to string.
(= (-> % :attrs :type) "string") #(= (-> % :attrs :type) "string")
(= (:tag %) :property)) props)]
(-> entity-map :content))]
(if (if
(empty? string-fields) (empty? string-fields)
{} {}
@ -164,8 +162,8 @@
"\n" "\n"
(order-by-clause entity-map) (order-by-clause entity-map)
"\n" "\n"
"--~ (if (:offset params) \"OFFSET :offset \") \n" "--~ (if (:offset params) \"OFFSET :offset \") \n"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")" "--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
"\n\n")})))) "\n\n")}))))
@ -177,17 +175,17 @@
query-name (str "get-" pretty-name) query-name (str "get-" pretty-name)
signature ":? :1"] signature ":? :1"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)
{:name query-name {:name query-name
:signature signature :signature signature
:entity entity-map :entity entity-map
:type :select-1 :type :select-1
:query :query
(str "-- :name " query-name " " signature "\n" (str "-- :name " query-name " " signature "\n"
"-- :doc selects an existing " pretty-name " record\n" "-- :doc selects an existing " pretty-name " record\n"
"SELECT * FROM " entity-name "\n" "SELECT * FROM " entity-name "\n"
(where-clause entity-map) (where-clause entity-map)
"\n\n")})) "\n\n")}))
{})) {}))
@ -201,19 +199,19 @@
query-name (str "list-" entity-name) query-name (str "list-" entity-name)
signature ":? :*"] signature ":? :*"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)
{:name query-name {:name query-name
:signature signature :signature signature
:entity entity-map :entity entity-map
:type :select-many :type :select-many
:query :query
(str "-- :name " query-name " " signature "\n" (str "-- :name " query-name " " signature "\n"
"-- :doc lists all existing " pretty-name " records\n" "-- :doc lists all existing " pretty-name " records\n"
"SELECT * FROM " entity-name "\n" "SELECT * FROM " entity-name "\n"
(order-by-clause entity-map) "\n" (order-by-clause entity-map) "\n"
"--~ (if (:offset params) \"OFFSET :offset \") \n" "--~ (if (:offset params) \"OFFSET :offset \") \n"
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")" "--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
"\n\n")}))) "\n\n")})))
(defn foreign-queries [entity-map entities-map] (defn foreign-queries [entity-map entities-map]
@ -221,39 +219,39 @@
pretty-name (singularise entity-name) pretty-name (singularise entity-name)
links (filter #(-> % :attrs :entity) (-> entity-map :content :properties vals))] links (filter #(-> % :attrs :entity) (-> entity-map :content :properties vals))]
(apply (apply
merge merge
(map (map
#(let [far-name (-> % :attrs :entity) #(let [far-name (-> % :attrs :entity)
far-entity ((keyword far-name) entities-map) far-entity ((keyword far-name) entities-map)
pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "") pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "")
farkey (-> % :attrs :farkey) farkey (-> % :attrs :farkey)
link-field (-> % :attrs :name) link-field (-> % :attrs :name)
query-name (str "list-" entity-name "-by-" pretty-far) query-name (str "list-" entity-name "-by-" pretty-far)
signature ":? :*"] signature ":? :*"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)
{:name query-name {:name query-name
:signature signature :signature signature
:entity entity-map :entity entity-map
:type :select-one-to-many :type :select-one-to-many
:far-entity far-entity :far-entity far-entity
:query :query
(str "-- :name " query-name " " signature "\n" (str "-- :name " query-name " " signature "\n"
"-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n" "-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n"
"SELECT * \nFROM " entity-name "\n" "SELECT * \nFROM " entity-name "\n"
"WHERE " entity-name "." link-field " = :id\n" "WHERE " entity-name "." link-field " = :id\n"
(order-by-clause entity-map) (order-by-clause entity-map)
"\n\n")})) "\n\n")}))
links)))) links))))
(defn link-table-query [near link far] (defn link-table-query [near link far]
(let [properties (-> link :content :properties vals) (let [properties (-> link :content :properties vals)
links (apply links (apply
merge merge
(map (map
#(hash-map (keyword (-> % :attrs :entity)) %) #(hash-map (keyword (-> % :attrs :entity)) %)
(filter #(-> % :attrs :entity) properties))) (filter #(-> % :attrs :entity) properties)))
near-name (-> near :attrs :name) near-name (-> near :attrs :name)
link-name (-> link :attrs :name) link-name (-> link :attrs :name)
far-name (-> far :attrs :name) far-name (-> far :attrs :name)
@ -261,37 +259,37 @@
query-name (str "list-" link-name "-" near-name "-by-" pretty-far) query-name (str "list-" link-name "-" near-name "-by-" pretty-far)
signature ":? :*"] signature ":? :*"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)
{:name query-name {:name query-name
:signature signature :signature signature
:entity link :entity link
:type :select-many-to-many :type :select-many-to-many
:near-entity near :near-entity near
:far-entity far :far-entity far
:query :query
(str "-- :name " query-name " " signature " \n" (str "-- :name " query-name " " signature " \n"
"-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n" "-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n"
"SELECT "near-name ".*\n" "SELECT "near-name ".*\n"
"FROM " near-name ", " link-name "\n" "FROM " near-name ", " link-name "\n"
"WHERE " near-name "." (first (key-names near)) " = " link-name "." (-> (links (keyword near-name)) :attrs :name) "\n\t" "WHERE " near-name "." (first (key-names near)) " = " link-name "." (-> (links (keyword near-name)) :attrs :name) "\n\t"
"AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n" "AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n"
(order-by-clause near) (order-by-clause near)
"\n\n")}))) "\n\n")})))
(defn link-table-queries [entity-map entities-map] (defn link-table-queries [entity-map entities-map]
(let (let
[entities (map [entities (map
#((keyword %) entities-map) #((keyword %) entities-map)
(remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals)))) (remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals))))
pairs (combinations entities 2)] pairs (combinations entities 2)]
(apply (apply
merge merge
(map (map
#(merge #(merge
(link-table-query (nth % 0) entity-map (nth % 1)) (link-table-query (nth % 0) entity-map (nth % 1))
(link-table-query (nth % 1) entity-map (nth % 0))) (link-table-query (nth % 1) entity-map (nth % 0)))
pairs)))) pairs))))
@ -303,34 +301,34 @@
query-name (str "delete-" pretty-name "!") query-name (str "delete-" pretty-name "!")
signature ":! :n"] signature ":! :n"]
(hash-map (hash-map
(keyword query-name) (keyword query-name)
{:name query-name {:name query-name
:signature signature :signature signature
:entity entity-map :entity entity-map
:type :delete-1 :type :delete-1
:query :query
(str "-- :name " query-name " " signature "\n" (str "-- :name " query-name " " signature "\n"
"-- :doc updates an existing " pretty-name " record\n" "-- :doc updates an existing " pretty-name " record\n"
"DELETE FROM " entity-name "\n" "DELETE FROM " entity-name "\n"
(where-clause entity-map) (where-clause entity-map)
"\n\n")})))) "\n\n")}))))
(defn queries (defn queries
[entity-map entities-map] [entity-map entities-map]
(merge (merge
{} {}
(insert-query entity-map) (insert-query entity-map)
(update-query entity-map) (update-query entity-map)
(delete-query entity-map) (delete-query entity-map)
(if (if
(is-link-table? entity-map) (is-link-table? entity-map)
(link-table-queries entity-map entities-map) (link-table-queries entity-map entities-map)
(merge (merge
(select-query entity-map) (select-query entity-map)
(list-query entity-map) (list-query entity-map)
(search-query entity-map) (search-query entity-map)
(foreign-queries entity-map entities-map))))) (foreign-queries entity-map entities-map)))))
;; (defn migrations-to-queries-sql ;; (defn migrations-to-queries-sql

117
src/adl/utils.clj
View file

@ -1,11 +1,126 @@
(ns adl.utils (ns adl.utils
(:require [clojure.string :as s])) (:require [clojure.string :as s]))
(defn singularise [string] ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; adl.utils: utility functions generally useful to generators.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2018 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; **Argument name conventions**: arguments with names of the form `*-map`
;;; represent elements extracted from an ADL XML file as parsed by
;;; `clojure.xml/parse`. Thus `entity-map` represents an ADL entity,
;;; `property-map` a property, and so on.
;;;
;;; Generally, `(:tag x-map) => "x"`, and for every such object
;;; `(:attrs x-map)` should return a map of attributes whose keys
;;; are keywords and whose values are strings.
(defn singularise
"Assuming this string represents an English language plural noun,
construct a Clojure symbol name which represents the singular."
[string]
(s/replace (s/replace (s/replace string #"_" "-") #"s$" "") #"ie$" "y")) (s/replace (s/replace (s/replace string #"_" "-") #"s$" "") #"ie$" "y"))
(defn entities
[application-map]
(filter #(= (-> % :tag) :entity) (:content application-map)))
(defn is-link-table? (defn is-link-table?
"Does this `entity-map` represent a pure link table?"
[entity-map] [entity-map]
(let [properties (-> entity-map :content :properties vals) (let [properties (-> entity-map :content :properties vals)
links (filter #(-> % :attrs :entity) properties)] links (filter #(-> % :attrs :entity) properties)]
(= (count properties) (count links)))) (= (count properties) (count links))))
(defn key-properties
"Return a list of all properties in the primary key of this `entity-map`."
[entity-map]
(filter
#(= (:tag %) :property)
(:content
;; there's required to be only one key element in and entity element
(first
(filter
#(= (:tag %) :key)
(:content entity-map))))))
(defn insertable-key-properties
"List properties in the key of the entity indicated by this `entity-map`
which should be inserted.
A key property is insertable it it is not `system` (database) generated.
But note that `system` is the default."
[entity-map]
(filter
#(let
[generator (-> % :attrs :generator)]
(not
(or (nil? generator)
(= generator "system"))))
(key-properties entity-map)))
(defn key-names
"List the names of all properties in the primary key of this `entity-map`."
[entity-map]
(remove
nil?
(map
#(:name (:attrs %))
(key-properties entity-map))))
(defn has-primary-key?
"True if this `entity-map` has a primary key."
[entity-map]
(not (empty? (key-names entity-map))))
(defn properties
"List the non-primary-key properties of this `entity-map`."
[entity-map]
(filter #(= (-> % :tag) :property) (:content entity-map)))
(defn has-non-key-properties?
"True if this `entity-map` has properties which do not form part of the
primary key."
[entity-map]
(not
(empty? (properties entity-map))))
(defn property-names
"List the names of non-primary-key properties of this `entity-map`."
[entity-map]
(map #(:name (:attrs %)) (properties entity-map)))
(defn quoted-type?
"Is the type of the property represented by this `property-map` one whose
values should be quoted in SQL queries?
TODO: this won't work for typedef types, which means we need to pass the
entire parsed ADL down the chain to here (and probably, generally) so that
we can resolve issues like that."
[property-map]
(#{"string", "text", "date", "time", "timestamp"} (-> property-map :attrs :type)))

107
test/adl/to_hugsql_queries_test.clj
View file

@ -1,6 +1,22 @@
(ns adl.to-hugsql-queries-test (ns adl.to-hugsql-queries-test
(:require [clojure.test :refer :all] (:require [clojure.string :as s]
[adl.to-hugsql-queries :refer :all])) [clojure.test :refer :all]
[adl.to-hugsql-queries :refer :all]
[adl.utils :refer :all]))
(defn string-equal-ignore-whitespace
"I don't want unit tests to fail just because emitted whitespace changes."
[a b]
(if
(and
(string? a)
(string? b))
(let
[pattern #"[\s]+"
aa (s/replace a pattern " ")
bb (s/replace b pattern " ")]
(= aa bb))
(= a b)))
(deftest entity-tests (deftest entity-tests
(let [xml {:tag :entity, (let [xml {:tag :entity,
@ -32,67 +48,120 @@
(testing "user distinct properties should provide the default ordering" (testing "user distinct properties should provide the default ordering"
(let [expected "ORDER BY address.street,\n\taddress.postcode,\n\taddress.id" (let [expected "ORDER BY address.street,\n\taddress.postcode,\n\taddress.id"
actual (order-by-clause xml)] actual (order-by-clause xml)]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "keys name extraction" (testing "keys name extraction"
(let [expected '("id") (let [expected '("id")
actual (key-names xml)] actual (key-names xml)]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "primary key test" (testing "primary key test"
(let [expected true (let [expected true
actual (has-primary-key? xml)] actual (has-primary-key? xml)]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "non-key properties test" (testing "non-key properties test"
(let [expected true (let [expected true
actual (has-non-key-properties? xml)] actual (has-non-key-properties? xml)]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "insert query generation" (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" (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))))] actual (:query (first (vals (insert-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "insert query signature" (testing "insert query signature"
(let [expected ":! :n" (let [expected ":! :n"
actual (:signature (first (vals (insert-query xml))))] actual (:signature (first (vals (insert-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "update query generation" (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" (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))))] actual (:query (first (vals (update-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "update query signature" (testing "update query signature"
(let [expected ":! :n" (let [expected ":! :n"
actual (:signature (first (vals (update-query xml))))] actual (:signature (first (vals (update-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "search query generation" (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" (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))))] actual (:query (first (vals (search-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "search query signature" (testing "search query signature"
(let [expected ":? :1" (let [expected ":? :1"
actual (:signature (first (vals (search-query xml))))] actual (:signature (first (vals (search-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "select query generation" (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" (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))))] actual (:query (first (vals (select-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "select query signature" (testing "select query signature"
(let [expected ":? :1" (let [expected ":? :1"
actual (:signature (first (vals (select-query xml))))] actual (:signature (first (vals (select-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "list query generation" (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" (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))))] actual (:query (first (vals (list-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "list query signature" (testing "list query signature"
(let [expected ":? :*" (let [expected ":? :*"
actual (:signature (first (vals (list-query xml))))] actual (:signature (first (vals (list-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "delete query generation" (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" (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))))] actual (:query (first (vals (delete-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
(testing "delete query signature" (testing "delete query signature"
(let [expected ":! :n" (let [expected ":! :n"
actual (:signature (first (vals (delete-query xml))))] actual (:signature (first (vals (delete-query xml))))]
(is (= actual expected)))) (is (string-equal-ignore-whitespace actual expected))))
)) ))
(deftest complex-key-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
{: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}
]}]
(testing "insert query generation - compound key, non system generated field in key"
(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\tpostcode\n\n"
actual (:query (first (vals (insert-query xml))))]
(is (string-equal-ignore-whitespace actual expected))))
(testing "update query generation - compound key"
(let [expected "-- :name update-addres! :! :n\n-- :doc updates an existing addres record\nUPDATE address\nSET street = :street,\n\ttown = :town\nWHERE address.id = :id AND\n\taddress.postcode = ':postcode'\n\n"
actual (:query (first (vals (update-query xml))))]
(is (string-equal-ignore-whitespace actual expected))))
(testing "search query generation - user-distinct field in key"
(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\taddress.postcode\n--~ (if (:offset params) \"OFFSET :offset \") \n--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")\n\n"
actual (:query (first (vals (search-query xml))))]
(is (string-equal-ignore-whitespace actual expected))))
(testing "delete query generation - compound key"
(let [expected "-- :name delete-addres! :! :n\n-- :doc updates an existing addres record\nDELETE FROM address\nWHERE address.id = :id AND\n\taddress.postcode = ':postcode'\n\n"
actual (:query (first (vals (delete-query xml))))]
(is (string-equal-ignore-whitespace actual expected))))))