Improved error reporting for syntax macros.

1 files changed, 85 insertions, 0 deletions

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))))))
+     )))