aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2020-08-12 01:06:06 -0400
committerEduardo Julian2020-08-12 01:06:06 -0400
commitbea5913a915a0bfd795f9e12b40f1d32716a6cf8 (patch)
tree535277cf8c683f95239d9b68873869d1304bf22b
parentddcc768d9d2e798814989037a286df9951840bcd (diff)
Aedifex can generate POM files.
-rw-r--r--stdlib/source/lux/locale/territory.lux8
-rw-r--r--stdlib/source/program/aedifex/dependency.lux1
-rw-r--r--stdlib/source/program/aedifex/pom.lux118
-rw-r--r--stdlib/source/test/lux.lux105
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux4
-rw-r--r--stdlib/source/test/lux/locale.lux13
-rw-r--r--stdlib/source/test/lux/locale/territory.lux206
7 files changed, 404 insertions, 51 deletions
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 [<name> <type> <tag>]
+ [(def: <name>
+ (-> <type> XML)
+ (|>> ..developer' (#_.Node ["" <tag>] _.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 [<bundle> <territories>]
+ [(def: <bundle>
+ Bundle
+ (let [count (template.count <territories>)
+ territories (`` (list (~~ (template.splice <territories>))))]
+ {#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 <territories>
+ 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 [<lens> <tag> <hash>]
+ [(let [[count set] (..aggregate (get@ <tag>) <hash> ..territories)]
+ (_.cover [<lens>]
+ (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 <reference> <aliases>)
+ (_.cover <aliases>
+ (list.every? (:: /.equivalence = <reference>)
+ (`` (list (~~ (template.splice <aliases>)))))))
+
+(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
+ )))