Queries improved, all tests in adl.to-hugsql-queries-test pass.
This commit is contained in:
parent
5cf0a4cbed
commit
dcbe9ee01b
|
|
@ -152,7 +152,7 @@ that we can allow HTML block level entities within content elements -->
|
|||
to this property before it is persisted.
|
||||
guid: The system will supply a unique GUid value to this field
|
||||
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.
|
||||
native: The database will supply a unique value to this field when it
|
||||
is persisted; the value will be an integer. RECOMMENDED!
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
[clojure.string :as s]
|
||||
[clj-time.core :as t]
|
||||
[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]
|
||||
(let
|
||||
[entity-name (:name (:attrs entity-map))]
|
||||
(str
|
||||
"WHERE " entity-name "."
|
||||
(s/join
|
||||
(str " AND\n\t" entity-name ".")
|
||||
(map #(str % " = " (keyword %)) (key-names entity-map))))))
|
||||
"WHERE " entity-name "."
|
||||
(s/join
|
||||
(str " AND\n\t" entity-name ".")
|
||||
(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]
|
||||
|
|
@ -66,69 +56,77 @@
|
|||
preferred (map
|
||||
#(:name (:attrs %))
|
||||
(filter #(and
|
||||
(= (-> % :attrs :distinct) "user")
|
||||
(#{"all", "user"} (-> % :attrs :distinct))
|
||||
(= (-> % :tag) :property))
|
||||
(-> entity-map :content)))]
|
||||
(concat (properties entity-map)(key-properties entity-map))))]
|
||||
(str
|
||||
"ORDER BY " entity-name "."
|
||||
(s/join
|
||||
(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]
|
||||
(let [entity-name (:name (:attrs entity-map))
|
||||
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 "!")
|
||||
signature ":! :n"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :insert-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc creates a new " pretty-name " record\n"
|
||||
"INSERT INTO " entity-name " ("
|
||||
(s/join ",\n\t" all-property-names)
|
||||
")\nVALUES ("
|
||||
(s/join ",\n\t" (map keyword all-property-names))
|
||||
")"
|
||||
(if
|
||||
(has-primary-key? entity-map)
|
||||
(str "\nreturning " (s/join ",\n\t" (key-names entity-map))))
|
||||
"\n\n")})))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :insert-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc creates a new " pretty-name " record\n"
|
||||
"INSERT INTO " entity-name " ("
|
||||
(s/join ",\n\t" pnames)
|
||||
")\nVALUES ("
|
||||
(s/join ",\n\t"
|
||||
(map
|
||||
#(let [target (keyword (-> % :attrs :name))]
|
||||
(if
|
||||
(quoted-type? %)
|
||||
(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]
|
||||
(if
|
||||
(and
|
||||
(has-primary-key? entity-map)
|
||||
(has-non-key-properties? entity-map))
|
||||
(has-primary-key? entity-map)
|
||||
(has-non-key-properties? entity-map))
|
||||
(let [entity-name (:name (:attrs entity-map))
|
||||
pretty-name (singularise entity-name)
|
||||
property-names (property-names entity-map)
|
||||
query-name (str "update-" pretty-name "!")
|
||||
signature ":! :n"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :update-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc updates an existing " pretty-name " record\n"
|
||||
"UPDATE " entity-name "\n"
|
||||
"SET "
|
||||
(s/join ",\n\t" (map #(str % " = " (keyword %)) property-names))
|
||||
"\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :update-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc updates an existing " pretty-name " record\n"
|
||||
"UPDATE " entity-name "\n"
|
||||
"SET "
|
||||
(s/join ",\n\t" (map #(str % " = " (keyword %)) property-names))
|
||||
"\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))
|
||||
{}))
|
||||
|
||||
|
||||
|
|
@ -137,11 +135,11 @@
|
|||
pretty-name (singularise entity-name)
|
||||
query-name (str "search-strings-" pretty-name)
|
||||
signature ":? :1"
|
||||
props (concat (properties entity-map) (insertable-key-properties entity-map))
|
||||
string-fields (filter
|
||||
#(and
|
||||
(= (-> % :attrs :type) "string")
|
||||
(= (:tag %) :property))
|
||||
(-> entity-map :content))]
|
||||
;; TODO: should also allow typdefed fields which typedef to string.
|
||||
#(= (-> % :attrs :type) "string")
|
||||
props)]
|
||||
(if
|
||||
(empty? string-fields)
|
||||
{}
|
||||
|
|
@ -164,8 +162,8 @@
|
|||
"\n"
|
||||
(order-by-clause entity-map)
|
||||
"\n"
|
||||
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
||||
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
||||
"\n\n")}))))
|
||||
|
||||
|
||||
|
|
@ -177,17 +175,17 @@
|
|||
query-name (str "get-" pretty-name)
|
||||
signature ":? :1"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc selects an existing " pretty-name " record\n"
|
||||
"SELECT * FROM " entity-name "\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc selects an existing " pretty-name " record\n"
|
||||
"SELECT * FROM " entity-name "\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))
|
||||
{}))
|
||||
|
||||
|
||||
|
|
@ -201,19 +199,19 @@
|
|||
query-name (str "list-" entity-name)
|
||||
signature ":? :*"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-many
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc lists all existing " pretty-name " records\n"
|
||||
"SELECT * FROM " entity-name "\n"
|
||||
(order-by-clause entity-map) "\n"
|
||||
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
||||
"\n\n")})))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-many
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc lists all existing " pretty-name " records\n"
|
||||
"SELECT * FROM " entity-name "\n"
|
||||
(order-by-clause entity-map) "\n"
|
||||
"--~ (if (:offset params) \"OFFSET :offset \") \n"
|
||||
"--~ (if (:limit params) \"LIMIT :limit\" \"LIMIT 100\")"
|
||||
"\n\n")})))
|
||||
|
||||
|
||||
(defn foreign-queries [entity-map entities-map]
|
||||
|
|
@ -221,39 +219,39 @@
|
|||
pretty-name (singularise entity-name)
|
||||
links (filter #(-> % :attrs :entity) (-> entity-map :content :properties vals))]
|
||||
(apply
|
||||
merge
|
||||
(map
|
||||
#(let [far-name (-> % :attrs :entity)
|
||||
far-entity ((keyword far-name) entities-map)
|
||||
pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "")
|
||||
farkey (-> % :attrs :farkey)
|
||||
link-field (-> % :attrs :name)
|
||||
query-name (str "list-" entity-name "-by-" pretty-far)
|
||||
signature ":? :*"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-one-to-many
|
||||
:far-entity far-entity
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n"
|
||||
"SELECT * \nFROM " entity-name "\n"
|
||||
"WHERE " entity-name "." link-field " = :id\n"
|
||||
(order-by-clause entity-map)
|
||||
"\n\n")}))
|
||||
links))))
|
||||
merge
|
||||
(map
|
||||
#(let [far-name (-> % :attrs :entity)
|
||||
far-entity ((keyword far-name) entities-map)
|
||||
pretty-far (s/replace (s/replace far-name #"_" "-") #"s$" "")
|
||||
farkey (-> % :attrs :farkey)
|
||||
link-field (-> % :attrs :name)
|
||||
query-name (str "list-" entity-name "-by-" pretty-far)
|
||||
signature ":? :*"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :select-one-to-many
|
||||
:far-entity far-entity
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc lists all existing " pretty-name " records related to a given " pretty-far "\n"
|
||||
"SELECT * \nFROM " entity-name "\n"
|
||||
"WHERE " entity-name "." link-field " = :id\n"
|
||||
(order-by-clause entity-map)
|
||||
"\n\n")}))
|
||||
links))))
|
||||
|
||||
|
||||
(defn link-table-query [near link far]
|
||||
(let [properties (-> link :content :properties vals)
|
||||
links (apply
|
||||
merge
|
||||
(map
|
||||
#(hash-map (keyword (-> % :attrs :entity)) %)
|
||||
(filter #(-> % :attrs :entity) properties)))
|
||||
merge
|
||||
(map
|
||||
#(hash-map (keyword (-> % :attrs :entity)) %)
|
||||
(filter #(-> % :attrs :entity) properties)))
|
||||
near-name (-> near :attrs :name)
|
||||
link-name (-> link :attrs :name)
|
||||
far-name (-> far :attrs :name)
|
||||
|
|
@ -261,37 +259,37 @@
|
|||
query-name (str "list-" link-name "-" near-name "-by-" pretty-far)
|
||||
signature ":? :*"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity link
|
||||
:type :select-many-to-many
|
||||
:near-entity near
|
||||
:far-entity far
|
||||
:query
|
||||
(str "-- :name " query-name " " signature " \n"
|
||||
"-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n"
|
||||
"SELECT "near-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"
|
||||
"AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n"
|
||||
(order-by-clause near)
|
||||
"\n\n")})))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity link
|
||||
:type :select-many-to-many
|
||||
:near-entity near
|
||||
:far-entity far
|
||||
:query
|
||||
(str "-- :name " query-name " " signature " \n"
|
||||
"-- :doc lists all existing " near-name " records related through " link-name " to a given " pretty-far "\n"
|
||||
"SELECT "near-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"
|
||||
"AND " link-name "." (-> (links (keyword far-name)) :attrs :name) " = :id\n"
|
||||
(order-by-clause near)
|
||||
"\n\n")})))
|
||||
|
||||
|
||||
(defn link-table-queries [entity-map entities-map]
|
||||
(let
|
||||
[entities (map
|
||||
#((keyword %) entities-map)
|
||||
(remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals))))
|
||||
#((keyword %) entities-map)
|
||||
(remove nil? (map #(-> % :attrs :entity) (-> entity-map :content :properties vals))))
|
||||
pairs (combinations entities 2)]
|
||||
(apply
|
||||
merge
|
||||
(map
|
||||
#(merge
|
||||
(link-table-query (nth % 0) entity-map (nth % 1))
|
||||
(link-table-query (nth % 1) entity-map (nth % 0)))
|
||||
pairs))))
|
||||
merge
|
||||
(map
|
||||
#(merge
|
||||
(link-table-query (nth % 0) entity-map (nth % 1))
|
||||
(link-table-query (nth % 1) entity-map (nth % 0)))
|
||||
pairs))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -303,34 +301,34 @@
|
|||
query-name (str "delete-" pretty-name "!")
|
||||
signature ":! :n"]
|
||||
(hash-map
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :delete-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc updates an existing " pretty-name " record\n"
|
||||
"DELETE FROM " entity-name "\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))))
|
||||
(keyword query-name)
|
||||
{:name query-name
|
||||
:signature signature
|
||||
:entity entity-map
|
||||
:type :delete-1
|
||||
:query
|
||||
(str "-- :name " query-name " " signature "\n"
|
||||
"-- :doc updates an existing " pretty-name " record\n"
|
||||
"DELETE FROM " entity-name "\n"
|
||||
(where-clause entity-map)
|
||||
"\n\n")}))))
|
||||
|
||||
|
||||
(defn queries
|
||||
[entity-map entities-map]
|
||||
(merge
|
||||
{}
|
||||
(insert-query entity-map)
|
||||
(update-query entity-map)
|
||||
(delete-query entity-map)
|
||||
(if
|
||||
(is-link-table? entity-map)
|
||||
(link-table-queries entity-map entities-map)
|
||||
(merge
|
||||
(select-query entity-map)
|
||||
(list-query entity-map)
|
||||
(search-query entity-map)
|
||||
(foreign-queries entity-map entities-map)))))
|
||||
{}
|
||||
(insert-query entity-map)
|
||||
(update-query entity-map)
|
||||
(delete-query entity-map)
|
||||
(if
|
||||
(is-link-table? entity-map)
|
||||
(link-table-queries entity-map entities-map)
|
||||
(merge
|
||||
(select-query entity-map)
|
||||
(list-query entity-map)
|
||||
(search-query entity-map)
|
||||
(foreign-queries entity-map entities-map)))))
|
||||
|
||||
|
||||
;; (defn migrations-to-queries-sql
|
||||
|
|
|
|||
|
|
@ -1,11 +1,126 @@
|
|||
(ns adl.utils
|
||||
(: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"))
|
||||
|
||||
(defn entities
|
||||
[application-map]
|
||||
(filter #(= (-> % :tag) :entity) (:content application-map)))
|
||||
|
||||
(defn is-link-table?
|
||||
"Does this `entity-map` represent a pure link table?"
|
||||
[entity-map]
|
||||
(let [properties (-> entity-map :content :properties vals)
|
||||
links (filter #(-> % :attrs :entity) properties)]
|
||||
(= (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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,22 @@
|
|||
(ns adl.to-hugsql-queries-test
|
||||
(:require [clojure.test :refer :all]
|
||||
[adl.to-hugsql-queries :refer :all]))
|
||||
(:require [clojure.string :as s]
|
||||
[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
|
||||
(let [xml {:tag :entity,
|
||||
|
|
@ -32,67 +48,120 @@
|
|||
(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))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "keys name extraction"
|
||||
(let [expected '("id")
|
||||
actual (key-names xml)]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "primary key test"
|
||||
(let [expected true
|
||||
actual (has-primary-key? xml)]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "non-key properties test"
|
||||
(let [expected true
|
||||
actual (has-non-key-properties? xml)]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace 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"
|
||||
(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))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "insert query signature"
|
||||
(let [expected ":! :n"
|
||||
actual (:signature (first (vals (insert-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace 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))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "update query signature"
|
||||
(let [expected ":! :n"
|
||||
actual (:signature (first (vals (update-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace 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))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "search query signature"
|
||||
(let [expected ":? :1"
|
||||
actual (:signature (first (vals (search-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace 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))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "select query signature"
|
||||
(let [expected ":? :1"
|
||||
actual (:signature (first (vals (select-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace 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))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "list query signature"
|
||||
(let [expected ":? :*"
|
||||
actual (:signature (first (vals (list-query xml))))]
|
||||
(is (= actual expected))))
|
||||
(is (string-equal-ignore-whitespace 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))))
|
||||
(is (string-equal-ignore-whitespace actual expected))))
|
||||
(testing "delete query signature"
|
||||
(let [expected ":! :n"
|
||||
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))))))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue