(ns adl-support.utils-test (:require [clojure.test :refer :all] [adl-support.core :refer [*warn*]] [adl-support.utils :refer :all])) ;; Yes, there's MASSES in utils which ought to be tested. I'll add more tests over time. (deftest singularise-tests (testing "Singularise" (is (= "address" (singularise "addresses"))) (is (= "address" (singularise "address"))) (is (= "expertise" (singularise "expertise"))))) (deftest child-with-tag-tests (testing "child-with-tag" (let [expected {:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}} actual (child-with-tag {:tag :property :attrs {:name "not test"} :content [{:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}}]} :prompt)] (is (= expected actual) "Basic search for one child which exists")) (let [expected nil actual (child-with-tag {:tag :property :attrs {:name "not test"} :content [{:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}}]} :frobox)] (is (= expected actual) "Basic search for one child which doesn't exist")) (let [expected nil actual (child-with-tag nil :frobox)] (is (= expected actual) "Basic search with nil element")) (let [expected {:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}} actual (child-with-tag {:tag :property :attrs {:name "not test"} :content [{:tag :frobox} {:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}}]} :prompt)] (is (= expected actual) "Basic search for one child which exists but is not first")) (let [expected {:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}} actual (child-with-tag {:tag :property :attrs {:name "not test"} :content [{:tag :prompt :attrs {:prompt "essai" :locale "fr-FR"}} {:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}}]} :prompt #(= (-> % :attrs :locale) "en_GB.UTF-8"))] (is (= expected actual) "Conditional search for one child which exists (1)")) (let [*locale* "fr-FR" expected {:tag :prompt :attrs {:prompt "essai" :locale "fr-FR"}} actual (child-with-tag {:tag :property :attrs {:name "not test"} :content [{:tag :prompt :attrs {:prompt "essai" :locale "fr-FR"}} {:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}}]} :prompt #(= (-> % :attrs :locale) "fr-FR"))] (is (= expected actual) "Conditional search for one child which exists (2)")) )) (deftest prompt-tests (testing "Prompts for fields and properties" (let [*locale* "en_GB.UTF-8" expected "Test" actual (prompt {:tag :property :attrs {:name "not test"} :content [{:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}}]} {} {} {})] (is (= expected actual) "Basic property with one prompt in current locale")) (let [*locale* "en_GB.UTF-8" expected "Test" actual (prompt {:tag :field :attrs {:property "not-test"} :content [{:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}}]} {} {} {})] (is (= expected actual) "Basic field with one prompt in current locale")) (let [*locale* "en_GB.UTF-8" expected "Test" actual (prompt {:tag :field :attrs {:property "not-test"}} {} {:tag :entity :content [{:tag :property :attrs {:name "not-test"} :content [{:tag :prompt :attrs {:prompt "test" :locale "en_GB.UTF-8"}}]}]} {})] (is (= expected actual) "Basic field with no prompt, in context of entity with appropriate property with prompt in current locale")) (let [*locale* "en_GB.UTF-8" expected "Home" actual (prompt {:tag :field, :attrs {:property "dwelling_id"}} {} {:tag :entity, :attrs {:volatility "5", :magnitude "6", :name "electors", :table "electors"}, :content [{:tag :documentation, :attrs nil, :content ["All electors known to the system; electors are\n people believed to be entitled to vote in the current\n campaign."]} {:tag :key, :attrs nil, :content [{:tag :property, :attrs {:distinct "system", :immutable "true", :column "id", :name "id", :type "integer", :required "true"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "id"}, :content nil}]}]} {:tag :property, :attrs {:distinct "user", :column "name", :name "name", :type "string", :required "true", :size "64"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Name"}, :content nil}]} {:tag :property, :attrs {:farkey "id", :entity "dwellings", :column "dwelling_id", :name "dwelling_id", :type "entity", :required "true"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Home"}, :content nil}]} {:tag :property, :attrs {:column "phone", :name "phone", :type "string", :size "16"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Phone"}, :content nil}]} {:tag :property, :attrs {:column "email", :name "email", :type "string", :size "128"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Email"}, :content nil}]} {:tag :property, :attrs {:default "Unknown", :farkey "id", :entity "genders", :column "gender", :type "entity", :name "gender"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Gender"}, :content nil}]} {:tag :property, :attrs {:type "text", :name "signature"}, :content [{:tag :documentation, :attrs nil, :content ["The signature of this elector, captured as SVG text,\n as evidence they have consented to us holding data on them.\n Null if they have not."]}]} {:tag :list, :attrs {:name "Electors", :properties "listed"}, :content [{:tag :field, :attrs {:property "id"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "id"}, :content nil}]} {:tag :field, :attrs {:property "name"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Name"}, :content nil}]} {:tag :field, :attrs {:property "dwelling_id"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Home"}, :content nil}]} {:tag :field, :attrs {:property "phone"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Phone"}, :content nil}]} {:tag :field, :attrs {:property "email"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "eMail"}, :content nil}]} {:tag :field, :attrs {:property "gender"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Gender"}, :content nil}]}]} {:tag :form, :attrs {:name "Elector", :properties "listed"}, :content [{:tag :field, :attrs {:property "id"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "id"}, :content nil}]} {:tag :field, :attrs {:property "name"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Name"}, :content nil}]} {:tag :field, :attrs {:property "dwelling_id"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Home"}, :content nil}]} {:tag :field, :attrs {:property "phone"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Phone"}, :content nil}]} {:tag :field, :attrs {:property "email"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "eMail"}, :content nil}]} {:tag :field, :attrs {:property "gender"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Gender"}, :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}]} {})] (is (= expected actual) "With realistic clutter: field with no prompt, in context of entity with appropriate property with prompt in current locale")) )) (deftest list-related-query-name-tests (testing "list-related-query-name" (let [genders-entity {:tag :entity, :attrs {:volatility "6", :magnitude "1", :name "genders", :table "genders"}, :content [{:tag :documentation, :content ["All genders which may be assigned to\n electors."]} {:tag :key, :attrs nil, :content [{:tag :property, :attrs {:distinct "all", :size "32", :type "string", :name "id"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Gender"}, :content nil}]}]} {:tag :list, :attrs {:name "Genders", :properties "all"}} {:tag :form, :attrs {:name "Gender", :properties "all"}}]} electors-entity {:tag :entity, :attrs {:volatility "6", :magnitude "1", :name "electors", :table "electors"}, :content [{:tag :documentation, :attrs nil, :content ["All electors known to the system; electors are people believed to be entitled to vote in the current campaign."]} {: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", :column "name", :name "name", :type "string", :required "true", :size "64"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Name"}, :content nil}]} {:tag :property, :attrs {:default "Unknown", :farkey "id", :entity "genders", :column "gender", :type "entity", :name "gender"}, :content [{:tag :prompt, :attrs {:locale "en_GB.UTF-8", :prompt "Gender"}, :content nil}]}]} property (child electors-entity #(= (-> % :attrs :name) "gender")) expected "list-electors-by-gender" actual (list-related-query-name property electors-entity genders-entity)] (is (= expected actual) "just checking...")) (let [e1 {:tag :entity :attrs {:name "dwellings"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}}]} {:tag :property :attrs {:name "address" :type "entity" :entity "addresses"}}]} e2 {:tag :entity :attrs {:name "addresses"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}}]} {:tag :property :attrs {:name "dwellings" :type "list" :entity "dwellings"}}]}] (let [property {:tag :property :attrs {:name "address" :type "entity" :entity "addresses"}} expected "list-dwellings-by-address" actual (list-related-query-name property e1 e2)] (is (= expected actual) "Entity property")) (let [property {:tag :property :attrs {:name "dwellings" :type "list" :entity "dwellings"}} expected "list-dwellings-by-address" actual (list-related-query-name property e2 e1)] (is (= expected actual) "List property"))) (let [team-entity {:tag :entity :attrs {:name "teams"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}}]} {:tag :property :attrs {:name "members" :type "link" :entity "canvassers"}} {:tag :property :attrs {:name "organisers" :type "link" :entity "canvassers"}}]} canvasser-entity {:tag :entity :attrs {:name "canvassers"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}}]} {:tag :property :attrs {:name "memberships" :type "link" :entity "teams"}}]}] (let [property {:tag :property :attrs {:name "members" :type "link" :entity "canvassers"}} expected "list-members-by-team" actual (list-related-query-name property team-entity canvasser-entity)] (is (= actual expected) "Link property - members")) (let [property {:tag :property :attrs {:name "organisers" :type "link" :entity "canvassers"}} expected "list-organisers-by-team" actual (list-related-query-name property team-entity canvasser-entity)] (is (= actual expected) "Link property - organisers")) (let [property {:tag :property :attrs {:name "memberships" :type "link" :entity "teams"}} expected "list-memberships-by-canvasser" actual (list-related-query-name property canvasser-entity team-entity)] (is (= actual expected) "Link property - membersips"))))) (deftest link-table-name-tests (testing "link-table-name" (let [e1 {:tag :entity :attrs {:name "teams"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}}]} {:tag :property :attrs {:name "members" :type "link" :entity "canvassers"}} {:tag :property :attrs {:name "organisers" :type "link" :entity "canvassers"}}]} e2 {:tag :entity :attrs {:name "canvassers"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}}]} {:tag :property :attrs {:name "memberships" :type "link" :entity "teams"}} {:tag :property :attrs {:name "roles" :type "link" :entity "roles"}}]} e3 {:tag :entity :attrs {:name "roles"} :content [{:tag :key :content [{:tag :property :type "string" :distinct "all" :name "id"}]}]}] (let [property {:tag :property :attrs {:name "members" :type "link" :entity "canvassers"}} expected "ln_members_teams" actual (link-table-name property e1 e2)] (is (= actual expected) "Link property - members")) (let [property {:tag :property :attrs {:name "organisers" :type "link" :entity "canvassers"}} expected "ln_organisers_teams" actual (link-table-name property e1 e2)] (is (= actual expected) "Link property - organisers")) (let [property {:tag :property :attrs {:name "memberships" :type "link" :entity "teams"}} expected "ln_memberships_canvassers" actual (link-table-name property e2 e1)] (is (= actual expected) "Link property - membersips")) (let [property {:tag :property :attrs {:name "roles" :type "link" :entity "roles"}} expected "ln_canvassers_roles" actual (link-table-name property e2 e3)] (is (= actual expected) "Link property - roles"))))) (deftest unique-link-tests (testing "unique-link?" (let [e1 {:tag :entity :attrs {:name "teams"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}}]} {:tag :property :attrs {:name "members" :type "link" :entity "canvassers"}} {:tag :property :attrs {:name "organisers" :type "link" :entity "canvassers"}}]} e2 {:tag :entity :attrs {:name "canvassers"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}}]} {:tag :property :attrs {:name "memberships" :type "link" :entity "teams"}} {:tag :property :attrs {:name "roles" :type "link" :entity "roles"}}]} e3 {:tag :entity :attrs {:name "roles"} :content [{:tag :key :content [{:tag :property :type "string" :distinct "all" :name "id"}]}]}] (is (= false (unique-link? e1 e2)) "There are two logical links, three link properties, between e1 and e2") (is (= true (unique-link? e2 e3)) "There is only one link between e2 and e3")))) (deftest capitalise-tests (testing "capitalise" (is (= (capitalise "the quick brown fox jumped over the lazy dog") "The Quick Brown Fox Jumped Over The Lazy Dog")))) (deftest safe-name-tests (testing "safe-name" (let [e1 {:tag :entity :attrs {:name "canvass-teams" :table "team"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}}]} {:tag :property :attrs {:name "members" :type "link" :entity "canvassers"}} {:tag :property :attrs {:name "organisers" :type "link" :entity "canvassers"}}]} p1 {:tag :property :attrs {:name "id" :type "integer" :distinct "system"}} p2 {:tag :property :attrs {:name "with_underscore" :column "with-hyphen" :type "integer"}}] (is (= (safe-name "the quick brown fox jumped over the lazy dog") "thequickbrownfoxjumpedoverthelazydog") "absent a convention, spaces are suppressed") (is (= (safe-name "the quick brown fox jumped over the lazy dog" :c) "the_quick_brown_fox_jumped_over_the_lazy_dog") "in :c convention, spaces are replaced with underscores") (is (= (safe-name "the quick brown fox jumped over the lazy dog" :c-sharp) "TheQuickBrownFoxJumpedOverTheLazyDog") "in :c-sharp convention spaces are suppressed and all words camel cased") (is (= (safe-name "the quick brown fox jumped over the lazy dog" :java) "theQuickBrownFoxJumpedOverTheLazyDog") "in :java convention spaces are suppressed and embedded words camel cased") (is (= (safe-name "the quick brown fox jumped over the lazy dog" :sql) "the_quick_brown_fox_jumped_over_the_lazy_dog") "in :sql convention, spaces are replaced with underscores") (is (= (safe-name e1) "canvass-teams")) (is (= (safe-name e1 :c) "canvass_teams") "In :c convention, hyphen is replaced by underscore") (is (= (safe-name e1 :c-sharp) "CanvassTeams") "In :c-sharp convention, hyphen is suppressed and words capitalised") (is (= (safe-name e1 :java) "canvassTeams") "In :java convention, hyphen is suppressed and embedded words capitalised") (is (= (safe-name e1 :sql) "team") "In :sql convention, the :table attribute is preferred") (is (= (safe-name p1) "id")) (is (= (safe-name p1 :c) "id")) (is (= (safe-name p1 :c-sharp) "Id")) (is (= (safe-name p1 :java) "id")) (is (= (safe-name p1 :sql) "id")) (is (= (safe-name p2) "withunderscore") "Absent a convention, underscore is not considered safe") (is (= (safe-name p2 :c) "with_underscore") "In :c convention, underscore is considered safe") (is (= (safe-name p2 :c-sharp) "WithUnderscore") "In :c-sharp convention, initial letters are capialised and underscore is suppressed") (is (= (safe-name p2 :java) "withUnderscore") "In :java convention, underscore is suppressed and embedded words capitalised") (is (= (safe-name p2 :sql) "with_hyphen") "In :sql convention, the column-name variant is preferred, and hyphens replaced with underscores")))) (deftest key-names-tests (testing "key-names" (let [e1 {:tag :entity :attrs {:name "canvass-teams" :table "team"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}}]} {:tag :property :attrs {:name "members" :type "link" :entity "canvassers"}} {:tag :property :attrs {:name "organisers" :type "link" :entity "canvassers"}}]} e2 {:tag :entity :attrs {:name "canvass-teams" :table "team"} :content [{:tag :key :content [{:tag :property :attrs {:name "id" :type "integer" :distinct "system"}} {:tag :property :attrs {:name "shard" :type "string" :default "SW"}}]} {:tag :property :attrs {:name "members" :type "link" :entity "canvassers"}} {:tag :property :attrs {:name "organisers" :type "link" :entity "canvassers"}}]}] (is (= (key-names e1) #{"id"})) (is (= (key-names e1 true) #{:id})) (is (= (key-names e2) #{"id" "shard"})) (is (= (key-names e2 true) #{:id :shard}))))) (deftest order-preserving-set-tests (testing "order-preserving-set" (is (= '(:a) (order-preserving-set '(:a :a :a :a)))) (is (= '(:a) (order-preserving-set [:a :a :a :a]))) (is (= '(:a :b :c :d :e) (order-preserving-set '(:a :a :b :c :a :b :d :c :e))))))