Full implementation of console for Node.js.

4 files changed, 374 insertions, 70 deletions

diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux
index 99db7ef1a..6dc3eabd9 100644
--- a/stdlib/source/test/lux/tool.lux
+++ b/stdlib/source/test/lux/tool.lux
@@ -22,6 +22,7 @@
       ]]]
    ["[1][0]" meta "_"
     ["[1]/[0]" archive "_"
+     ["[1]/[0]" artifact]
      ["[1]/[0]" signature]
      ["[1]/[0]" key]
      ["[1]/[0]" document]]]
@@ -37,6 +38,7 @@
       /analysis/simple.test
       /analysis/composite.test
       /analysis/pattern.test
+      /meta/archive/artifact.test
       /meta/archive/signature.test
       /meta/archive/key.test
       /meta/archive/document.test
diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux
new file mode 100644
index 000000000..b241b0c46
--- /dev/null
+++ b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux
@@ -0,0 +1,48 @@
+(.using
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [\\specification
+     ["$[0]" equivalence]]]
+   [math
+    ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]]
+ [\\library
+  ["[0]" /]])
+
+(def: random_category
+  (Random /.Category)
+  ($_ random.or
+      (random#in [])
+      (random.ascii/lower 1)
+      (random.ascii/lower 2)
+      (random.ascii/lower 3)
+      (random.ascii/lower 4)
+      (random.ascii/lower 5)
+      (random.ascii/lower 6)
+      ))
+
+(def: random_dependency
+  (Random /.Dependency)
+  ($_ random.and
+      random.nat
+      random.nat
+      ))
+
+(def: .public random
+  (Random /.Artifact)
+  ($_ random.and
+      random.nat
+      ..random_category
+      random.bit
+      (random.set /.dependency_hash 5 ..random_dependency)
+      ))
+
+(def: .public test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Artifact /.ID])
+      ($_ _.and
+          (_.for [/.equivalence]
+                 ($equivalence.spec /.equivalence ..random))
+          )))
diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux
index 39e8d13dd..ee313599f 100644
--- a/stdlib/source/test/lux/world/file.lux
+++ b/stdlib/source/test/lux/world/file.lux
@@ -1,19 +1,239 @@
 (.using
-  [library
-   [lux "*"
-    ["_" test {"+" Test}]
-    [abstract
-     [monad {"+" do}]]
-    [control
-     ["[0]" io]]
-    [math
-     ["[0]" random]]]]
-  ["[0]" / "_"
-   ["[1][0]" watch]]
-  [\\library
-   ["[0]" /]]
-  [\\specification
-   ["$[0]" /]])
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    ["[0]" monad {"+" do}]]
+   [control
+    ["[0]" io {"+" IO}]
+    ["[0]" try {"+" Try}]
+    [concurrency
+     [async {"+" Async}]
+     ["[0]" atom {"+" Atom}]]]
+   [data
+    ["[0]" binary {"+" Binary} ("[1]#[0]" monoid)]
+    ["[0]" text ("[1]#[0]" equivalence)]
+    [collection
+     ["[0]" dictionary {"+" Dictionary}]
+     ["[0]" list]]]
+   [math
+    ["[0]" random]]
+   [time
+    ["[0]" instant {"+" Instant}]]]]
+ ["[0]" / "_"
+  ["[1][0]" watch]]
+ [\\library
+  ["[0]" /]]
+ [\\specification
+  ["$[0]" /]])
+
+(type: Disk
+  (Dictionary /.Path (Either [Instant Binary] (List Text))))
+
+(def: (file? disk @)
+  (-> (Atom Disk) (-> /.Path (IO Bit)))
+  (do io.monad
+    [disk (atom.read! disk)]
+    (in (case (dictionary.value @ disk)
+          {.#None} false
+          {.#Some {.#Left _}} true
+          {.#Some {.#Right _}} false))))
+
+(def: (directory? disk @)
+  (-> (Atom Disk) (-> /.Path (IO Bit)))
+  (do io.monad
+    [disk (atom.read! disk)]
+    (in (case (dictionary.value @ disk)
+          {.#None} false
+          {.#Some {.#Left _}} false
+          {.#Some {.#Right _}} true))))
+
+(def: (alert_parent! disk alert @)
+  (-> (Atom Disk)
+      (-> (List /.Path) (List /.Path))
+      (-> /.Path (IO (Try Any))))
+  (do [! io.monad]
+    [disk' (atom.read! disk)]
+    (case (dictionary.value @ disk')
+      {.#Some {.#Right siblings}}
+      (do !
+        [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Right (alert siblings)} disk') disk)]
+        (in {try.#Success []}))
+
+      _
+      (in {try.#Failure ""}))))
+
+(def: (write fs disk it @)
+  (-> (/.System Async) (Atom Disk) (-> Binary /.Path (IO (Try Any))))
+  (do [! io.monad]
+    [now instant.now
+     disk' (atom.read! disk)]
+    (case (dictionary.value @ disk')
+      (^or {.#None}
+           {.#Some {.#Left _}})
+      (do !
+        [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Left [now it]} disk') disk)]
+        (case (/.parent fs @)
+          {.#Some parent}
+          (alert_parent! disk (|>> (list& @)) parent)
+
+          {.#None}
+          (in {try.#Success []})))
+
+      _
+      (in {try.#Failure ""}))))
+
+(def: (read disk @)
+  (-> (Atom Disk) (-> /.Path (IO (Try Binary))))
+  (do io.monad
+    [disk (atom.read! disk)]
+    (in (case (dictionary.value @ disk)
+          {.#Some {.#Left [_ it]}}
+          {try.#Success it}
+
+          _
+          {try.#Failure ""}))))
+
+(def: (delete fs disk @)
+  (-> (/.System Async) (Atom Disk)
+      (-> /.Path (IO (Try Any))))
+  (do [! io.monad]
+    [disk' (atom.read! disk)]
+    (case (dictionary.value @ disk')
+      {.#Some {.#Right children}}
+      (if (list.empty? children)
+        (do !
+          [_ (atom.compare_and_swap! disk' (dictionary.lacks @ disk') disk)]
+          (in {try.#Success []}))
+        (in {try.#Failure ""}))
+      
+      {.#Some {.#Left [_ data]}}
+      (do !
+        [_ (atom.compare_and_swap! disk' (dictionary.lacks @ disk') disk)]
+        (case (/.parent fs @)
+          {.#Some parent}
+          (alert_parent! disk (list.only (|>> (text#= @) not)) parent)
+
+          {.#None}
+          (in {try.#Success []})))
+
+      _
+      (in {try.#Failure ""}))))
+
+(def: (fs /)
+  (-> Text (/.System IO))
+  (let [disk (: (Atom Disk)
+                (atom.atom (dictionary.empty text.hash)))
+        mock (/.mock /)]
+    (implementation
+     (def: separator /)
+
+     (def: file? (..file? disk))
+     (def: directory? (..directory? disk))
+     (def: write (..write mock disk))
+     (def: read (..read disk))
+     (def: delete (..delete mock disk))
+
+     (def: (file_size @)
+       (do [! io.monad]
+         [disk (atom.read! disk)]
+         (in (case (dictionary.value @ disk)
+               {.#Some {.#Left [_ it]}}
+               {try.#Success (binary.size it)}
+
+               _
+               {try.#Failure ""}))))
+     (def: (last_modified @)
+       (do [! io.monad]
+         [disk (atom.read! disk)]
+         (in (case (dictionary.value @ disk)
+               {.#Some {.#Left [it _]}}
+               {try.#Success it}
+
+               _
+               {try.#Failure ""}))))
+     (def: (can_execute? @)
+       (do [! io.monad]
+         [disk (atom.read! disk)]
+         (in (case (dictionary.value @ disk)
+               {.#Some {.#Left _}}
+               {try.#Success false}
+
+               _
+               {try.#Failure ""}))))
+
+     (def: (make_directory @)
+       (do [! io.monad]
+         [disk' (atom.read! disk)]
+         (case (dictionary.value @ disk')
+           {.#None}
+           (do !
+             [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Right (list)} disk') disk)]
+             (case (/.parent mock @)
+               {.#Some parent}
+               (alert_parent! disk (|>> (list& @)) parent)
+
+               {.#None}
+               (in {try.#Success []})))
+
+           _
+           (in {try.#Failure ""}))))
+     (def: (directory_files @)
+       (do [! io.monad]
+         [disk' (atom.read! disk)]
+         (case (dictionary.value @ disk')
+           {.#Some {.#Right children}}
+           (|> children
+               (monad.only ! (..file? disk))
+               (# ! each (|>> {try.#Success})))
+
+           _
+           (in {try.#Failure ""}))))
+     (def: (sub_directories @)
+       (do [! io.monad]
+         [disk' (atom.read! disk)]
+         (case (dictionary.value @ disk')
+           {.#Some {.#Right children}}
+           (|> children
+               (monad.only ! (..directory? disk))
+               (# ! each (|>> {try.#Success})))
+
+           _
+           (in {try.#Failure ""}))))
+     (def: (append it @)
+       (do [! io.monad]
+         [now instant.now
+          disk' (atom.read! disk)]
+         (case (dictionary.value @ disk')
+           {.#None}
+           (..write mock disk it @)
+           
+           {.#Some {.#Left [_ old]}}
+           (do !
+             [_ (atom.compare_and_swap! disk'
+                                        (dictionary.has @ {.#Left [now (binary#composite old it)]} disk')
+                                        disk)]
+             (in {try.#Success []}))
+
+           _
+           (in {try.#Failure ""}))))
+     (def: (modify it @)
+       (do [! io.monad]
+         [disk' (atom.read! disk)]
+         (case (dictionary.value @ disk')
+           {.#Some {.#Left [_ data]}}
+           (do !
+             [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Left [it data]} disk') disk)]
+             (in {try.#Success []}))
+
+           _
+           (in {try.#Failure ""}))))
+     (def: (move it @)
+       (do [! (try.with io.monad)]
+         [data (..read disk @)
+          write (..write mock disk data it)]
+         (..delete mock disk @)))
+     )))
 
 (def: .public test
   Test
@@ -23,6 +243,8 @@
         ($_ _.and
             (_.for [/.mock]
                    ($/.spec (io.io (/.mock /))))
+            (_.for [/.async]
+                   ($/.spec (io.io (/.async (..fs /)))))
             
             /watch.test
             ))))
diff --git a/stdlib/source/test/lux/world/net/http/client.lux b/stdlib/source/test/lux/world/net/http/client.lux
index 474d1ea08..fdc32834b 100644
--- a/stdlib/source/test/lux/world/net/http/client.lux
+++ b/stdlib/source/test/lux/world/net/http/client.lux
@@ -1,31 +1,55 @@
 (.using
-  [library
-   [lux "*"
-    ["_" test {"+" Test}]
-    [abstract
-     [monad {"+" do}]]
-    [control
-     [pipe {"+" do>}]
-     ["[0]" io {"+" IO}]
-     ["[0]" try]
-     ["[0]" function]]
-    [data
-     ["[0]" binary]
-     ["[0]" product]
-     ["[0]" text
-      ["%" format {"+" format}]
-      [encoding
-       ["[0]" utf8]]]
-     [collection
-      ["[0]" dictionary]]]
-    [math
-     ["[0]" random {"+" Random}]
-     [number
-      ["[0]" nat]]]]]
-  [\\library
-   ["[0]" /
-    ["/[1]" //
-     ["[1][0]" status]]]])
+ [library
+  [lux "*"
+   ["_" test {"+" Test}]
+   [abstract
+    [monad {"+" Monad do}]]
+   [control
+    [pipe {"+" do>}]
+    ["[0]" io {"+" IO}]
+    ["[0]" try {"+" Try}]
+    ["[0]" function]
+    [concurrency
+     ["[0]" async ("[1]#[0]" functor)]]]
+   [data
+    ["[0]" binary]
+    ["[0]" product]
+    ["[0]" text
+     ["%" format {"+" format}]
+     [encoding
+      ["[0]" utf8]]]
+    [collection
+     ["[0]" dictionary]]]
+   [math
+    ["[0]" random {"+" Random}]
+    [number
+     ["[0]" nat]]]]]
+ [\\library
+  ["[0]" /
+   ["/[1]" //
+    ["[1][0]" status]]]])
+
+(def: (verification ! expected response)
+  (All (_ !)
+    (-> (Monad !) Nat (! (Try (//.Response !)))
+        (! Bit)))
+  (do !
+    [response response]
+    (case response
+      {try.#Success response}
+      (|> response
+          product.right
+          (value@ //.#body)
+          (function.on {.#None})
+          (# ! each (|>> (do> try.monad
+                              []
+                              [product.right (# utf8.codec decoded)]
+                              [(# nat.decimal decoded)]
+                              [(nat.= expected) in])
+                         (try.else false))))
+      
+      {try.#Failure error}
+      (in false))))
 
 (def: .public test
   Test
@@ -64,32 +88,40 @@
                                                    //.#body (function (_ ?wanted_bytes)
                                                               (io.io {try.#Success [(binary.size data)
                                                                                     data]}))]]})))))]]
-        (`` ($_ _.and
-                (~~ (template [<definition> <expected>]
-                      [(_.cover [<definition>]
-                                (|> (<definition> "" //.empty {.#None} mock)
-                                    (do> try.monad
-                                         [io.run!]
-                                         [product.right (value@ //.#body) (function.on {.#None}) io.run!]
-                                         [product.right (# utf8.codec decoded)]
-                                         [(# nat.decimal decoded)]
-                                         [(nat.= <expected>) in])
-                                    (try.else false)))]
+        (with_expansions [<cases> (as_is [/.post on_post]
+                                         [/.get on_get]
+                                         [/.put on_put]
+                                         [/.patch on_patch]
+                                         [/.delete on_delete]
+                                         [/.head on_head]
+                                         [/.connect on_connect]
+                                         [/.options on_options]
+                                         [/.trace on_trace])]
+          (`` ($_ _.and
+                  (~~ (template [<definition> <expected>]
+                        [(_.cover [<definition>]
+                                  (|> (<definition> "" //.empty {.#None} mock)
+                                      (verification io.monad <expected>)
+                                      io.run!))]
+
+                        <cases>
+                        ))
+                  (_.cover [/.headers]
+                           (nat.= (dictionary.size headers)
+                                  (|> headers
+                                      dictionary.entries
+                                      /.headers
+                                      dictionary.size)))
+                  (in (do [! async.monad]
+                        [.let [mock (/.async mock)]
+                         (~~ (template [<definition> <expected>]
+                               [<expected> (|> (<definition> "" //.empty {.#None} mock)
+                                               (verification ! <expected>))]
+
+                               <cases>))]
+                        (_.cover' [/.async]
+                                  (and (~~ (template [<definition> <expected>]
+                                             [<expected>]
 
-                      [/.post on_post]
-                      [/.get on_get]
-                      [/.put on_put]
-                      [/.patch on_patch]
-                      [/.delete on_delete]
-                      [/.head on_head]
-                      [/.connect on_connect]
-                      [/.options on_options]
-                      [/.trace on_trace]
-                      ))
-                (_.cover [/.headers]
-                         (nat.= (dictionary.size headers)
-                                (|> headers
-                                    dictionary.entries
-                                    /.headers
-                                    dictionary.size)))
-                )))))
+                                             <cases>))))))
+                  ))))))