Aedifex can generate POM files.

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
+          )))