Improved error reporting for syntax macros.

4 files changed, 99 insertions, 5 deletions

diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux
index 0dde0402a..1edfb381f 100644
--- a/stdlib/source/test/aedifex/cli.lux
+++ b/stdlib/source/test/aedifex/cli.lux
@@ -18,8 +18,8 @@
   {#program
    ["." /
     ["/#" // #_
-     ["#" profile]
-     [upload (#+ User Password)]]]})
+     [repository (#+ User Password)]
+     ["#" profile]]]})
 
 (def: compilation
   (Random /.Compilation)
diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux
index e26240562..12fa349bb 100644
--- a/stdlib/source/test/aedifex/parser.lux
+++ b/stdlib/source/test/aedifex/parser.lux
@@ -29,7 +29,7 @@
      ["#" profile]
      ["#." project (#+ Project)]
      ["#." artifact (#+ Artifact)]
-     ["#." dependency (#+ Repository Dependency)]
+     ["#." dependency (#+ Dependency)]
      ["#." format]]]})
 
 (def: name
diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux
index d0da1ff2a..10d921f94 100644
--- a/stdlib/source/test/aedifex/profile.lux
+++ b/stdlib/source/test/aedifex/profile.lux
@@ -28,7 +28,8 @@
   {#program
    ["." /
     ["/#" // #_
-     ["#." dependency (#+ Repository Dependency)]
+     [repository (#+ Address)]
+     ["#." dependency (#+ Dependency)]
      ["#." format]]]})
 
 (def: distribution
@@ -103,7 +104,7 @@
   (random.ascii/alpha 1))
 
 (def: repository
-  (Random Repository)
+  (Random Address)
   (random.ascii/alpha 1))
 
 (def: source
diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux
new file mode 100644
index 000000000..4f96d9329
--- /dev/null
+++ b/stdlib/source/test/aedifex/repository.lux
@@ -0,0 +1,93 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    ["." hash (#+ Hash)]
+    ["." equivalence (#+ Equivalence)]
+    ["." monad (#+ do)]]
+   [control
+    ["." io]
+    ["." try]
+    ["." exception (#+ exception:)]]
+   [data
+    ["." binary (#+ Binary)]
+    ["." text
+     ["%" format (#+ format)]]
+    [collection
+     ["." dictionary (#+ Dictionary)]]]
+   [math
+    ["." random (#+ Random)]]]
+  [//
+   ["@." artifact]]
+  {#spec
+   ["$." /]}
+  {#program
+   ["." / (#+ Identity)
+    ["/#" // #_
+     ["#." artifact (#+ Version Artifact)
+      ["#/." extension (#+ Extension)]]]]})
+
+(def: identity
+  (Random Identity)
+  (random.and (random.ascii/alpha 10)
+              (random.ascii/alpha 10)))
+
+(def: identity-equivalence
+  (Equivalence Identity)
+  (equivalence.product text.equivalence
+                       text.equivalence))
+
+(def: artifact
+  (-> Version Artifact)
+  (|>> ["com.github.luxlang" "test-artifact"]))
+
+(def: item-hash
+  (Hash [Artifact Extension])
+  (hash.product //artifact.hash
+                text.hash))
+
+(exception: (not-found {artifact Artifact}
+                       {extension Extension})
+  (exception.report
+   ["Artifact" (//artifact.format artifact)]
+   ["Extension" (%.text extension)]))
+
+(exception: (invalid-identity {[user _] Identity})
+  (exception.report
+   ["User" (%.text user)]))
+
+(type: Store
+  (Dictionary [Artifact Extension] Binary))
+
+(def: empty
+  Store
+  (dictionary.new ..item-hash))
+
+(structure: (simulation identity)
+  (-> Identity (/.Simulation Store))
+
+  (def: (on-download artifact extension state)
+    (case (dictionary.get [artifact extension] state)
+      (#.Some content)
+      (exception.return [state content])
+      
+      #.None
+      (exception.throw ..not-found [artifact extension])))
+  (def: (on-upload requester artifact extension content state)
+    (if (:: identity-equivalence = identity requester)
+      (exception.return (dictionary.put [artifact extension] content state))
+      (exception.throw ..invalid-identity [requester]))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (do {! random.monad}
+        [valid ..identity
+         invalid (random.filter (|>> (:: identity-equivalence = valid) not)
+                                ..identity)]
+        ($_ _.and
+            (_.with-cover [/.mock /.Simulation]
+              ($/.spec valid (..artifact "1.2.3-YES")
+                       invalid (..artifact "4.5.6-NO")
+                       (/.mock (..simulation valid) ..empty)))
+            ))))