A number of improvements, but still not generating clean PSQL.

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"]

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
-                 (remove
+                 nil?
-                   nil?
+                 (flatten
                    (list
                      (map
                        #(emit-property % entity application true)

test/adl/to_psql_test.clj

@@ -4,70 +4,421 @@
             [adl.to-psql :refer :all]
             [adl-support.utils :refer :all]))
 
-(deftest create-table-test
+;; (deftest link-property-test
-  (testing "Generation of table creation"
+;;   (testing "No field generated for link property"
-    (let [application {:tag :application,
+
-                       :attrs {:version "0.1.1", :name "test-app"},
+
+(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,
+                       [{:tag :documentation,
-                         :attrs {:name "address"},
+                         :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,
+                           ["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."]}
-                             :attrs
+                          {:tag :generator, :attrs {:action "native"}, :content nil}]}
-                             {:immutable "true",
+                        {:tag :list,
-                              :required "true",
+                         :attrs {:name "Addresses", :properties "listed"},
-                              :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"},
                          :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",
+                             {:locale "en_GB.UTF-8",
-                              :required "true",
+                              :prompt "Sub address (e.g. flat number)"},
-                              :distinct "system",
+                             :content nil}]}]}
-                              :type "integer",
+                        {:tag :permission,
-                              :name "id"},
+                         :attrs {:permission "read", :group "canvassers"},
-                             :content
+                         :content nil}
-                             [{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
+                        {:tag :permission,
-                          {:tag :property
+                         :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"}}
+                           {:distinct "system",
-                          {:tag :property
+                            :immutable "true",
-                           :attrs
+                            :column "id",
-                           {:name "sub_address" :type "string" :size "32"}}]}]}
+                            :name "id",
-          address-entity (child-with-tag application :entity #(= (:name %) "address"))
+                            :type "integer",
-          dwelling-entity (child-with-tag application :entity #(= (:name %) "dwelling"))
+                            :required "true"},
-          expected ""
+                           :content
-          actual (emit-table address-entity application "Test doc")
+                           [{:tag :generator, :attrs {:action "native"}, :content nil}]}]}
-          ]
+                        {:tag :property,
-      (is (= actual expected)))))
+                         :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))))
+    ))