A number of improvements, but still not generating clean PSQL.
This commit is contained in:
parent
dd4120bb91
commit
c2d006ac3b
|
|
@ -5,7 +5,7 @@
|
|||
: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.6"]
|
||||
:dependencies [[adl-support "0.1.7-SNAPSHOT"]
|
||||
[bouncer "1.0.1"]
|
||||
[clojure-saxon "0.9.4"]
|
||||
[environ "1.1.0"]
|
||||
|
|
|
|||
|
|
@ -194,11 +194,12 @@
|
|||
([property entity application]
|
||||
(emit-property property entity application false))
|
||||
([property entity application key?]
|
||||
(let [default (:default (:attrs property))]
|
||||
(let [default (:default (:attrs property))
|
||||
type (-> property :attrs :type)]
|
||||
(if
|
||||
(and
|
||||
(= (:tag property) :property)
|
||||
(not (#{"link" "list£"} (:type (:attrs property)))))
|
||||
(not (#{"link" "list"} (:type (:attrs property)))))
|
||||
(s/join
|
||||
" "
|
||||
(remove
|
||||
|
|
@ -225,7 +226,10 @@
|
|||
|
||||
(defn compose-convenience-entity-field
|
||||
[field entity application]
|
||||
(let [farside (entity-for-property (property-for-field field entity) application)]
|
||||
(let [property (case (:tag field)
|
||||
:field (property-for-field field entity)
|
||||
:property field)
|
||||
farside (entity-for-property property application)]
|
||||
(flatten
|
||||
(map
|
||||
(fn [f]
|
||||
|
|
@ -435,9 +439,9 @@
|
|||
(str
|
||||
(s/join
|
||||
",\n"
|
||||
(flatten
|
||||
(remove
|
||||
nil?
|
||||
(remove
|
||||
nil?
|
||||
(flatten
|
||||
(list
|
||||
(map
|
||||
#(emit-property % entity application true)
|
||||
|
|
|
|||
|
|
@ -4,70 +4,421 @@
|
|||
[adl.to-psql :refer :all]
|
||||
[adl-support.utils :refer :all]))
|
||||
|
||||
(deftest create-table-test
|
||||
(testing "Generation of table creation"
|
||||
(let [application {:tag :application,
|
||||
:attrs {:version "0.1.1", :name "test-app"},
|
||||
;; (deftest link-property-test
|
||||
;; (testing "No field generated for link property"
|
||||
|
||||
|
||||
(deftest to-psql-tests
|
||||
(let [application {:tag :application,
|
||||
:attrs {:version "0.1.1",
|
||||
:name "youyesyet",
|
||||
:xmlns:adl "http://bowyer.journeyman.cc/adl/1.4.1/",
|
||||
:xmlns:html "http://www.w3.org/1999/xhtml",
|
||||
:xmlns "http://bowyer.journeyman.cc/adl/1.4.1/"}
|
||||
:content
|
||||
[{:tag :typedef,
|
||||
:attrs
|
||||
{:size "16",
|
||||
:pattern
|
||||
"^([Gg][Ii][Rr] 0[Aa]{2})|((([A-Za-z][0-9]{1,2})|(([A-Za-z][A-Ha-hJ-Yj-y][0-9]{1,2})|(([AZa-z][0-9][A-Za-z])|([A-Za-z][A-Ha-hJ-Yj-y][0-9]?[A-Za-z]))))[0-9][A-Za-z]{2})$",
|
||||
:type "string",
|
||||
:name "postcode"},
|
||||
:content
|
||||
[{:tag :entity,
|
||||
:attrs {:name "address"},
|
||||
[{:tag :documentation,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :key,
|
||||
["See\n https://assets.publishing.service.gov.uk/government/uploads/system/uploads/attachment_data/file/488478/Bulk_Data_Transfer_-_additional_validation_valid_from_12_November_2015.pdf,\n section 3"]}
|
||||
{:tag :help,
|
||||
:attrs {:locale "en_GB.UTF-8"},
|
||||
:content ["A valid postcode."]}]}
|
||||
{:tag :entity,
|
||||
:attrs
|
||||
{:volatility "6",
|
||||
:magnitude "6",
|
||||
:name "addresses",
|
||||
:table "addresses"},
|
||||
:content
|
||||
[{:tag :documentation,
|
||||
:attrs nil,
|
||||
:content
|
||||
["Addresses of all buildings which contain\n dwellings."]}
|
||||
{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:distinct "system",
|
||||
:immutable "true",
|
||||
:column "id",
|
||||
:name "id",
|
||||
:type "integer",
|
||||
:required "true"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user",
|
||||
:size "256",
|
||||
:column "address",
|
||||
:name "address",
|
||||
:type "string",
|
||||
:required "true"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Address"},
|
||||
:content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user",
|
||||
:size "16",
|
||||
:column "postcode",
|
||||
:name "postcode",
|
||||
:typedef "postcode",
|
||||
:type "defined"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Postcode"},
|
||||
:content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:farkey "id",
|
||||
:entity "districts",
|
||||
:column "district_id",
|
||||
:name "district_id",
|
||||
:type "entity"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "District"},
|
||||
:content nil}]}
|
||||
{:tag :property,
|
||||
:attrs {:column "latitude", :name "latitude", :type "real"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Latitude"},
|
||||
:content nil}]}
|
||||
{:tag :property,
|
||||
:attrs {:column "longitude", :name "longitude", :type "real"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Longitude"},
|
||||
:content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:farkey "address_id",
|
||||
:entity "dwellings",
|
||||
:name "dwellings",
|
||||
:type "list"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:column "locality", :name "locality", :type "integer"},
|
||||
:content
|
||||
[{:tag :documentation,
|
||||
: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"}}
|
||||
]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user", :size "128", :type "string", :name "street"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:size "64", :type "string", :name "town"},
|
||||
:content nil}
|
||||
{:tag :property,
|
||||
:attrs {:name "dwellings" :type "list" :entity "dwellings" :farkey "address_id"}}
|
||||
]}
|
||||
{:tag :entity,
|
||||
:attrs {:name "dwelling"},
|
||||
["Locality indexing; see issue #44. Note that\n this property should be generated automatically from the\n latitude and longitude: (+ (* 10000 ;; left-shift the\n latitude component four digits (integer (* latitude 1000)))\n (- ;; invert the sign of the longitude component, since ;;\n we're interested in localities West of Greenwich. (integer (*\n longitude 1000)))) We'll use a trigger to insert this. I\n don't think it will ever appear in the user interface; it's\n an implementation detail, not of interest to\n users."]}
|
||||
{:tag :generator, :attrs {:action "native"}, :content nil}]}
|
||||
{:tag :list,
|
||||
:attrs {:name "Addresses", :properties "listed"},
|
||||
:content
|
||||
[{:tag :key,
|
||||
[{:tag :field,
|
||||
:attrs {:property "address"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Address"},
|
||||
:content nil}]}
|
||||
{:tag :field,
|
||||
:attrs {:property "postcode"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Postcode"},
|
||||
:content nil}]}
|
||||
{:tag :field,
|
||||
:attrs {:property "district_id"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "District"},
|
||||
:content nil}]}]}
|
||||
{:tag :form,
|
||||
:attrs {:name "Address", :properties "listed"},
|
||||
:content
|
||||
[{:tag :field,
|
||||
:attrs {:property "address"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Address"},
|
||||
:content nil}]}
|
||||
{:tag :field,
|
||||
:attrs {:property "postcode"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Postcode"},
|
||||
:content nil}]}
|
||||
{:tag :field,
|
||||
:attrs {:property "district_id"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "District"},
|
||||
:content nil}]}
|
||||
{:tag :field,
|
||||
:attrs {:property "latitude"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Latitude"},
|
||||
:content nil}]}
|
||||
{:tag :field,
|
||||
:attrs {:property "longitude"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Longitude"},
|
||||
:content nil}]}
|
||||
{:tag :auxlist,
|
||||
:attrs
|
||||
{:canadd "true",
|
||||
:onselect "form-dwellings-Dwelling",
|
||||
:property "dwellings"},
|
||||
:content
|
||||
[{:tag :field,
|
||||
:attrs {:property "sub-address"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Sub-address"},
|
||||
:content nil}]}]}]}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "canvassers"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "teamorganisers"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "issueexperts"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "analysts"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "issueeditors"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "all", :group "admin"},
|
||||
:content nil}]}
|
||||
|
||||
{:tag :entity,
|
||||
:attrs
|
||||
{:volatility "6",
|
||||
:magnitude "6",
|
||||
:name "dwellings",
|
||||
:table "dwellings"},
|
||||
:content
|
||||
[{:tag :documentation,
|
||||
:attrs nil,
|
||||
:content
|
||||
["All dwellings within addresses in the system; a\n dwelling is a house, flat or appartment in which electors live.\n Every address should have at least one dwelling; essentially,\n an address maps onto a street door and dwellings map onto\n what's behind that door. So a tenement or a block of flats\n would be one address with many dwellings."]}
|
||||
{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:distinct "system",
|
||||
:immutable "true",
|
||||
:column "id",
|
||||
:name "id",
|
||||
:type "integer",
|
||||
:required "true"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user",
|
||||
:farkey "id",
|
||||
:entity "addresses",
|
||||
:column "address_id",
|
||||
:name "address_id",
|
||||
:type "entity",
|
||||
:required "true"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Building Address"},
|
||||
:content nil}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user",
|
||||
:name "sub-address",
|
||||
:size "32",
|
||||
:type "string",
|
||||
:required "false"},
|
||||
:content
|
||||
[{:tag :documentation,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
["\n The part of the address which identifies the flat or\n apartment within the building, if in a multiple occupancy\n building.\n "]}]}
|
||||
{:tag :property,
|
||||
:attrs {:entity "electors", :name "electors", :type "list"},
|
||||
:content nil}
|
||||
{:tag :list,
|
||||
:attrs {:name "Dwellings", :properties "listed"},
|
||||
:content
|
||||
[{:tag :field,
|
||||
:attrs {:property "address_id"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Building Address"},
|
||||
:content nil}]}
|
||||
{:tag :field,
|
||||
:attrs {:property "sub-address"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Sub address"},
|
||||
:content nil}]}]}
|
||||
{:tag :form,
|
||||
:attrs {:name "Dwelling", :properties "listed"},
|
||||
:content
|
||||
[{:tag :field,
|
||||
:attrs {:property "address_id"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "Building Address"},
|
||||
:content nil}]}
|
||||
{:tag :field,
|
||||
:attrs {:property "sub-address"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs
|
||||
{:immutable "true",
|
||||
:required "true",
|
||||
:distinct "system",
|
||||
:type "integer",
|
||||
:name "id"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
|
||||
{:tag :property
|
||||
{:locale "en_GB.UTF-8",
|
||||
:prompt "Sub address (e.g. flat number)"},
|
||||
:content nil}]}]}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "canvassers"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "teamorganisers"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "issueexperts"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "analysts"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "issueeditors"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "all", :group "admin"},
|
||||
:content nil}]}
|
||||
{:tag :entity,
|
||||
:attrs
|
||||
{:volatility "7",
|
||||
:magnitude "4",
|
||||
:name "districts",
|
||||
:table "districts"},
|
||||
:content
|
||||
[{:tag :documentation,
|
||||
:attrs nil,
|
||||
:content
|
||||
["Electoral districts: TODO: Shape (polygon)\n information will need to be added, for use in\n maps."]}
|
||||
{:tag :key,
|
||||
:attrs nil,
|
||||
:content
|
||||
[{:tag :property,
|
||||
:attrs
|
||||
{:name "address_id" :required "true" :type "entity" :entity "address" :farkey "id"}}
|
||||
{:tag :property
|
||||
:attrs
|
||||
{:name "sub_address" :type "string" :size "32"}}]}]}
|
||||
address-entity (child-with-tag application :entity #(= (:name %) "address"))
|
||||
dwelling-entity (child-with-tag application :entity #(= (:name %) "dwelling"))
|
||||
expected ""
|
||||
actual (emit-table address-entity application "Test doc")
|
||||
]
|
||||
(is (= actual expected)))))
|
||||
{:distinct "system",
|
||||
:immutable "true",
|
||||
:column "id",
|
||||
:name "id",
|
||||
:type "integer",
|
||||
:required "true"},
|
||||
:content
|
||||
[{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
|
||||
{:tag :property,
|
||||
:attrs
|
||||
{:distinct "user",
|
||||
:size "64",
|
||||
:column "name",
|
||||
:name "name",
|
||||
:type "string",
|
||||
:required "true"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "name"},
|
||||
:content nil}]}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "public"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "all", :group "admin"},
|
||||
:content nil}
|
||||
{:tag :list,
|
||||
:attrs {:name "Districts", :properties "listed"},
|
||||
:content
|
||||
[{:tag :field,
|
||||
:attrs {:property "name"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "name"},
|
||||
:content nil}]}]}
|
||||
{:tag :form,
|
||||
:attrs {:name "District", :properties "listed"},
|
||||
:content
|
||||
[{:tag :field,
|
||||
:attrs {:property "name"},
|
||||
:content
|
||||
[{:tag :prompt,
|
||||
:attrs {:locale "en_GB.UTF-8", :prompt "name"},
|
||||
:content nil}]}]}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "canvassers"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "teamorganisers"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "issueexperts"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "analysts"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "read", :group "issueeditors"},
|
||||
:content nil}
|
||||
{:tag :permission,
|
||||
:attrs {:permission "all", :group "admin"},
|
||||
:content nil}]}
|
||||
]}
|
||||
address-entity (child-with-tag application :entity #(= (-> % :attrs :name) "addresses"))
|
||||
dwelling-entity (child-with-tag application :entity #(= (-> % :attrs :name) "dwellings"))]
|
||||
(testing "varchar field"
|
||||
(let [property (child-with-tag address-entity :property #(= (-> % :attrs :name) "address"))
|
||||
expected "\t address VARCHAR(256) NOT NULL"
|
||||
actual (emit-property property address-entity application false)]
|
||||
(is (= actual expected))))
|
||||
(testing "integer field"
|
||||
(let [property (child-with-tag address-entity :property #(= (-> % :attrs :name) "locality"))
|
||||
expected "\t locality INTEGER"
|
||||
actual (emit-property property address-entity application false)]
|
||||
(is (= actual expected))))
|
||||
(testing "real field"
|
||||
(let [property (child-with-tag address-entity :property #(= (-> % :attrs :name) "longitude"))
|
||||
expected "\t longitude DOUBLE PRECISION"
|
||||
actual (emit-property property address-entity application false)]
|
||||
(is (= actual expected))))
|
||||
(testing "list field"
|
||||
(let [property (child-with-tag address-entity :property #(= (-> % :attrs :name) "dwellings"))
|
||||
actual (emit-property property address-entity application false)]
|
||||
(is (nil? actual))))
|
||||
(testing "entity field"
|
||||
(let [property (child-with-tag address-entity :property #(= (-> % :attrs :name) "district_id"))
|
||||
expected "\t district_id INTEGER"
|
||||
actual (emit-property property address-entity application false)]
|
||||
(is (= actual expected))))
|
||||
|
||||
;; (testing "pattern field"
|
||||
;; (let [property (child-with-tag address-entity :property #(= (-> % :attrs :name) "postcode"))
|
||||
;; expected #"\t postcode VARCHAR(16) CONSTRAINT pattern_\d+ CHECK (postcode ~* '^([Gg][Ii][Rr] 0[Aa]{2})|((([A-Za-z][0-9]{1,2})|(([A-Za-z][A-Ha-hJ-Yj-y][0-9]{1,2})|(([AZa-z][0-9][A-Za-z])|([A-Za-z][A-Ha-hJ-Yj-y][0-9]?[A-Za-z]))))[0-9][A-Za-z]{2})$')"
|
||||
;; actual (emit-property property address-entity application false)]
|
||||
;; ;; slightly tricky because the pattern name is gensymed.
|
||||
;; (is (= actual expected))
|
||||
;; (is (string? (re-find expected actual)))))
|
||||
(testing "Table creation"
|
||||
(let [expected "------------------------------------------------------------------------\n--\tTest doc \n--\t\n--\tAll dwellings within addresses in the system; a\n--\t dwelling is a house, flat or appartment in which electors live.\n--\t Every address should have at least one dwelling; essentially,\n--\t an address maps onto a street door and dwellings map onto\n--\t what's behind that door. So a tenement or a block of flats\n--\t would be one address with many dwellings. \n------------------------------------------------------------------------\nCREATE TABLE dwellings\n(\n\t id SERIAL NOT NULL PRIMARY KEY,\n\t address_id INTEGER NOT NULL,\n\t sub_address VARCHAR(32)\n);\nGRANT SELECT ON dwellings TO admin,\n\tanalysts,\n\tcanvassers,\n\tissueeditors,\n\tissueexperts,\n\tteamorganisers ;\nGRANT INSERT ON dwellings TO admin ;\nGRANT UPDATE ON dwellings TO admin ;\nGRANT DELETE ON dwellings TO admin ;"
|
||||
actual (emit-table dwelling-entity application "Test doc")]
|
||||
(is (= actual expected))))
|
||||
))
|
||||
|
|
|
|||
Loading…
Reference in a new issue