Re-named Promise to Async.

1 files changed, 176 insertions, 0 deletions

diff --git a/stdlib/source/test/lux/control/concurrency/async.lux b/stdlib/source/test/lux/control/concurrency/async.lux
new file mode 100644
index 000000000..1c7d075f4
--- /dev/null
+++ b/stdlib/source/test/lux/control/concurrency/async.lux
@@ -0,0 +1,176 @@
+(.module:
+  [library
+   [lux #*
+    ["_" test (#+ Test)]
+    ["@" target]
+    [abstract
+     [monad (#+ do)]
+     [\\specification
+      ["$." functor (#+ Injection Comparison)]
+      ["$." apply]
+      ["$." monad]]]
+    [control
+     [pipe (#+ case>)]
+     ["." io]]
+    [time
+     ["." instant]
+     ["." duration]]
+    [math
+     ["." random]
+     [number
+      ["n" nat]
+      ["i" int]
+      ["." i64]]]]]
+  [\\library
+   ["." /
+    [//
+     ["." atom (#+ Atom)]]]])
+
+(def: injection
+  (Injection /.Async)
+  /.resolved)
+
+(def: comparison
+  (Comparison /.Async)
+  (function (_ == left right)
+    (io.run
+     (do io.monad
+       [?left (/.poll left)
+        ?right (/.poll right)]
+       (wrap (case [?left ?right]
+               [(#.Some left)
+                (#.Some right)]
+               (== left right)
+               
+               _
+               false))))))
+
+(def: delay
+  (for {@.js
+        (i64.left_shift 4 1)}
+       (i64.left_shift 3 1)))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (do {! random.monad}
+        [to_wait (|> random.nat (\ ! map (|>> (n.% ..delay) (n.+ ..delay))))
+         expected random.nat
+         dummy random.nat
+         #let [not_dummy (|> random.nat (random.only (|>> (n.= dummy) not)))]
+         leftE not_dummy
+         rightE not_dummy]
+        ($_ _.and
+            (_.for [/.functor]
+                   ($functor.spec ..injection ..comparison /.functor))
+            (_.for [/.apply]
+                   ($apply.spec ..injection ..comparison /.apply))
+            (_.for [/.monad]
+                   ($monad.spec ..injection ..comparison /.monad))
+            
+            (wrap (do /.monad
+                    [#let [[async resolver] (: [(/.Async Nat) (/.Resolver Nat)]
+                                               (/.async []))]
+                     resolved? (/.future (resolver expected))
+                     actual async]
+                    (_.cover' [/.Async /.Resolver /.async]
+                              (and resolved?
+                                   (n.= expected actual)))))
+            (wrap (do /.monad
+                    [actual (/.resolved expected)]
+                    (_.cover' [/.resolved]
+                              (n.= expected actual))))
+            (wrap (do /.monad
+                    [actual (/.future (io.io expected))]
+                    (_.cover' [/.future]
+                              (n.= expected actual))))
+            (wrap (do /.monad
+                    [pre (/.future instant.now)
+                     actual (/.schedule to_wait (io.io expected))
+                     post (/.future instant.now)]
+                    (_.cover' [/.schedule]
+                              (and (n.= expected actual)
+                                   (i.>= (.int to_wait)
+                                         (duration.to_millis (instant.span pre post)))))))
+            (wrap (do /.monad
+                    [pre (/.future instant.now)
+                     _ (/.wait to_wait)
+                     post (/.future instant.now)]
+                    (_.cover' [/.wait]
+                              (i.>= (.int to_wait)
+                                    (duration.to_millis (instant.span pre post))))))
+            (wrap (do /.monad
+                    [[leftA rightA] (/.and (/.future (io.io leftE))
+                                           (/.future (io.io rightE)))]
+                    (_.cover' [/.and]
+                              (n.= (n.+ leftE rightE)
+                                   (n.+ leftA rightA)))))
+            (wrap (do /.monad
+                    [pre (/.future instant.now)
+                     actual (/.delay to_wait expected)
+                     post (/.future instant.now)]
+                    (_.cover' [/.delay]
+                              (and (n.= expected actual)
+                                   (i.>= (.int to_wait)
+                                         (duration.to_millis (instant.span pre post)))))))
+            (wrap (do /.monad
+                    [?left (/.or (wrap leftE)
+                                 (/.delay to_wait dummy))
+                     ?right (/.or (/.delay to_wait dummy)
+                                  (wrap rightE))]
+                    (_.cover' [/.or]
+                              (case [?left ?right]
+                                [(#.Left leftA) (#.Right rightA)]
+                                (n.= (n.+ leftE rightE)
+                                     (n.+ leftA rightA))
+
+                                _
+                                false))))
+            (wrap (do /.monad
+                    [leftA (/.either (wrap leftE)
+                                     (/.delay to_wait dummy))
+                     rightA (/.either (/.delay to_wait dummy)
+                                      (wrap rightE))]
+                    (_.cover' [/.either]
+                              (n.= (n.+ leftE rightE)
+                                   (n.+ leftA rightA)))))
+            (wrap (do /.monad
+                    [?actual (/.future (/.poll (/.resolved expected)))
+                     #let [[async resolver] (: [(/.Async Nat) (/.Resolver Nat)]
+                                               (/.async []))]
+                     ?never (/.future (/.poll async))]
+                    (_.cover' [/.poll]
+                              (case [?actual ?never]
+                                [(#.Some actual) #.None]
+                                (n.= expected actual)
+
+                                _
+                                false))))
+            (wrap (do /.monad
+                    [yep (/.future (/.resolved? (/.resolved expected)))
+                     #let [[async resolver] (: [(/.Async Nat) (/.Resolver Nat)]
+                                               (/.async []))]
+                     nope (/.future (/.resolved? async))]
+                    (_.cover' [/.resolved?]
+                              (and yep
+                                   (not nope)))))
+            (wrap (do /.monad
+                    [?none (/.time_out 0 (/.delay to_wait dummy))
+                     ?actual (/.time_out to_wait (wrap expected))]
+                    (_.cover' [/.time_out]
+                              (case [?none ?actual]
+                                [#.None (#.Some actual)]
+                                (n.= expected actual)
+
+                                _
+                                false))))
+            (wrap (do /.monad
+                    [#let [box (: (Atom Nat)
+                                  (atom.atom dummy))]
+                     _ (/.future (/.await (function (_ value)
+                                            (atom.write value box))
+                                          (/.resolved expected)))
+                     actual (/.future (atom.read box))]
+                    (_.cover' [/.await]
+                              (n.= expected actual))))
+            ))))