Improved error reporting for syntax macros.

9 files changed, 110 insertions, 28 deletions

diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
index 9d73f9181..efc261189 100644
--- a/stdlib/source/program/aedifex/cli.lux
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -8,7 +8,7 @@
    [data
     ["." text]]]
   [//
-   [upload (#+ User Password)]
+   [repository (#+ User Password)]
    ["/" profile (#+ Name)]])
 
 (type: #export Compilation
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index 3041c53f1..aa48946bf 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -25,18 +25,19 @@
     ["." export]]]
   ["." /// #_
    ["/" profile (#+ Profile)]
-   ["//" upload (#+ User Password)]
+   ["//" upload]
    ["#." action (#+ Action)]
    ["#." command (#+ Command)]
    ["#." pom]
    ["#." hash]
+   ["#." repository (#+ User Password)]
    ["#." artifact
     ["#/." type]]
    ["#." dependency
     ["#/." resolution]]])
 
 (exception: #export (cannot-find-repository {repository Text}
-                                            {options (Dictionary Text ///dependency.Repository)})
+                                            {options (Dictionary Text ///repository.Address)})
   (exception.report
    ["Repository" (%.text repository)]
    ["Options" (exception.enumerate (function (_ [name repo])
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
index cdd0789ff..629618620 100644
--- a/stdlib/source/program/aedifex/dependency.lux
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -11,9 +11,6 @@
    ["#." artifact (#+ Artifact)
     [type (#+ Type)]]])
 
-(type: #export Repository
-  URL)
-
 (type: #export Dependency
   {#artifact Artifact
    #type Type})
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index 10874cbfc..2c6a9b5e6 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -29,9 +29,10 @@
    [world
     [net (#+ URL)
      ["." uri]]]]
-  ["." // (#+ Repository Dependency)
+  ["." // (#+ Dependency)
    ["/#" // #_
     ["/" profile]
+    ["#." repository (#+ Address)]
     ["#." hash]
     ["#." pom]
     ["#." package (#+ Package)]
@@ -109,7 +110,7 @@
           (wrap actual)))))
 
 (def: #export (resolve repository dependency)
-  (-> Repository Dependency (IO (Try Package)))
+  (-> Address Dependency (IO (Try Package)))
   (let [[artifact type] dependency
         prefix (format repository uri.separator (///artifact.uri artifact))]
     (do (try.with io.monad)
@@ -146,7 +147,7 @@
      ["Type" (%.text type)])))
 
 (def: (resolve-any repositories dependency)
-  (-> (List Repository) Dependency (IO (Try Package)))
+  (-> (List Address) Dependency (IO (Try Package)))
   (case repositories
     #.Nil
     (|> dependency
@@ -164,7 +165,7 @@
         (resolve-any alternatives dependency)))))
 
 (def: #export (resolve-all repositories dependencies resolution)
-  (-> (List Repository) (List Dependency) Resolution (IO (Try Resolution)))
+  (-> (List Address) (List Dependency) Resolution (IO (Try Resolution)))
   (case dependencies
     #.Nil
     (:: (try.with io.monad) wrap resolution)
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index 4fa6612c0..45e1e6a6a 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -21,6 +21,7 @@
    ["/" profile]
    ["#." project (#+ Project)]
    ["#." dependency]
+   ["#." repository]
    ["#." artifact (#+ Artifact)
     ["#/." type]]])
 
@@ -136,7 +137,7 @@
         )))
 
 (def: repository
-  (Parser //dependency.Repository)
+  (Parser //repository.Address)
   ..url)
 
 (def: type
@@ -164,7 +165,7 @@
   <c>.text)
 
 (def: deploy-repository
-  (Parser (List [Text //dependency.Repository]))
+  (Parser (List [Text //repository.Address]))
   (<c>.record (<>.some
                (<>.and <c>.text
                        ..repository))))
@@ -185,7 +186,7 @@
            ^info (: (Parser (Maybe /.Info))
                     (<>.maybe
                      (..singular input "info" ..info)))
-           ^repositories (: (Parser (Set //dependency.Repository))
+           ^repositories (: (Parser (Set //repository.Address))
                             (|> (..plural input "repositories" ..repository)
                                 (:: ! map (set.from-list text.hash))
                                 (<>.default (set.new text.hash))))
@@ -206,7 +207,7 @@
            ^test (: (Parser (Maybe Module))
                     (<>.maybe
                      (..singular input "test" ..module)))
-           ^deploy-repositories (: (Parser (Dictionary Text //dependency.Repository))
+           ^deploy-repositories (: (Parser (Dictionary Text //repository.Address))
                                    (<| (:: ! map (dictionary.from-list text.hash))
                                        (<>.default (list))
                                        (..singular input "deploy-repositories" ..deploy-repository)))]]
diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux
index 259a3f769..a310b2c48 100644
--- a/stdlib/source/program/aedifex/pom.lux
+++ b/stdlib/source/program/aedifex/pom.lux
@@ -19,7 +19,8 @@
      ["." dictionary]]]]
   ["." // #_
    ["/" profile]
-   ["#." dependency (#+ Repository Dependency)]
+   ["#." repository (#+ Address)]
+   ["#." dependency (#+ Dependency)]
    ["#." artifact (#+ Artifact)
     ["#/." type]]])
 
@@ -65,7 +66,7 @@
       (#_.Node ["" "license"] _.attrs)))
 
 (def: repository
-  (-> Repository XML)
+  (-> Address XML)
   (|>> (..property "url")
        list
        (#_.Node ["" "repository"] _.attrs)))
diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux
index 190ed3714..8b5ea26b6 100644
--- a/stdlib/source/program/aedifex/profile.lux
+++ b/stdlib/source/program/aedifex/profile.lux
@@ -22,7 +22,8 @@
        [descriptor (#+ Module)]]]]]]
   [//
    ["." artifact (#+ Artifact)]
-   ["." dependency]])
+   ["." dependency]
+   ["." repository]])
 
 (type: #export Distribution
   #Repo
@@ -140,13 +141,13 @@
   {#parents (List Name)
    #identity (Maybe Artifact)
    #info (Maybe Info)
-   #repositories (Set dependency.Repository)
+   #repositories (Set repository.Address)
    #dependencies (Set dependency.Dependency)
    #sources (Set Source)
    #target (Maybe Target)
    #program (Maybe Module)
    #test (Maybe Module)
-   #deploy-repositories (Dictionary Text dependency.Repository)})
+   #deploy-repositories (Dictionary Text repository.Address)})
 
 (def: #export equivalence
   (Equivalence Profile)
diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux
new file mode 100644
index 000000000..f92b1e5b9
--- /dev/null
+++ b/stdlib/source/program/aedifex/repository.lux
@@ -0,0 +1,85 @@
+(.module:
+  [lux #*
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." io (#+ IO)]
+    ["." try (#+ Try)]
+    [concurrency
+     ["." promise (#+ Promise)]
+     ["." stm]]]
+   [data
+    [binary (#+ Binary)]]
+   [world
+    [net (#+ URL)]]]
+  ["." // #_
+   ["#." artifact (#+ Artifact)
+    ["#/." extension (#+ Extension)]]])
+
+(type: #export Address
+  URL)
+
+(type: #export User
+  Text)
+
+(type: #export Password
+  Text)
+
+(type: #export Identity
+  {#user User
+   #password Password})
+
+(signature: #export (Repository !)
+  (: (-> Artifact Extension (! (Try Binary)))
+     download)
+  (: (-> Identity Artifact Extension Binary (! (Try Any)))
+     upload))
+
+(def: #export (async repository)
+  (-> (Repository IO) (Repository Promise))
+  (structure
+   (def: (download artifact extension)
+     (promise.future (:: repository download artifact extension)))
+
+   (def: (upload identity artifact extension content)
+     (promise.future (:: repository upload identity artifact extension content)))
+   ))
+
+(signature: #export (Simulation s)
+  (: (-> Artifact Extension s
+         (Try [s Binary]))
+     on-download)
+  (: (-> Identity Artifact Extension Binary s
+         (Try s))
+     on-upload))
+
+(def: #export (mock simulation init)
+  (All [s] (-> (Simulation s) s (Repository Promise)))
+  (let [state (stm.var init)]
+    (structure
+     (def: (download artifact extension)
+       (stm.commit
+        (do {! stm.monad}
+          [|state| (stm.read state)]
+          (case (:: simulation on-download artifact extension |state|)
+            (#try.Success [|state| output])
+            (do !
+              [_ (stm.write |state| state)]
+              (wrap (#try.Success output)))
+            
+            (#try.Failure error)
+            (wrap (#try.Failure error))))))
+
+     (def: (upload identity artifact extension content)
+       (stm.commit
+        (do {! stm.monad}
+          [|state| (stm.read state)]
+          (case (:: simulation on-upload identity artifact extension content |state|)
+            (#try.Success |state|)
+            (do !
+              [_ (stm.write |state| state)]
+              (wrap (#try.Success [])))
+            
+            (#try.Failure error)
+            (wrap (#try.Failure error))))))
+     )))
diff --git a/stdlib/source/program/aedifex/upload.lux b/stdlib/source/program/aedifex/upload.lux
index f5834fa61..391413f03 100644
--- a/stdlib/source/program/aedifex/upload.lux
+++ b/stdlib/source/program/aedifex/upload.lux
@@ -18,7 +18,8 @@
     [net (#+ URL)
      ["." uri]]]]
   ["." // #_
-   ["#." dependency (#+ Repository Dependency)]
+   ["#." repository (#+ Address User Password)]
+   ["#." dependency (#+ Dependency)]
    ["#." artifact]])
 
 (type: #export (Action a)
@@ -28,14 +29,8 @@
   (:coerce (Monad Action)
            (try.with io.monad)))
 
-(type: #export User
-  Text)
-
-(type: #export Password
-  Text)
-
 (def: (url repository dependency)
-  (-> Repository Dependency URL)
+  (-> Address Dependency URL)
   (format repository
           uri.separator
           (//artifact.uri (get@ #//dependency.artifact dependency))
@@ -80,7 +75,7 @@
                                                              (java/util/Base64::getEncoder))))
 
 (def: #export (upload repository user password dependency content)
-  (-> Repository User Password Dependency Binary
+  (-> Address User Password Dependency Binary
       (Action Any))
   (do {! ..monad}
     [connection (|> (..url repository dependency)