From c2d006ac3bf38731fa5712038e4af9e72be3ad1c Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 15 Nov 2019 15:27:24 +0000 Subject: [PATCH] A number of improvements, but still not generating clean PSQL. --- project.clj | 2 +- src/adl/to_psql.clj | 16 +- test/adl/to_psql_test.clj | 467 +++++++++++++++++++++++++++++++++----- 3 files changed, 420 insertions(+), 65 deletions(-) diff --git a/project.clj b/project.clj index e212a47..c2e3c69 100644 --- a/project.clj +++ b/project.clj @@ -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"] diff --git a/src/adl/to_psql.clj b/src/adl/to_psql.clj index f913692..74cf5c6 100644 --- a/src/adl/to_psql.clj +++ b/src/adl/to_psql.clj @@ -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) diff --git a/test/adl/to_psql_test.clj b/test/adl/to_psql_test.clj index 418d688..3339fc0 100644 --- a/test/adl/to_psql_test.clj +++ b/test/adl/to_psql_test.clj @@ -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)))) + ))