From a40f40f230e6312ae432f06e7f73aa5945d8fa49 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 18 Jul 2021 23:10:18 -0400
Subject: New JVM compiler can now compile JVM interfaces.

---
 stdlib/source/test/aedifex/metadata/artifact.lux | 84 ++++++++++++++++++------
 1 file changed, 65 insertions(+), 19 deletions(-)

(limited to 'stdlib/source/test/aedifex/metadata/artifact.lux')

diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux
index 5e5f67bec..5ba4bdbe4 100644
--- a/stdlib/source/test/aedifex/metadata/artifact.lux
+++ b/stdlib/source/test/aedifex/metadata/artifact.lux
@@ -9,8 +9,19 @@
     [control
      ["." try ("#\." functor)]
      [parser
-      ["<.>" xml]]]
+      ["." environment]
+      ["<.>" xml]]
+     [concurrency
+      ["." promise]]]
+    [data
+     ["." maybe]
+     ["." text ("#\." equivalence)]
+     [collection
+      ["." list]]]
+    [macro
+     ["." code]]
     [math
+     ["." random (#+ Random)]
      [number
       ["n" nat]]]
     ["." time
@@ -19,12 +30,16 @@
      ["." month]
      ["." instant]
      ["." duration]]
-    [math
-     ["." random (#+ Random)]]
-    [macro
-     ["." code]]]]
+    [world
+     ["." file]
+     ["." program]]]]
   [\\program
-   ["." /]])
+   ["." /
+    ["/#" //
+     ["/#" // #_
+      ["#." artifact]
+      ["#." repository #_
+       ["#/." local]]]]]])
 
 (def: #export random
   (Random /.Metadata)
@@ -55,16 +70,47 @@
   Test
   (<| (_.covering /._)
       (_.for [/.Metadata])
-      ($_ _.and
-          (_.for [/.equivalence]
-                 ($equivalence.spec /.equivalence ..random))
-          (do random.monad
-            [expected ..random]
-            (_.cover [/.format /.parser]
-                     (|> expected
-                         /.format
-                         list
-                         (<xml>.run /.parser)
-                         (try\map (\ /.equivalence = expected))
-                         (try.default false))))
-          )))
+      (do random.monad
+        [expected ..random
+         #let [artifact {#///artifact.group (get@ #/.group expected)
+                         #///artifact.name (get@ #/.name expected)
+                         #///artifact.version (|> expected
+                                                  (get@ #/.versions)
+                                                  list.head
+                                                  (maybe.default ""))}]]
+        ($_ _.and
+            (_.for [/.equivalence]
+                   ($equivalence.spec /.equivalence ..random))
+            
+            (do random.monad
+              [expected ..random]
+              (_.cover [/.format /.parser]
+                       (|> expected
+                           /.format
+                           list
+                           (<xml>.run /.parser)
+                           (try\map (\ /.equivalence = expected))
+                           (try.default false))))
+            (_.cover [/.uri]
+                     (text\= (//.remote_project_uri artifact)
+                             (/.uri artifact)))
+            (do random.monad
+              [home (random.ascii/lower 5)
+               working_directory (random.ascii/lower 5)
+               #let [program (program.async (program.mock environment.empty home working_directory))
+                     fs (file.mock (\ file.default separator))
+                     repository (///repository/local.repository program fs)]]
+              (wrap (do promise.monad
+                      [wrote? (/.write repository artifact expected)
+                       actual (/.read repository artifact)]
+                      (_.cover' [/.write /.read]
+                                (and (case wrote?
+                                       (#try.Success _) true
+                                       (#try.Failure _) false)
+                                     (case actual
+                                       (#try.Success actual)
+                                       (\ /.equivalence = expected actual)
+                                       
+                                       (#try.Failure _)
+                                       false))))))
+            ))))
-- 
cgit v1.2.3