From bea5913a915a0bfd795f9e12b40f1d32716a6cf8 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 12 Aug 2020 01:06:06 -0400 Subject: Aedifex can generate POM files. --- stdlib/source/lux/locale/territory.lux | 8 +- stdlib/source/program/aedifex/dependency.lux | 1 + stdlib/source/program/aedifex/pom.lux | 118 ++++++++++++ stdlib/source/test/lux.lux | 105 ++++++----- stdlib/source/test/lux/control/concurrency/frp.lux | 4 +- stdlib/source/test/lux/locale.lux | 13 ++ stdlib/source/test/lux/locale/territory.lux | 206 +++++++++++++++++++++ 7 files changed, 404 insertions(+), 51 deletions(-) create mode 100644 stdlib/source/program/aedifex/pom.lux create mode 100644 stdlib/source/test/lux/locale.lux create mode 100644 stdlib/source/test/lux/locale/territory.lux diff --git a/stdlib/source/lux/locale/territory.lux b/stdlib/source/lux/locale/territory.lux index 40a2a0c31..fa313c20c 100644 --- a/stdlib/source/lux/locale/territory.lux +++ b/stdlib/source/lux/locale/territory.lux @@ -293,11 +293,15 @@ ["ZW" "ZWE" 716 "Zimbabwe" zimbabwe []] ) - (structure: #export equivalence (Equivalence Territory) + (structure: #export equivalence + (Equivalence Territory) + (def: (= reference sample) (is? reference sample))) - (structure: #export hash (Hash Territory) + (structure: #export hash + (Hash Territory) + (def: &equivalence ..equivalence) (def: hash diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux index 2507ad589..13e30028b 100644 --- a/stdlib/source/program/aedifex/dependency.lux +++ b/stdlib/source/program/aedifex/dependency.lux @@ -1,6 +1,7 @@ (.module: [lux (#- Type)]) +## https://maven.apache.org/ref/3.6.3/maven-core/artifact-handlers.html (type: #export Type Text) diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux new file mode 100644 index 000000000..d19ec5902 --- /dev/null +++ b/stdlib/source/program/aedifex/pom.lux @@ -0,0 +1,118 @@ +(.module: + [lux #* + [control + [pipe (#+ case>)]] + [data + ["." maybe ("#@." functor)] + [format + ["_" xml (#+ XML)]] + [collection + ["." list ("#@." monoid functor)]]]] + [// + ["/" project]]) + +## https://maven.apache.org/pom.html + +(def: #export file + "pom.xml") + +(def: version + XML + (#_.Node ["" "modelVersion"] _.attrs + (list (#_.Text "4.0.0")))) + +(def: (property tag value) + (-> Text Text XML) + (#_.Node ["" tag] + _.attrs + (list (#_.Text value)))) + +(def: (artifact value) + (-> /.Artifact (List XML)) + (list (..property "groupId" (get@ #/.group value)) + (..property "artifactId" (get@ #/.name value)) + (..property "version" (get@ #/.version value)))) + +(def: distribution + (-> /.Distribution XML) + (|>> (case> #/.Repo "repo" + #/.Manual "manual") + (..property "distribution"))) + +(def: (license [name url distribution]) + (-> /.License XML) + (|> (list (..property "name" name) + (..property "url" url) + (..distribution distribution)) + (#_.Node ["" "license"] _.attrs))) + +(def: repository + (-> /.Repository XML) + (|>> (..property "url") + list + (#_.Node ["" "repository"] _.attrs))) + +(def: (dependency [artifact type]) + (-> /.Dependency XML) + (#_.Node ["" "dependency"] + _.attrs + (list@compose (..artifact artifact) + (list (..property "type" type))))) + +(def: scm + (-> /.SCM XML) + (|>> (..property "url") + list + (#_.Node ["" "scm"] _.attrs))) + +(def: (organization [name url]) + (-> /.Organization XML) + (|> (list (..property "name" name) + (..property "url" url)) + (#_.Node ["" "organization"] _.attrs))) + +(def: (developer-organization [name url]) + (-> /.Organization (List XML)) + (list (..property "organization" name) + (..property "organizationUrl" url))) + +(def: (developer' [name email organization]) + (-> /.Developer (List XML)) + (list& (..property "name" name) + (..property "email" email) + (|> organization (maybe@map ..developer-organization) (maybe.default (list))))) + +(template [ ] + [(def: + (-> XML) + (|>> ..developer' (#_.Node ["" ] _.attrs)))] + + [developer /.Developer "developer"] + [contributor /.Contributor "contributor"] + ) + +(def: (group tag) + (-> Text (-> (List XML) XML)) + (|>> (#_.Node ["" tag] _.attrs))) + +(def: (info value) + (-> /.Info (List XML)) + ($_ list@compose + (|> value (get@ #/.url) (maybe@map (..property "url")) maybe.to-list) + (|> value (get@ #/.description) (maybe@map (..property "description")) maybe.to-list) + (|> value (get@ #/.licenses) (list@map ..license) (..group "licenses") list) + (|> value (get@ #/.scm) (maybe@map ..scm) maybe.to-list) + (|> value (get@ #/.organization) (maybe@map ..organization) maybe.to-list) + (|> value (get@ #/.developers) (list@map ..developer) (..group "developers") list) + (|> value (get@ #/.contributors) (list@map ..contributor) (..group "contributors") list) + )) + +(def: #export (project value) + (-> /.Project XML) + (#_.Node ["" "project"] _.attrs + ($_ list@compose + (list ..version) + (..artifact (get@ #/.identity value)) + (|> value (get@ #/.repositories) (list@map ..repository) (..group "repositories") list) + (|> value (get@ #/.dependencies) (list@map ..dependency) (..group "dependencies") list) + ))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 8ce6b58b5..d41c295c4 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -29,42 +29,46 @@ [math ["." random (#+ Random) ("#@." functor)]] ## TODO: Test these modules - [data - [format - [css (#+)] - [markdown (#+)]]] + ## [data + ## [format + ## [css (#+)] + ## [markdown (#+)]]] + ["@" target - [js (#+)] - [python (#+)] - [lua (#+)] - [ruby (#+)] - [php (#+)] - [common-lisp (#+)] - [scheme (#+)]] - [tool - [compiler - [language - [lux - [phase - [generation - [jvm (#+)] - [js (#+)] - ## [python (#+)] - ## [lua (#+)] - ## [ruby (#+)] - ## [php (#+)] - ## [common-lisp (#+)] - ## [scheme (#+)] - ] - [extension - [generation - [jvm (#+)] - [js (#+)] - ## [python (#+)] - ## [lua (#+)] - ## [ruby (#+)] - ]] - ]]]]] + ## [js (#+)] + ## [python (#+)] + ## [lua (#+)] + ## [ruby (#+)] + ## [php (#+)] + ## [common-lisp (#+)] + ## [scheme (#+)] + ] + + ## [tool + ## [compiler + ## [language + ## [lux + ## [phase + ## [generation + ## [jvm (#+)] + ## [js (#+)] + ## ## [python (#+)] + ## ## [lua (#+)] + ## ## [ruby (#+)] + ## ## [php (#+)] + ## ## [common-lisp (#+)] + ## ## [scheme (#+)] + ## ] + ## [extension + ## [generation + ## [jvm (#+)] + ## [js (#+)] + ## ## [python (#+)] + ## ## [lua (#+)] + ## ## [ruby (#+)] + ## ]] + ## ]]]]] + ## [control ## ["._" predicate] ## [function @@ -123,6 +127,7 @@ ["#." abstract] ["#." control] ["#." data] + ["#." locale] ["#." macro] ["#." math] ["#." time] @@ -306,6 +311,23 @@ @.js on-valid-host} on-default)))))) +(def: sub-tests + Test + (_.in-parallel (list /abstract.test + /control.test + /data.test + /locale.test + /macro.test + /math.test + /time.test + ## /tool.test + /type.test + /world.test + /host.test + /extension.test + /target/jvm.test + ))) + (def: test (<| (_.context (name.module (name-of /._))) ($_ _.and @@ -350,18 +372,7 @@ ..templates) (<| (_.context "Cross-platform support.") ..cross-platform-support))) - (_.in-parallel (list /abstract.test - /control.test - /data.test - /macro.test - /math.test - /time.test - ## /tool.test - /type.test - /world.test - /host.test - /extension.test - /target/jvm.test)) + ..sub-tests ))) (program: args diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 776d84ae5..70aae523e 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -169,7 +169,7 @@ (list@= (list distint/0 distint/1 distint/2) actual)))) (wrap (do promise.monad - [#let [polling-delay 10 + [#let [polling-delay 20 amount-of-polls 5 total-delay (n.* amount-of-polls polling-delay) [channel sink] (/.poll polling-delay (: (IO Nat) (io.io sample)))] @@ -180,7 +180,7 @@ (and (list.every? (n.= sample) actual) (n.>= amount-of-polls (list.size actual)))))) (wrap (do promise.monad - [#let [polling-delay 10 + [#let [polling-delay 20 amount-of-polls 5 total-delay (n.* amount-of-polls polling-delay) [channel sink] (/.periodic polling-delay)] diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux new file mode 100644 index 000000000..0e6f0ea01 --- /dev/null +++ b/stdlib/source/test/lux/locale.lux @@ -0,0 +1,13 @@ +(.module: + [lux #* + ["_" test (#+ Test)]] + ["." / #_ + ["#." language] + ["#." territory]]) + +(def: #export test + Test + ($_ _.and + /language.test + /territory.test + )) diff --git a/stdlib/source/test/lux/locale/territory.lux b/stdlib/source/test/lux/locale/territory.lux new file mode 100644 index 000000000..43d4401ec --- /dev/null +++ b/stdlib/source/test/lux/locale/territory.lux @@ -0,0 +1,206 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + [hash (#+ Hash)]] + [data + ["." text] + [number + ["n" nat]] + [collection + ["." set (#+ Set)] + ["." list ("#@." functor fold)]]] + [macro + ["." template]] + [math + ["." random]]] + {1 + ["." /]}) + +(type: Bundle + {#count Nat + #names (Set Text) + #shorts (Set Text) + #longs (Set Text) + #numbers (Set Nat) + #territories (Set /.Territory) + #test Test}) + +(template [ ] + [(def: + Bundle + (let [count (template.count ) + territories (`` (list (~~ (template.splice ))))] + {#count count + #names (|> territories (list@map /.name) (set.from-list text.hash)) + #shorts (|> territories (list@map /.short-code) (set.from-list text.hash)) + #longs (|> territories (list@map /.long-code) (set.from-list text.hash)) + #numbers (|> territories (list@map /.numeric-code) (set.from-list n.hash)) + #territories (|> territories (set.from-list /.hash)) + #test (_.cover + true)}))] + + [territories/a [/.afghanistan /.aland-islands /.albania /.algeria /.american-samoa + /.andorra /.angola /.anguilla /.antarctica /.antigua + /.argentina /.armenia /.aruba /.australia /.austria + /.azerbaijan]] + [territories/b [/.the-bahamas /.bahrain /.bangladesh /.barbados /.belarus + /.belgium /.belize /.benin /.bermuda /.bhutan + /.bolivia /.bonaire /.bosnia /.botswana /.bouvet-island + /.brazil /.british-indian-ocean-territory /.brunei-darussalam /.bulgaria /.burkina-faso + /.burundi]] + [territories/c [/.cape-verde /.cambodia /.cameroon /.canada /.cayman-islands + /.central-african-republic /.chad /.chile /.china /.christmas-island + /.cocos-islands /.colombia /.comoros /.congo /.democratic-republic-of-the-congo + /.cook-islands /.costa-rica /.ivory-coast /.croatia /.cuba + /.curacao /.cyprus /.czech-republic]] + [territories/d [/.denmark /.djibouti /.dominica /.dominican-republic]] + [territories/e [/.ecuador /.egypt /.el-salvador /.equatorial-guinea /.eritrea + /.estonia /.eswatini /.ethiopia]] + [territories/f [/.falkland-islands /.faroe-islands /.fiji /.finland /.france + /.french-guiana /.french-polynesia /.french-southern-territories]] + [territories/g [/.gabon /.the-gambia /.georgia /.germany /.ghana + /.gibraltar /.greece /.greenland /.grenada /.guadeloupe + /.guam /.guatemala /.guernsey /.guinea /.guinea-bissau + /.guyana]] + [territories/h [/.haiti /.heard-island /.honduras /.hong-kong + /.hungary]] + [territories/i [/.iceland /.india /.indonesia /.iran /.iraq + /.ireland /.isle-of-man /.israel /.italy]] + [territories/j [/.jamaica /.japan /.jersey /.jordan]] + [territories/k [/.kazakhstan /.kenya /.kiribati /.north-korea /.south-korea + /.kuwait /.kyrgyzstan]] + [territories/l [/.laos /.latvia /.lebanon /.lesotho /.liberia + /.libya /.liechtenstein /.lithuania /.luxembourg]] + [territories/m [/.macau /.macedonia /.madagascar /.malawi /.malaysia + /.maldives /.mali /.malta /.marshall-islands /.martinique + /.mauritania /.mauritius /.mayotte /.mexico /.micronesia + /.moldova /.monaco /.mongolia /.montenegro /.montserrat + /.morocco /.mozambique /.myanmar]] + [territories/n [/.namibia /.nauru /.nepal /.netherlands /.new-caledonia + /.new-zealand /.nicaragua /.niger /.nigeria /.niue + /.norfolk-island /.northern-mariana-islands /.norway]] + [territories/o [/.oman]] + [territories/p [/.pakistan /.palau /.palestine /.panama /.papua-new-guinea + /.paraguay /.peru /.philippines /.pitcairn-islands /.poland + /.portugal /.puerto-rico]] + [territories/q [/.qatar]] + [territories/r [/.reunion /.romania /.russia /.rwanda]] + [territories/s [/.saint-barthelemy /.saint-helena /.saint-kitts /.saint-lucia /.saint-martin + /.saint-pierre /.saint-vincent /.samoa /.san-marino /.sao-tome + /.saudi-arabia /.senegal /.serbia /.seychelles /.sierra-leone + /.singapore /.sint-maarten /.slovakia /.slovenia /.solomon-islands + /.somalia /.south-africa /.south-georgia /.south-sudan /.spain + /.sri-lanka /.sudan /.suriname /.svalbard /.sweden + /.switzerland /.syria]] + [territories/t [/.taiwan /.tajikistan /.tanzania /.thailand /.east-timor + /.togo /.tokelau /.tonga /.trinidad /.tunisia + /.turkey /.turkmenistan /.turks /.tuvalu]] + [territories/u [/.uganda /.ukraine /.united-arab-emirates /.united-kingdom /.united-states-of-america + /.united-states-minor-outlying-islands /.uruguay /.uzbekistan]] + [territories/v [/.vanuatu /.vatican-city /.venezuela /.vietnam /.british-virgin-islands /.united-states-virgin-islands]] + [territories/w [/.wallis /.western-sahara]] + [territories/y [/.yemen]] + [territories/z [/.zambia /.zimbabwe]] + ) + +(def: territories + (List Bundle) + (list ..territories/a + ..territories/b + ..territories/c + ..territories/d + ..territories/e + ..territories/f + ..territories/g + ..territories/h + ..territories/i + ..territories/j + ..territories/k + ..territories/l + ..territories/m + ..territories/n + ..territories/o + ..territories/p + ..territories/q + ..territories/r + ..territories/s + ..territories/t + ..territories/u + ..territories/v + ..territories/w + ..territories/y + ..territories/z)) + +(def: (aggregate lens hash territories) + (All [a] (-> (-> Bundle (Set a)) + (Hash a) + (List Bundle) + [Nat (Set a)])) + (list@fold (function (_ bundle [count set]) + [(n.+ count (get@ #count bundle)) + (set.union set (lens bundle))]) + [0 (set.new hash)] + territories)) + +(def: territories-test + Test + (|> ..territories + list.reverse + (list@map (get@ #test)) + (list@fold _.and + (`` ($_ _.and + (~~ (template [ ] + [(let [[count set] (..aggregate (get@ ) ..territories)] + (_.cover [] + (n.= count (set.size set))))] + + [/.name #names text.hash] + [/.short-code #shorts text.hash] + [/.long-code #longs text.hash] + [/.numeric-code #numbers n.hash] + [/.equivalence #territories /.hash] + )) + ))))) + +(template: (!aliases ) + (_.cover + (list.every? (:: /.equivalence = ) + (`` (list (~~ (template.splice ))))))) + +(def: aliases-test + Test + ($_ _.and + ## A + (!aliases /.antigua [/.barbuda]) + ## B + (!aliases /.bonaire [/.sint-eustatius /.saba]) + (!aliases /.bosnia [/.herzegovina]) + ## H + (!aliases /.heard-island [/.mcdonald-islands]) + ## S + (!aliases /.saint-helena [/.ascension /.tristan-da-cunha]) + (!aliases /.saint-kitts [/.nevis]) + (!aliases /.saint-pierre [/.miquelon]) + (!aliases /.saint-vincent [/.the-grenadines]) + (!aliases /.sao-tome [/.principe]) + (!aliases /.south-georgia [/.south-sandwich-islands]) + (!aliases /.svalbard [/.jan-mayen]) + ## T + (!aliases /.trinidad [/.tobago]) + (!aliases /.turks [/.caicos-islands]) + ## U + (!aliases /.united-kingdom [/.northern-ireland]) + ## W + (!aliases /.wallis [/.futuna]) + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Territory]) + ($_ _.and + ..territories-test + ..aliases-test + ))) -- cgit v1.2.3