Add local repo installation to Aedifex.

5 files changed, 133 insertions, 48 deletions

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