diff --git a/.gitignore b/.gitignore index 243eef8..43b9a5b 100644 --- a/.gitignore +++ b/.gitignore @@ -29,3 +29,5 @@ generated/ *.orig + +*.out diff --git a/project.clj b/project.clj index c2e3c69..d306ce5 100644 --- a/project.clj +++ b/project.clj @@ -5,14 +5,14 @@ :license {:name "GNU Lesser General Public License, version 3.0 or (at your option) any later version" :url "https://www.gnu.org/licenses/lgpl-3.0.en.html"} - :dependencies [[adl-support "0.1.7-SNAPSHOT"] + :dependencies [[adl-support "0.1.8-SNAPSHOT"] [bouncer "1.0.1"] [clojure-saxon "0.9.4"] [environ "1.1.0"] [hiccup "1.0.5"] - [org.clojure/clojure "1.8.0"] - [org.clojure/math.combinatorics "0.1.6"] - [org.clojure/tools.cli "0.4.2"]] + [org.clojure/clojure "1.12.0"] + [org.clojure/math.combinatorics "0.3.0"] + [org.clojure/tools.cli "1.1.230"]] :aot [adl.main] diff --git a/resources/schemas/adl-1.4.2.dtd b/resources/schemas/adl-1.4.2.dtd deleted file mode 100644 index d2f63d8..0000000 --- a/resources/schemas/adl-1.4.2.dtd +++ /dev/null @@ -1,628 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/resources/schemas/adl-1.4.2.xsd b/resources/schemas/adl-1.4.2.xsd deleted file mode 100644 index 225477a..0000000 --- a/resources/schemas/adl-1.4.2.xsd +++ /dev/null @@ -1,559 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/adl/to_hugsql_queries.clj b/src/adl/to_hugsql_queries.clj index 9e13053..9104710 100644 --- a/src/adl/to_hugsql_queries.clj +++ b/src/adl/to_hugsql_queries.clj @@ -1,14 +1,12 @@ (ns ^{:doc "Application Description Language - generate HUGSQL queries file." - :author "Simon Brooke"} + :author "Simon Brooke"} adl.to-hugsql-queries - (:require [adl-support.core :refer :all] - [adl-support.utils :refer :all] - [clojure.java.io :refer [file make-parents]] - [clojure.math.combinatorics :refer [combinations]] - [clojure.string :as s] - [clojure.xml :as x] - [clj-time.core :as t] - [clj-time.format :as f])) + (:require [adl-support.core :refer :all] + [adl-support.utils :refer :all] + [clojure.java.io :refer [make-parents]] + [clojure.math.combinatorics :refer [combinations]] + [clojure.string :as s] + [clj-time.core :as t])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -46,8 +44,8 @@ (let [entity-name (safe-name entity :sql) property-names (map #(:name (:attrs %)) properties)] - (if-not (empty? property-names) - (str + (when-not (empty? property-names) + (str "WHERE " (s/join "\n\tAND " @@ -99,9 +97,10 @@ insertable-property-names (map #(safe-name % :sql) (insertable-properties entity)) - query-name (str "create-" pretty-name "!") - signature (if (has-primary-key? entity) - ": % :attrs :farkey) - link-type (-> % :attrs :type) - link-field (-> % :attrs :name) - query-name (list-related-query-name % entity (or far-entity far-name) false) - signature ":? :*"] - (hash-map - (keyword query-name) - {:name query-name - :signature signature - :entity entity - :type :select-one-to-many - :far-entity far-entity - :query - (s/join - "\n" - (remove - empty? - (case link-type - "entity" (list - (str "-- :name " query-name " " signature) - (str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name) - (str "SELECT DISTINCT lv_" entity-safe ".* \nFROM lv_" entity-safe) - (str "WHERE lv_" entity-safe "." (safe-name % :sql) " = :id") - (order-by-clause entity "lv_" false)) - "link" (let [ltn - (link-table-name % entity far-entity)] - (list - (str "-- :name " query-name " " signature) - (str "-- :doc links all existing " pretty-far " records related to a given " pretty-name) - (str "SELECT DISTINCT lv_" safe-far ".* \nFROM lv_" safe-far ", " ltn) - (str "WHERE lv_" safe-far "." - (safe-name (first (key-names far-entity)) :sql) - " = " ltn "." (singularise safe-far) "_id") - (str "\tAND " ltn "." (singularise entity-safe) "_id = :id") - (order-by-clause far-entity "lv_" false))) - "list" (list - (str "-- :name " query-name " " signature) - (str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name) - (str "SELECT DISTINCT lv_" safe-far ".* \nFROM lv_" safe-far) - (str "WHERE lv_" safe-far "." (safe-name (first (key-names far-entity)) :sql) " = :id") - (order-by-clause far-entity "lv_" false)) - (list (str "ERROR: unexpected type " link-type " of property " %))))) - })) - links)))) + merge + (map + #(let [far-name (:entity (:attrs %)) + far-entity (first + (children + application + (fn [x] + (and + (= (:tag x) :entity) + (= (:name (:attrs x)) far-name))))) + pretty-far (singularise far-name) + safe-far (safe-name far-entity :sql) + farkey (-> % :attrs :farkey) + link-type (-> % :attrs :type) + link-field (-> % :attrs :name) + query-name (list-related-query-name % entity far-entity false) + signature ":? :*"] + (hash-map + (keyword query-name) + {:name query-name + :signature signature + :entity entity + :type :select-one-to-many + :far-entity far-entity + :query + (s/join + "\n" + (remove + empty? + (case link-type + "entity" (list + (str "-- :name " query-name " " signature) + (str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name) + (str "SELECT DISTINCT lv_" entity-safe ".* \nFROM lv_" entity-safe) + (str "WHERE lv_" entity-safe "." (safe-name % :sql) " = :id") + (order-by-clause entity "lv_" false)) + "link" (let [ltn + (link-table-name % entity far-entity)] + (list + (str "-- :name " query-name " " signature) + (str "-- :doc links all existing " pretty-far " records related to a given " pretty-name) + (str "SELECT DISTINCT lv_" safe-far ".* \nFROM lv_" safe-far ", " ltn) + (str "WHERE lv_" safe-far "." + (safe-name (first (key-names far-entity)) :sql) + " = " ltn "." (singularise safe-far) "_id") + (str "\tAND " ltn "." (singularise entity-safe) "_id = :id") + (order-by-clause far-entity "lv_" false))) + "list" (list + (str "-- :name " query-name " " signature) + (str "-- :doc lists all existing " pretty-far " records related to a given " pretty-name) + (str "SELECT DISTINCT lv_" safe-far ".* \nFROM lv_" safe-far) + (str "WHERE lv_" safe-far "." (safe-name (first (key-names far-entity)) :sql) " = :id") + (order-by-clause far-entity "lv_" false)) + (list (str "ERROR: unexpected type " link-type " of property " %)))))})) + links)))) (defn delete-query diff --git a/src/adl/to_psql.clj b/src/adl/to_psql.clj index f08b80e..f12eda1 100644 --- a/src/adl/to_psql.clj +++ b/src/adl/to_psql.clj @@ -3,10 +3,9 @@ adl.to-psql (:require [adl-support.core :refer :all] [adl-support.utils :refer :all] - [adl.to-hugsql-queries :refer [queries]] - [clojure.java.io :refer [file make-parents writer]] + ;; [adl.to-hugsql-queries :refer [queries]] + [clojure.java.io :refer [make-parents]] [clojure.string :as s] - [clojure.xml :as x] [clj-time.core :as t] [clj-time.format :as f])) @@ -221,7 +220,7 @@ (if key? "NOT NULL PRIMARY KEY" - (if (= (:required (:attrs property)) "true") "NOT NULL")))))))))) + (when (= (:required (:attrs property)) "true") "NOT NULL")))))))))) (defn compose-convenience-entity-field @@ -267,6 +266,7 @@ (all-properties entity) (user-distinct-properties entity))))))) +(declare compose-convenience-where-clause) (defn compose-convenience-where-clause "Compose an SQL `WHERE` clause for a convenience view of this diff --git a/src/adl/validator.clj b/src/adl/validator.clj index d47dc4e..fa5919f 100644 --- a/src/adl/validator.clj +++ b/src/adl/validator.clj @@ -1,16 +1,16 @@ (ns ^{:doc "Application Description Language: validator for ADL structure. TODO: this is at present largely a failed experiment." :author "Simon Brooke"} - adl.validator - (:require [adl-support.utils :refer :all] + adl.validator + (:require [adl-support.utils :refer []] [clojure.set :refer [union]] [clojure.xml :refer [parse]] [bouncer.core :as b] - [bouncer.validators :as v])) + [bouncer.validators :as v :refer [every member required string]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; -;;;; Application Description Language: validator for ADL structure +;;;; squirrel-parse.to-adl: validate Application Description Language. ;;;; ;;;; This program is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU General Public License @@ -40,14 +40,14 @@ "Pass this `validation` and the object `o` to bouncer" [o validation] (if - (symbol? validation) + (symbol? validation) (try (b/validate o validation) (catch java.lang.ClassCastException c ;; The validator regularly barfs on strings, which are perfectly ;; valid content of some elements. I need a way to validate ;; elements where they're not tolerated! - (if (string? o) [nil o])) + (when (string? o) [nil o])) (catch Exception e [{:error (.getName (.getClass e)) :message (.getMessage e) @@ -61,20 +61,20 @@ OK, so: most of the validators will (usually) fail, and that's OK. How do we identify the one which ought not to have failed?" [o & validations] - `(println + (println (str - (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 '%) - ~validations)))))) + (when (:tag o) (str "Tag: " (:tag o) "; ")) + (when (:name (:attrs o)) (str "Name: " (:name (:attrs o)) ";")) + (when-not (or (:tag o) (:name (:attrs o))) (str "Context: " o)))) + + (empty? + (remove :tag (remove nil? (map first (map + #(try-validate o '%) + validations)))))) ;;; the remainder of this file is a fairly straight translation of the ADL 1.4 DTD into Clojure - -(declare documentation-validations fieldgroup-validations ) +(declare documentation-validations fieldgroup-validations) (def permissions "permissions a group may have on an entity, list, page, form or field @@ -105,7 +105,7 @@ #{"all", "all-delete-orphan", "delete", "manual", "save-update"}) (def defineable-data-types - "data types which can be used in a typedef to provide validation - + "data types which can be used in a typedef to provide validation - e.g. a string can be used with a regexp or a scalar can be used with min and max values * `string`: varchar java.sql.Types.VARCHAR @@ -128,8 +128,8 @@ * `text`: text or java.sql.Types.LONGVARCHAR memo java.sql.Types.CLOB" (union - defineable-data-types - #{"boolean" "text"})) + defineable-data-types + #{"boolean" "text"})) (def complex-data-types "data types which are more complex than SimpleDataTypes... @@ -169,7 +169,7 @@ (def sequences #{"canonical", "reverse-canonical"}) (def reference-validations -"The 'specification' and 'reference' elements are for documentation only, + "The 'specification' and 'reference' elements are for documentation only, and do not contribute to the engineering of the application described. A reference element is a reference to a specifying document. @@ -190,9 +190,18 @@ [:attrs :property] v/string ;; and should be the name of a property in that entity :content [[v/every documentation-validations]]}) +;; (def sample-reference {:tag :reference +;; :attrs {:abbr "foo" +;; :section "bar" +;; :entity "animal" +;; :property "breed"} +;; :content [{:tag :documentation +;; :content ["Every animal should have a breed."]}]}) + +;; (b/validate sample-reference reference-validations) (def specification-validations - "The 'specification' and 'reference' elements are for documentation only, + "The 'specification' and 'reference' elements are for documentation only, and do not contribute to the engineering of the application described. A specification element is intended chiefly to declare the reference @@ -207,30 +216,33 @@ [:attrs :name] [v/string v/required] [:attrs :abbr] [v/string v/required] :content [[v/every #(disjunct-valid? + % 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?" + "contains documentation on the element which immediately contains it. For + the time being, HTML markup is not permitted within documentation, but + Markdown (which may include a string representation of HTML markup) should + be." {:tag [v/required [#(= % :documentation)]] - :content documentation-content-validator}) + :content [[v/every #(disjunct-valid? + % + v/string + reference-validations)]]}) + +;; (def sample-documentation {:tag :documentation +;; :content ["Every animal should have a breed." +;; sample-reference]}) +;; (b/validate sample-documentation documentation-validations) +;; (b/valid? sample-documentation documentation-validations) (def content-validations {:tag [v/required [#(= % :content)]]}) (def help-validations - "helptext about a property of an entity, or a field of a page, form or + "helptext about a property of an entity, or a field of a page, form or list, or a typedef. Typically there will be only one of these per property per locale; if there are more than one all those matching the locale may be concatenated, or just one may be used. @@ -270,7 +282,7 @@ (def prompt-validations - "a prompt for a property or field; used as the prompt text for a widget + "a prompt for a property or field; used as the prompt text for a widget which edits it. Typically there will be only one of these per property per locale; if there are more than one all those matching the locale may be concatenated, or just one may be used. @@ -296,6 +308,17 @@ (b/valid? % documentation-validations) (b/valid? % prompt-validations))]]}) +(def sample-option {:tag :option, + :attrs {:value "Female"}, + :content + [{:tag :prompt, + :attrs {:locale "fr-FR", :prompt "Femme"}, + :content nil} + {:tag :prompt, + :attrs {:locale "en-GB", :prompt "Female"}, + :content nil}]}) +(b/validate sample-option option-validations) + (def pragma-validations "pragmatic advice to generators of lists and forms, in the form of name/value pairs which may contain anything. Over time some pragmas @@ -323,8 +346,8 @@ [:attrs :action] [v/string v/required [v/member generator-actions]] [:attrs :class] v/string :content [[v/every #(disjunct-valid? % - documentation-validations - param-validations)]]}) + documentation-validations + param-validations)]]}) (def in-implementation-validations @@ -340,7 +363,7 @@ [:attrs :target] [v/string v/required] [:attrs :value] [v/string v/required] [:attrs :kind] v/string - :content [[v/every #(b/valid? % documentation-validations)]]}) + :content [[v/every documentation-validations]]}) (def typedef-validations "the definition of a defined type. At this stage a defined type is either @@ -362,22 +385,22 @@ [:attrs :name] [v/required v/string] [:attrs :type] [[v/member defineable-data-types]] [:attrs :size] [[#(if - (string? %) + (string? %) (integer? (read-string %)) (integer? %))]] [:attrs :pattern] v/string [:attrs :minimum] [[#(if - (string? %) + (string? %) (integer? (read-string %)) (integer? %))]] [:attrs :maximum] [[#(if - (string? %) + (string? %) (integer? (read-string %)) (integer? %))]] :content [[v/every #(or - (b/valid? % documentation-validations) - (b/valid? % in-implementation-validations) - (b/valid? % help-validations))]]}) + (b/valid? % documentation-validations) + (b/valid? % in-implementation-validations) + (b/valid? % help-validations))]]}) (def group-validations "a group of people with similar permissions to one another @@ -387,10 +410,10 @@ {:tag [v/required [#(= % :group)]] [:attrs :name] [v/string v/required] [:attrs :parent] v/string - :content [[v/every #(b/valid? % documentation-validations)]]}) + :content [[v/every documentation-validations]]}) (def property-validations - "a property (field) of an entity (table) + "a property (field) of an entity (table) * `name`: the name of this property. * `type`: the type of this property. @@ -428,34 +451,53 @@ committed to persistent store, the value which it holds before it has been committed" {:tag [v/required [#(= % :property)]] - [:attrs :name] [v/required v/string] - [:attrs :type] [v/required [v/member all-data-types]] - ;; [:attrs :default] [] ;; it's allowed, but I don't have anything particular to say about it - [:attrs :typedef] v/string [:attrs :distinct] [v/string [v/member #{"none", "all", "user", "system"}]] [:attrs :entity] v/string [:attrs :farkey] v/string - [:attrs :required] [[v/member #{"true", "false"}]] [:attrs :immutable] [[v/member #{"true", "false"}]] + [:attrs :name] [v/required v/string] + [:attrs :required] [[v/member #{"true", "false"}]] [:attrs :size] [[#(cond - (empty? %) ;; it's allowed to be missing - true + (empty? %) ;; it's allowed to be missing + true (string? %) (integer? (read-string %)) - true + :else (integer? %))]] + [:attrs :type] [v/required [v/member all-data-types]] + ;; [:attrs :default] [] ;; it's allowed, but I don't have anything particular to say about it + [:attrs :typedef] v/string + [:attrs :cascade] [[v/member cascade-actions]] [:attrs :column] v/string [:attrs :concrete] [[v/member #{"true", "false"}]] - [:attrs :cascade] [[v/member cascade-actions]] -;; :content [[v/every #(disjunct-valid? % -;; documentation-validations -;; generator-validations -;; permission-validations -;; option-validations -;; prompt-validations -;; help-validations -;; ifmissing-validations)]] - }) + :content [[v/every #(disjunct-valid? % + documentation-validations + generator-validations + permission-validations + option-validations + prompt-validations + help-validations + ifmissing-validations)]]}) + +;; (disjunct-valid? sample-option documentation-validations +;; generator-validations +;; permission-validations +;; option-validations +;; prompt-validations +;; help-validations +;; ifmissing-validations) + +;; (def sample-property {:tag :property, +;; :attrs +;; {:immutable "true", +;; :required "true", +;; :distinct "system", +;; :type "integer", +;; :name "id"}, +;; :content +;; [{:tag :generator, :attrs {:action "native"}, :content nil}]}) + +;; (b/validate sample-property property-validations) (def permission-validations @@ -489,10 +531,10 @@ {:tag [v/required [#(= % :field)]] [:attrs :property] [v/string v/required] ;; and it must also be the name of a property in the current entity :content [[v/every #(or - (b/valid? % documentation-validations) - (b/valid? % prompt-validations) - (b/valid? % permission-validations) - (b/valid? % help-validations))]]}) + (b/valid? % documentation-validations) + (b/valid? % prompt-validations) + (b/valid? % permission-validations) + (b/valid? % help-validations))]]}) (def verb-validations "a verb is something that may be done through a form. Probably the verbs 'store' @@ -529,12 +571,12 @@ [:attrs :onselect] v/string [:attrs :canadd] v/boolean :content [[v/every #(or - (b/valid? % documentation-validations) - (b/valid? % prompt-validations) - (b/valid? % field-validations) - (b/valid? % fieldgroup-validations) - (b/valid? % auxlist-validations) - (b/valid? % verb-validations))]]}) + (b/valid? % documentation-validations) + (b/valid? % prompt-validations) + (b/valid? % field-validations) + (b/valid? % fieldgroup-validations) + (b/valid? % auxlist-validations) + (b/valid? % verb-validations))]]}) (def fieldgroup-validations "a group of fields and other controls within a form or list, which the @@ -542,14 +584,14 @@ {:tag [v/required [#(= % :fieldgroup)]] [:attrs :name] [v/string v/required] :content [[v/every #(or - (b/valid? % documentation-validations) - (b/valid? % prompt-validations) - (b/valid? % permission-validations) - (b/valid? % help-validations) - (b/valid? % field-validations) - (b/valid? % fieldgroup-validations) - (b/valid? % auxlist-validations) - (b/valid? % verb-validations))]]}) + (b/valid? % documentation-validations) + (b/valid? % prompt-validations) + (b/valid? % permission-validations) + (b/valid? % help-validations) + (b/valid? % field-validations) + (b/valid? % fieldgroup-validations) + (b/valid? % auxlist-validations) + (b/valid? % verb-validations))]]}) (def form-validations @@ -559,16 +601,16 @@ [:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]] [:attrs :canadd] [[v/member #{"true", "false"}]] :content [[v/every #(disjunct-valid? % - documentation-validations - head-validations - top-validations - foot-validations - field-validations - fieldgroup-validations - auxlist-validations - verb-validations - permission-validations - pragma-validations)]]}) + documentation-validations + head-validations + top-validations + foot-validations + field-validations + fieldgroup-validations + auxlist-validations + verb-validations + permission-validations + pragma-validations)]]}) (def page-validations "a page on which an entity may be displayed" @@ -576,16 +618,16 @@ [:attrs :name] [v/required v/string] [:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]] :content [[v/every #(disjunct-valid? % - documentation-validations - head-validations - top-validations - foot-validations - field-validations - fieldgroup-validations - auxlist-validations - verb-validations - permission-validations - pragma-validations)]]}) + documentation-validations + head-validations + top-validations + foot-validations + field-validations + fieldgroup-validations + auxlist-validations + verb-validations + permission-validations + pragma-validations)]]}) (def list-validations "a list on which entities of a given type are listed @@ -597,21 +639,21 @@ [:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]] [:attrs :onselect] v/string :content [[v/every #(disjunct-valid? % - documentation-validations - head-validations - top-validations - foot-validations - field-validations - fieldgroup-validations - auxlist-validations - verb-validations - permission-validations - pragma-validations - order-validations)]]}) + documentation-validations + head-validations + top-validations + foot-validations + field-validations + fieldgroup-validations + auxlist-validations + verb-validations + permission-validations + pragma-validations + order-validations)]]}) (def key-validations {:tag [v/required [#(= % :key)]] - :content [[v/every #(b/validate % property-validations)]]}) + :content [[v/every property-validations]]}) (def entity-validations @@ -635,15 +677,15 @@ [:attrs :table] v/string [:attrs :foreign] [[v/member #{"true", "false"}]] :content [[v/every #(disjunct-valid? % - documentation-validations - prompt-validations - content-validations - key-validations - property-validations - permission-validations - form-validations - page-validations - list-validations)]]}) + documentation-validations + prompt-validations + content-validations + key-validations + property-validations + permission-validations + form-validations + page-validations + list-validations)]]}) (def application-validations {:tag [v/required [#(= % :application)]] @@ -652,12 +694,12 @@ [:attrs :revision] v/string [:attrs :currency] v/string :content [[v/every #(disjunct-valid? % - specification-validations - documentation-validations - content-validations - typedef-validations - group-validations - entity-validations)]]}) + specification-validations + documentation-validations + content-validations + typedef-validations + group-validations + entity-validations)]]}) (defn valid-adl? diff --git a/test/adl/to_hugsql_queries_test.clj b/test/adl/to_hugsql_queries_test.clj index 9c46782..761208e 100644 --- a/test/adl/to_hugsql_queries_test.clj +++ b/test/adl/to_hugsql_queries_test.clj @@ -1,76 +1,62 @@ (ns adl.to-hugsql-queries-test (:require [clojure.string :as s] - [clojure.test :refer :all] - [adl.to-hugsql-queries :refer :all] - [adl-support.utils :refer :all])) + [clojure.test :refer [deftest is testing]] + [adl.to-hugsql-queries :refer [delete-query insert-query list-query order-by-clause search-query select-query update-query]] + [adl-support.utils :refer [child-with-tag has-non-key-properties? has-primary-key? key-names]])) (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 + (and + (string? a) + (string? b)) + (let [pattern #"[\s]+" - aa (s/replace (s/trim a) pattern " ") - bb (s/replace (s/trim b) pattern " ")] - (= aa bb)) + aa (s/replace a pattern " ") + bb (s/replace b pattern " ")] + (= aa bb)) (= a b))) -(string-equal-ignore-whitespace? -"-- :name create-address! :