550 lines
28 KiB
Clojure
550 lines
28 KiB
Clojure
(ns adl.to-psql-test
|
|
(:require
|
|
[adl-support.utils :refer [child child-with-tag]]
|
|
[adl.to-psql :refer [emit-convenience-entity-field emit-convenience-view
|
|
emit-property emit-table]]
|
|
[clojure.test :refer [deftest is testing]]))
|
|
|
|
;; (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://www.journeyman.cc/adl/1.4.7/",
|
|
:xmlns:html "http://www.w3.org/1999/xhtml",
|
|
:xmlns "http://www.journeyman.cc/adl/1.4.7/"}
|
|
: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 :documentation,
|
|
:attrs nil,
|
|
:content
|
|
["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
|
|
["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 :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
|
|
["\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
|
|
{: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
|
|
{: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))))
|
|
(testing "Convenience entity field - is an entity field, should emit"
|
|
(let [property (child-with-tag address-entity :property #(= (-> % :attrs :name) "district_id"))
|
|
expected "district_id.name AS district_id_expanded"
|
|
actual (emit-convenience-entity-field property address-entity application)]
|
|
(is (= actual expected))))
|
|
|
|
(testing "Convenience entity field - is not an entity field, should not emit"
|
|
(let [farside dwelling-entity
|
|
property (child-with-tag address-entity :property #(= (-> % :attrs :name) "dwellings"))
|
|
expected nil
|
|
actual (emit-convenience-entity-field property address-entity application)]
|
|
(is (= actual expected))))
|
|
|
|
))
|
|
|
|
(deftest bug-9-test
|
|
(testing "Correct reference to aliased tables in convenience view select queries
|
|
see [bug 9](https://github.com/simon-brooke/adl/issues/9)"
|
|
(let [app
|
|
{:tag :application,
|
|
:attrs {:version "0.0.1",
|
|
:name "pastoralist",
|
|
:xmlns:adl "http://www.journeyman.cc/adl/1.4.7/",
|
|
:xmlns:html "http://www.w3.org/1999/xhtml",
|
|
:xmlns "http://www.journeyman.cc/adl/1.4.7/"},
|
|
:content [{:tag :documentation,
|
|
:attrs nil,
|
|
:content ["A web-app intended to be used by pastoralists in managing
|
|
pastures, grazing, and animals."]}
|
|
{:tag :entity,
|
|
:attrs {:volatility "5", :magnitude "9", :name "animal" :table "animal"},
|
|
:content
|
|
[{: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 {:entity "animal", :type "entity", :name "dam"},
|
|
:content nil}
|
|
{:tag :property,
|
|
:attrs {:entity "animal", :type "entity", :name "sire"},
|
|
:content nil}
|
|
{:tag :property,
|
|
:attrs
|
|
{:required "true",
|
|
:distinct "user",
|
|
:size "64",
|
|
:type "string",
|
|
:name "animal-identifier"},
|
|
:content
|
|
[{:tag :prompt,
|
|
:attrs {:locale "en_GB.UTF-8", :prompt "Ear-tag Number"},
|
|
:content nil}]}
|
|
{:tag :property,
|
|
:attrs {:distinct "user", :size "64", :type "string", :name "name"},
|
|
:content nil}]}]}
|
|
animal (child app #(= (-> % :attrs :name) "animal"))
|
|
dam (child animal #(= (-> % :attrs :name) "dam"))]
|
|
(let [actual (emit-convenience-view animal app)
|
|
should-find #"dam.animal_identifier"
|
|
should-not-find #"animal.name AS dam_expanded"]
|
|
;; (print actual) ;; see what we've got
|
|
(is (re-find should-find actual))
|
|
(is (nil? (re-find should-not-find actual)))))))
|
|
|
|
(deftest bug-10-test
|
|
(testing "Correct table names in convenience view select queries
|
|
see [bug 10](https://github.com/simon-brooke/adl/issues/10)"
|
|
(let [app
|
|
{:tag :application,
|
|
:attrs {:version "0.0.1",
|
|
:name "pastoralist",
|
|
:xmlns:adl "http://www.journeyman.cc/adl/1.4.7/",
|
|
:xmlns:html "http://www.w3.org/1999/xhtml",
|
|
:xmlns "http://www.journeyman.cc/adl/1.4.7/"},
|
|
:content [{:tag :documentation,
|
|
:attrs nil,
|
|
:content ["A web-app intended to be used by pastoralists in managing
|
|
pastures, grazing, and animals."]}
|
|
{:tag :entity,
|
|
:attrs
|
|
{:volatility "5",
|
|
:magnitude "3",
|
|
:name "event-type",
|
|
:table "event-type"},
|
|
:content
|
|
[{: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 {:size "80", :type "string", :name "summary"},
|
|
:content nil}
|
|
{:tag :property,
|
|
:attrs {:type "text", :name "description"},
|
|
:content nil}
|
|
{:tag :property,
|
|
:attrs {:default "1", :type "integer", :name "n-holdings"},}
|
|
{:tag :property,
|
|
:attrs {:default "1", :type "integer", :name "n-pastures"}}
|
|
{:tag :property,
|
|
:attrs {:default "1", :type "integer", :name "n-animals"}}]}]}
|
|
should-find #"event_type.description"
|
|
should-not-find #"event-type.description"
|
|
actual (emit-convenience-view (child app #(= (-> % :attrs :name) "event-type")) app)]
|
|
(is (re-find should-find actual))
|
|
(is (nil? (re-find should-not-find actual))))))
|