Add local repo installation to Aedifex.

16 files changed, 348 insertions, 113 deletions

diff --git a/stdlib/source/lux/locale.lux b/stdlib/source/lux/locale.lux
index 0fe688e43..5205c2f85 100644
--- a/stdlib/source/lux/locale.lux
+++ b/stdlib/source/lux/locale.lux
@@ -44,7 +44,8 @@
   (structure: #export hash
     (Hash Locale)
     
-    (def: &equivalence ..equivalence)
+    (def: &equivalence
+      ..equivalence)
     
     (def: hash
       (|>> :representation
diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux
index 8b868db58..f91b0e51a 100644
--- a/stdlib/source/lux/macro/code.lux
+++ b/stdlib/source/lux/macro/code.lux
@@ -58,7 +58,9 @@
   [local-identifier #.Identifier "Produces a local identifier (an identifier with no module prefix)."]
   [local-tag        #.Tag        "Produces a local tag (a tag with no module prefix)."])
 
-(structure: #export equivalence (Equivalence Code)
+(structure: #export equivalence
+  (Equivalence Code)
+  
   (def: (= x y)
     (case [x y]
       (^template [<tag> <eq>]
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
index 1dceaaba6..7d6a56b63 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -155,26 +155,23 @@
       (#.Some [_ path])
       (#try.Success path))))
 
-(def: (enumerate-context system partial-host-extension context enumeration)
-  (-> (file.System Promise) Extension Context Enumeration
-      (Promise (Try Enumeration)))
+(def: (enumerate-context system context enumeration)
+  (-> (file.System Promise) Context Enumeration (Promise (Try Enumeration)))
   (do {@ (try.with promise.monad)}
     [directory (!.use (:: system directory) [context])]
     (loop [directory directory
            enumeration enumeration]
       (do @
         [files (!.use (:: directory files) [])
-         enumeration (monad.fold @ (let [full-host-extension (..full-host-extension partial-host-extension)]
-                                     (function (_ file enumeration)
-                                       (let [path (!.use (:: file path) [])]
-                                         (if (or (text.ends-with? full-host-extension path)
-                                                 (text.ends-with? ..lux-extension path))
-                                           (do @
-                                             [path (promise@wrap (..clean-path system context path))
-                                              source-code (!.use (:: file content) [])]
-                                             (promise@wrap
-                                              (dictionary.try-put path source-code enumeration)))
-                                           (wrap enumeration)))))
+         enumeration (monad.fold @ (function (_ file enumeration)
+                                     (let [path (!.use (:: file path) [])]
+                                       (if (text.ends-with? ..lux-extension path)
+                                         (do @
+                                           [path (promise@wrap (..clean-path system context path))
+                                            source-code (!.use (:: file content) [])]
+                                           (promise@wrap
+                                            (dictionary.try-put path source-code enumeration)))
+                                         (wrap enumeration))))
                                  enumeration
                                  files)
          directories (!.use (:: directory directories) [])]
@@ -183,12 +180,11 @@
 (def: Action
   (type (All [a] (Promise (Try a)))))
 
-(def: #export (enumerate system partial-host-extension contexts)
-  (-> (file.System Promise) Extension (List Context)
-      (Action Enumeration))
+(def: #export (enumerate system contexts)
+  (-> (file.System Promise) (List Context) (Action Enumeration))
   (monad.fold (: (Monad Action)
                  (try.with promise.monad))
-              (enumerate-context system partial-host-extension)
+              (enumerate-context system)
               (: Enumeration
                  (dictionary.new text.hash))
               contexts))
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index fd269f71f..6909704dd 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -10,7 +10,9 @@
      ["." cli (#+ program:)]
      ["<c>" code]]
     [security
-     ["!" capability]]]
+     ["!" capability]]
+    [concurrency
+     ["." promise]]]
    [data
     [binary (#+ Binary)]
     ["." text
@@ -28,7 +30,9 @@
   ["." / #_
    ["#" project]
    ["#." parser]
-   ["#." pom]])
+   ["#." pom]
+   ["#." cli]
+   ["#." local]])
 
 (def: (read-file! path)
   (-> Path (IO (Try Binary)))
@@ -67,22 +71,36 @@
             [..read-code]
             [(list) (<c>.run /parser.project)])))
 
-(program: [project-file]
+(program: [{command /cli.command}]
   (do {@ io.monad}
-    [data (..read-file! project-file)]
+    [data (..read-file! /.file)]
     (case data
       (#try.Success data)
       (case (..project data)
-        (#try.Success value)
-        (do @
-          [outcome (..write-pom! /pom.file value)]
-          (case outcome
-            (#try.Success value)
-            (wrap (log! "Successfully wrote POM file!"))
-            
-            (#try.Failure error)
-            (wrap (log! (format "Could not write POM file:" text.new-line
-                                error)))))
+        (#try.Success project)
+        (case command
+          #/cli.POM
+          (do @
+            [outcome (..write-pom! /pom.file project)]
+            (case outcome
+              (#try.Success value)
+              (wrap (log! "Successfully wrote POM file!"))
+              
+              (#try.Failure error)
+              (wrap (log! (format "Could not write POM file:" text.new-line
+                                  error)))))
+          
+          #/cli.Install
+          (exec (do promise.monad
+                  [outcome (/local.install (file.async file.system) project)]
+                  (wrap (case outcome
+                          (#try.Success _)
+                          (log! "Successfully installed locally!")
+                          
+                          (#try.Failure error)
+                          (log! (format "Could not install locally:" text.new-line
+                                        error)))))
+            (wrap [])))
         
         (#try.Failure error)
         (wrap (log! (format "Invalid format file:" text.new-line
@@ -90,4 +108,4 @@
       
       (#try.Failure error)
       (wrap (log! (format "Could not read file: "
-                          (%.text project-file)))))))
+                          (%.text /.file)))))))
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
new file mode 100644
index 000000000..5f75cac9b
--- /dev/null
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -0,0 +1,16 @@
+(.module:
+  [lux #*
+   [control
+    ["<>" parser
+     ["." cli (#+ Parser)]]]])
+
+(type: #export Command
+  #POM
+  #Install)
+
+(def: #export command
+  (Parser Command)
+  ($_ <>.or
+      (cli.this "pom")
+      (cli.this "install")
+      ))
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
new file mode 100644
index 000000000..15d9a9323
--- /dev/null
+++ b/stdlib/source/program/aedifex/local.lux
@@ -0,0 +1,86 @@
+(.module:
+  [lux #*
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." io (#+ IO)]
+    ["." try (#+ Try)]
+    [concurrency
+     ["." promise (#+ Promise)]]
+    [security
+     ["!" capability]]]
+   [data
+    [binary (#+ Binary)]
+    ["." text
+     ["%" format (#+ format)]
+     ["." encoding]]
+    [collection
+     ["." list ("#@." monoid)]]
+    [format
+     ["." binary]
+     ["." tar]
+     ["." xml]]]
+   [world
+    ["." file (#+ Path File Directory)]]]
+  [program
+   [compositor
+    ["." export]]]
+  ["." // #_
+   ["#." project (#+ Project)]
+   ["#." pom]
+   ["#." dependency]])
+
+(def: group-separator
+  ".")
+
+(def: (local system)
+  (All [a] (-> (file.System a) Path))
+  (format "~" (:: system separator) ".m2"))
+
+(def: (repository system)
+  (All [a] (-> (file.System a) Path))
+  (format (..local system) (:: system separator) "repository"))
+
+(def: (guarantee-repository! system project)
+  (-> (file.System Promise) Project (Promise (Try Path)))
+  (do {@ (try.with promise.monad)}
+    [_ (: (Promise (Try (Directory Promise)))
+          (file.get-directory promise.monad system (..local system)))
+     #let [root (..repository system)
+           identity (get@ #//project.identity project)]
+     _ (: (Promise (Try (Directory Promise)))
+          (file.get-directory promise.monad system root))]
+    (monad.fold @
+                (function (_ child parent)
+                  (do @
+                    [#let [path (format parent (:: system separator) child)]
+                     _ (: (Promise (Try (Directory Promise)))
+                          (file.get-directory promise.monad system path))]
+                    (wrap path)))
+                root
+                (list@compose (|> identity
+                                  (get@ #//project.group)
+                                  (text.split-all-with ..group-separator))
+                              (list (get@ #//project.name identity)
+                                    (get@ #//project.version identity))))))
+
+(def: (save! system content file)
+  (-> (file.System Promise) Binary Path (Promise (Try Any)))
+  (do (try.with promise.monad)
+    [file (: (Promise (Try (File Promise)))
+             (file.get-file promise.monad system file))]
+    (!.use (:: file over-write) [content])))
+
+(def: #export (install system project)
+  (-> (file.System Promise) Project (Promise (Try Any)))
+  (do (try.with promise.monad)
+    [repository (..guarantee-repository! system project)
+     #let [identity (get@ #//project.identity project)
+           artifact-name (format repository
+                                 (:: system separator) (get@ #//project.name identity)
+                                 "-" (get@ #//project.version identity))]
+     package (export.library system (get@ #//project.sources project))
+     _ (..save! system (binary.run tar.writer package)
+                (format artifact-name "." //dependency.lux-library))]
+    (..save! system (|> project //pom.project (:: xml.codec encode) encoding.to-utf8)
+             (format artifact-name //pom.extension))))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index f3bdbe34f..1a4b2f638 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -121,6 +121,10 @@
        (<>.default //dependency.lux-library ..type)
        )))
 
+(def: source
+  (Parser /.Source)
+  <c>.text)
+
 (def: #export project
   (Parser /.Project)
   (<| <c>.form
@@ -137,4 +141,7 @@
               (<| (<>.default (list))
                   (..bundle (' #dependencies))
                   ..dependency)
+              (<| (<>.default (list "source"))
+                  (..bundle (' #sources))
+                  ..source)
               ))))
diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux
index d19ec5902..102728e1e 100644
--- a/stdlib/source/program/aedifex/pom.lux
+++ b/stdlib/source/program/aedifex/pom.lux
@@ -16,6 +16,9 @@
 (def: #export file
   "pom.xml")
 
+(def: #export extension
+  ".pom")
+
 (def: version
   XML
   (#_.Node ["" "modelVersion"] _.attrs
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
index a0891951f..9f98ebc51 100644
--- a/stdlib/source/program/aedifex/project.lux
+++ b/stdlib/source/program/aedifex/project.lux
@@ -1,10 +1,14 @@
 (.module:
-  [lux (#- Name Info)
+  [lux (#- Name Info Source)
    [world
-    [net (#+ URL)]]]
+    [net (#+ URL)]
+    [file (#+ Path)]]]
   [//
    ["." dependency]])
 
+(def: #export file
+  "project.lux")
+
 (type: #export Group
   Text)
 
@@ -61,8 +65,12 @@
 (type: #export Dependency
   [Artifact dependency.Type])
 
+(type: #export Source
+  Path)
+
 (type: #export Project
   {#identity Artifact
    #info Info
    #repositories (List Repository)
-   #dependencies (List Dependency)})
+   #dependencies (List Dependency)
+   #sources (List Source)})
diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux
index 03235bbad..4c4384636 100644
--- a/stdlib/source/program/compositor/cli.lux
+++ b/stdlib/source/program/compositor/cli.lux
@@ -12,9 +12,14 @@
    [world
     [file (#+ Path)]]])
 
-(type: #export Source Path)
-(type: #export Library Path)
-(type: #export Target Path)
+(type: #export Source
+  Path)
+
+(type: #export Library
+  Path)
+
+(type: #export Target
+  Path)
 
 (type: #export Compilation
   [(List Source) (List Library) Target Module])
diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux
index f6a78ed78..468b1ef9d 100644
--- a/stdlib/source/program/compositor/export.lux
+++ b/stdlib/source/program/compositor/export.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux #*
+  [lux (#- Source)
    [abstract
     ["." monad (#+ do)]]
    [control
@@ -27,7 +27,10 @@
    [world
     ["." file]]]
   [//
-   [cli (#+ Export)]])
+   [cli (#+ Source Export)]])
+
+(def: file
+  "library.tar")
 
 (def: no-ownership
   tar.Ownership
@@ -37,26 +40,31 @@
     {#tar.user commons
      #tar.group commons}))
 
-(def: #export (export system extension [sources target])
-  (-> (file.System Promise) Extension Export (Promise (Try Any)))
-  (let [package (format target (:: system separator) "library.tar")]
+(def: #export (library system sources)
+  (-> (file.System Promise) (List Source) (Promise (Try tar.Tar)))
+  (do (try.with promise.monad)
+    [files (io.enumerate system sources)]
+    (|> (dictionary.entries files)
+        (monad.map try.monad
+                   (function (_ [path source-code])
+                     (do try.monad
+                       [path (|> path
+                                 (text.replace-all (:: system separator) .module-separator)
+                                 tar.path)
+                        source-code (tar.content source-code)]
+                       (wrap (#tar.Normal [path
+                                           (instant.from-millis +0)
+                                           tar.none
+                                           ..no-ownership
+                                           source-code])))))
+        (:: try.monad map row.from-list)
+        (:: promise.monad wrap))))
+
+(def: #export (export system [sources target])
+  (-> (file.System Promise) Export (Promise (Try Any)))
+  (let [package (format target (:: system separator) ..file)]
     (do (try.with promise.monad)
-      [package (: (Promise (Try (file.File Promise)))
-                  (file.get-file promise.monad system package))
-       files (io.enumerate system extension sources)
-       tar (|> (dictionary.entries files)
-               (monad.map try.monad
-                          (function (_ [path source-code])
-                            (do try.monad
-                              [path (|> path
-                                        (text.replace-all (:: system separator) .module-separator)
-                                        tar.path)
-                               source-code (tar.content source-code)]
-                              (wrap (#tar.Normal [path
-                                                  (instant.from-millis +0)
-                                                  tar.none
-                                                  ..no-ownership
-                                                  source-code])))))
-               (:: try.monad map (|>> row.from-list (binary.run tar.writer)))
-               promise@wrap)]
-      (!.use (:: package over-write) tar))))
+      [tar (..library system sources)
+       package (: (Promise (Try (file.File Promise)))
+                  (file.get-file promise.monad system package))]
+      (!.use (:: package over-write) (binary.run tar.writer tar)))))
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index 70aae523e..fe082cda7 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -168,27 +168,28 @@
                       (_.claim [/.distinct]
                                (list@= (list distint/0 distint/1 distint/2)
                                        actual))))
-              (wrap (do promise.monad
-                      [#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)))]
-                       _ (promise.schedule total-delay (io.io []))
-                       _ (promise.future (:: sink close))
-                       actual (/.consume channel)]
-                      (_.claim [/.poll]
-                               (and (list.every? (n.= sample) actual)
-                                    (n.>= amount-of-polls (list.size actual))))))
-              (wrap (do promise.monad
-                      [#let [polling-delay 20
-                             amount-of-polls 5
-                             total-delay (n.* amount-of-polls polling-delay)
-                             [channel sink] (/.periodic polling-delay)]
-                       _ (promise.schedule total-delay (io.io []))
-                       _ (promise.future (:: sink close))
-                       actual (/.consume channel)]
-                      (_.claim [/.periodic]
-                               (n.>= amount-of-polls (list.size actual)))))
+              (let [polling-delay 10
+                    wiggle-room (n.* 2 polling-delay)
+                    amount-of-polls 5
+                    total-delay (|> polling-delay
+                                    (n.* amount-of-polls)
+                                    (n.+ wiggle-room))]
+                ($_ _.and
+                    (wrap (do promise.monad
+                            [#let [[channel sink] (/.poll polling-delay (: (IO Nat) (io.io sample)))]
+                             _ (promise.schedule total-delay (io.io []))
+                             _ (promise.future (:: sink close))
+                             actual (/.consume channel)]
+                            (_.claim [/.poll]
+                                     (and (list.every? (n.= sample) actual)
+                                          (n.>= amount-of-polls (list.size actual))))))
+                    (wrap (do promise.monad
+                            [#let [[channel sink] (/.periodic polling-delay)]
+                             _ (promise.schedule total-delay (io.io []))
+                             _ (promise.future (:: sink close))
+                             actual (/.consume channel)]
+                            (_.claim [/.periodic]
+                                     (n.>= amount-of-polls (list.size actual)))))))
               (wrap (do promise.monad
                       [#let [max-iterations 10]
                        actual (|> [0 sample]
diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux
index 2495223b5..1c8933499 100644
--- a/stdlib/source/test/lux/control/concurrency/promise.lux
+++ b/stdlib/source/test/lux/control/concurrency/promise.lux
@@ -109,10 +109,10 @@
                                   (i.>= (.int to-wait)
                                         (duration.to-millis (instant.span pre post)))))))
             (wrap (do /.monad
-                    [?left (/.or (/.delay 10 leftE)
-                                 (/.delay 20 dummy))
-                     ?right (/.or (/.delay 20 dummy)
-                                  (/.delay 10 rightE))]
+                    [?left (/.or (/.delay 100 leftE)
+                                 (/.delay 200 dummy))
+                     ?right (/.or (/.delay 200 dummy)
+                                  (/.delay 100 rightE))]
                     (_.claim [/.or]
                              (case [?left ?right]
                                [(#.Left leftA) (#.Right rightA)]
@@ -122,10 +122,10 @@
                                _
                                false))))
             (wrap (do /.monad
-                    [leftA (/.either (/.delay 10 leftE)
-                                     (/.delay 20 dummy))
-                     rightA (/.either (/.delay 20 dummy)
-                                      (/.delay 10 rightE))]
+                    [leftA (/.either (/.delay 100 leftE)
+                                     (/.delay 200 dummy))
+                     rightA (/.either (/.delay 200 dummy)
+                                      (/.delay 100 rightE))]
                     (_.claim [/.either]
                              (n.= (n.+ leftE rightE)
                                   (n.+ leftA rightA)))))
diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux
index a00b8bc58..d09625d79 100644
--- a/stdlib/source/test/lux/control/function/memo.lux
+++ b/stdlib/source/test/lux/control/function/memo.lux
@@ -50,7 +50,7 @@
   Test
   (<| (_.covering /._)
       (do {@ random.monad}
-        [input (|> random.nat (:: @ map (|>> (n.% 6) (n.+ 20))))])
+        [input (|> random.nat (:: @ map (|>> (n.% 5) (n.+ 21))))])
       (_.with-cover [/.Memo])
       ($_ _.and
           (_.cover [/.closed /.none]
diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux
index d646852f3..8bc24976e 100644
--- a/stdlib/source/test/lux/control/parser/binary.lux
+++ b/stdlib/source/test/lux/control/parser/binary.lux
@@ -3,8 +3,10 @@
    ["_" test (#+ Test)]
    [abstract
     [equivalence (#+ Equivalence)]
+    [predicate (#+ Predicate)]
     [monad (#+ do)]]
    [control
+    [pipe (#+ case>)]
     ["." try]
     ["." exception]
     ["<>" parser]]
@@ -15,7 +17,8 @@
     ["." bit]
     ["." name]
     ["." text ("#@." equivalence)
-     ["." encoding]]
+     ["." encoding]
+     ["%" format (#+ format)]]
     ["." format #_
      ["#" binary]]
     [number
@@ -46,10 +49,25 @@
 
 (def: segment-size 10)
 
+(def: (utf8-conversion-does-not-alter? value)
+  (Predicate Text)
+  (|> value
+      encoding.to-utf8
+      encoding.from-utf8
+      (case> (#try.Success converted)
+             (text@= value converted)
+             
+             (#try.Failure error)
+             false)))
+
+(def: random-text
+  (Random Text)
+  (random.filter ..utf8-conversion-does-not-alter?
+                 (random.unicode ..segment-size)))
+
 (def: random-name
   (Random Name)
-  (random.and (random.unicode ..segment-size)
-              (random.unicode ..segment-size)))
+  (random.and ..random-text ..random-text))
 
 (structure: cursor-equivalence
   (Equivalence Cursor)
@@ -63,7 +81,7 @@
 (def: random-cursor
   (Random Cursor)
   ($_ random.and
-      (random.unicode ..segment-size)
+      ..random-text
       random.nat
       random.nat))
 
@@ -83,7 +101,7 @@
                   random.int
                   random.rev
                   random.frac
-                  (random.unicode ..segment-size)
+                  ..random-text
                   ..random-name
                   ..random-name
                   random-sequence
@@ -186,7 +204,8 @@
                 [(do {@ random.monad}
                    [expected <random>]
                    (_.cover [<parser>]
-                            (|> (format.run <format> expected)
+                            (|> expected
+                                (format.run <format>)
                                 (/.run <parser>)
                                 (!expect (^multi (#try.Success actual)
                                                  (:: <equivalence> = expected actual))))))]
@@ -195,8 +214,7 @@
                 [/.nat format.nat random.nat n.equivalence]
                 [/.int format.int random.int int.equivalence]
                 [/.rev format.rev random.rev rev.equivalence]
-                [/.frac format.frac random.frac frac.equivalence]
-                ))
+                [/.frac format.frac random.frac frac.equivalence]))
           (do {@ random.monad}
             [expected (:: @ map (|>> (i64.and (i64.mask /.size/8))
                                      (n.max 2))
@@ -216,7 +234,8 @@
                 [(do {@ random.monad}
                    [expected <random>]
                    (_.cover [<parser>]
-                            (|> (format.run <format> expected)
+                            (|> expected
+                                (format.run <format>)
                                 (/.run <parser>)
                                 (!expect (^multi (#try.Success actual)
                                                  (:: <equivalence> = expected actual))))))]
@@ -229,7 +248,8 @@
                 [(do {@ random.monad}
                    [expected <random>]
                    (_.cover [<cover>]
-                            (|> (format.run <format> expected)
+                            (|> expected
+                                (format.run <format>)
                                 (/.run <parser>)
                                 (!expect (^multi (#try.Success actual)
                                                  (:: <equivalence> = expected actual))))))]
@@ -237,8 +257,7 @@
                 [/.maybe (/.maybe /.nat) (format.maybe format.nat) (random.maybe random.nat) (maybe.equivalence n.equivalence)]
                 [/.list (/.list /.nat) (format.list format.nat) (random.list ..segment-size random.nat) (list.equivalence n.equivalence)]
                 [/.set (/.set n.hash /.nat) (format.set format.nat) (random.set n.hash ..segment-size random.nat) set.equivalence]
-                [/.name /.name format.name ..random-name name.equivalence]
-                ))
+                [/.name /.name format.name ..random-name name.equivalence]))
           (do {@ random.monad}
             [expected (:: @ map (list.repeat ..segment-size) random.nat)]
             (_.cover [/.set-elements-are-not-unique]
diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux
index 0e6f0ea01..37a629596 100644
--- a/stdlib/source/test/lux/locale.lux
+++ b/stdlib/source/test/lux/locale.lux
@@ -1,13 +1,78 @@
 (.module:
   [lux #*
-   ["_" test (#+ Test)]]
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]]}]
+   [math
+    ["." random (#+ Random) ("#@." monad)]]
+   [data
+    ["." text ("#@." equivalence)
+     ["." encoding (#+ Encoding)]]
+    [collection
+     ["." list]]]]
   ["." / #_
    ["#." language]
-   ["#." territory]])
+   ["#." territory]]
+  {1
+   ["." /
+    ["." language (#+ Language)]
+    ["." territory (#+ Territory)]]})
+
+(def: random-language
+  (Random Language)
+  (random.either (random@wrap language.afar)
+                 (random@wrap language.zaza)))
+
+(def: random-territory
+  (Random Territory)
+  (random.either (random@wrap territory.afghanistan)
+                 (random@wrap territory.zimbabwe)))
+
+(def: random-encoding
+  (Random Encoding)
+  (random.either (random@wrap encoding.ascii)
+                 (random@wrap encoding.koi8-u)))
+
+(def: random-locale
+  (Random /.Locale)
+  (do random.monad
+    [language ..random-language
+     territory ..random-territory
+     encoding ..random-encoding]
+    (wrap (/.locale language (#.Some territory) (#.Some encoding)))))
 
 (def: #export test
   Test
-  ($_ _.and
-      /language.test
-      /territory.test
-      ))
+  (<| (_.covering /._)
+      (_.with-cover [/.Locale])
+      ($_ _.and
+          (_.with-cover [/.equivalence]
+            ($equivalence.spec /.equivalence ..random-locale))
+          
+          (do random.monad
+            [language ..random-language
+             territory ..random-territory
+             encoding ..random-encoding
+             #let [l-locale (/.locale language #.None #.None)
+                   lt-locale (/.locale language (#.Some territory) #.None)
+                   le-locale (/.locale language #.None (#.Some encoding))
+                   lte-locale (/.locale language (#.Some territory) (#.Some encoding))]
+             #let [language-check (and (text@= (language.code language)
+                                               (/.code l-locale))
+                                       (list.every? (|>> /.code (text.starts-with? (language.code language)))
+                                                    (list lt-locale le-locale lte-locale)))
+                   territory-check (list.every? (|>> /.code (text.contains? (territory.long-code territory)))
+                                                (list lt-locale lte-locale))
+                   encoding-check (list.every? (|>> /.code (text.ends-with? (encoding.name encoding)))
+                                               (list le-locale lte-locale))]]
+            (_.cover [/.locale /.code]
+                     (and language-check
+                          territory-check
+                          encoding-check)))
+          
+          /language.test
+          /territory.test
+          )))