From 03b1085924b225d34d3b11f1a442b0b5d926c417 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 2 Nov 2020 17:31:39 -0400
Subject: Allow defining anonymous actors.

---
 stdlib/source/program/aedifex.lux                  |  10 +-
 stdlib/source/program/aedifex/cache.lux            | 138 ++++++++++++++++++++
 stdlib/source/program/aedifex/command/build.lux    |   9 +-
 .../program/aedifex/dependency/resolution.lux      |   5 +
 stdlib/source/program/aedifex/local.lux            | 139 +--------------------
 stdlib/source/program/aedifex/package.lux          |  15 ++-
 6 files changed, 169 insertions(+), 147 deletions(-)
 create mode 100644 stdlib/source/program/aedifex/cache.lux

(limited to 'stdlib/source/program')

diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index f3f222d90..a3712a19f 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -37,7 +37,7 @@
    ["#." parser]
    ["#." pom]
    ["#." cli]
-   ["#." local]
+   ["#." cache]
    ["#." dependency #_
     ["#" resolution]]
    ["#." command
@@ -52,14 +52,14 @@
   (-> /.Profile (Promise Any))
   (do promise.monad
     [outcome (do (try.with promise.monad)
-               [cache (/local.all-cached (file.async file.default)
-                                         (set.to-list (get@ #/.dependencies profile))
-                                         /dependency.empty)
+               [cache (/cache.read-all (file.async file.default)
+                                       (set.to-list (get@ #/.dependencies profile))
+                                       /dependency.empty)
                 resolution (promise.future
                             (/dependency.resolve-all (set.to-list (get@ #/.repositories profile))
                                                      (set.to-list (get@ #/.dependencies profile))
                                                      cache))]
-               (/local.cache-all (file.async file.default)
+               (/cache.write-all (file.async file.default)
                                  resolution))]
     (wrap (case outcome
             (#try.Success _)
diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux
new file mode 100644
index 000000000..2a81b2869
--- /dev/null
+++ b/stdlib/source/program/aedifex/cache.lux
@@ -0,0 +1,138 @@
+(.module:
+  [lux #*
+   [abstract
+    [codec (#+ Codec)]
+    ["." monad (#+ do)]]
+   [control
+    ["." try (#+ Try)]
+    [concurrency
+     ["." promise (#+ Promise)]]
+    [security
+     ["!" capability]]]
+   [data
+    [binary (#+ Binary)]
+    [text
+     ["%" format (#+ format)]
+     ["." encoding]]
+    [collection
+     ["." dictionary]
+     ["." set]]
+    [format
+     ["." xml]]]
+   [world
+    ["." file (#+ Path File Directory)]]]
+  ["." // #_
+   ["#" local]
+   ["#." hash]
+   ["#." package (#+ Package)]
+   ["#." artifact
+    ["#/." extension]]
+   [dependency (#+ Dependency)
+    [resolution (#+ Resolution)]]])
+
+(def: (write! system content file)
+  (-> (file.System Promise) Binary Path (Promise (Try Any)))
+  (do (try.with promise.monad)
+    [file (: (Promise (Try (File Promise)))
+             (file.get-file promise.monad system file))]
+    (!.use (:: file over-write) [content])))
+
+(def: #export (write-one system [artifact type] package)
+  (-> (file.System Promise) Dependency Package (Promise (Try Any)))
+  (do (try.with promise.monad)
+    [directory (: (Promise (Try Path))
+                  (file.make-directories promise.monad system (//.path system artifact)))
+     #let [prefix (format directory (:: system separator) (//artifact.identity artifact))]
+     directory (: (Promise (Try (Directory Promise)))
+                  (file.get-directory promise.monad system directory))
+     _ (..write! system
+                 (get@ #//package.library package)
+                 (format prefix (//artifact/extension.extension type)))
+     _ (..write! system
+                 (|> package
+                     (get@ #//package.sha-1)
+                     (:: //hash.sha-1-codec encode)
+                     encoding.to-utf8)
+                 (format prefix //artifact/extension.sha-1))
+     _ (..write! system
+                 (|> package
+                     (get@ #//package.md5)
+                     (:: //hash.md5-codec encode)
+                     encoding.to-utf8)
+                 (format prefix //artifact/extension.md5))
+     _ (..write! system
+                 (|> package (get@ #//package.pom) (:: xml.codec encode) encoding.to-utf8)
+                 (format prefix //artifact/extension.pom))]
+    (wrap [])))
+
+(def: #export (write-all system resolution)
+  (-> (file.System Promise) Resolution (Promise (Try Any)))
+  (do {! (try.with promise.monad)}
+    [_ (monad.map ! (function (_ [dependency package])
+                      (..write-one system dependency package))
+                  (dictionary.entries resolution))]
+    (wrap [])))
+
+(def: (read! system path)
+  (-> (file.System Promise) Path (Promise (Try Binary)))
+  (do (try.with promise.monad)
+    [file (: (Promise (Try (File Promise)))
+             (!.use (:: system file) path))]
+    (!.use (:: file content) [])))
+
+(def: (decode codec data)
+  (All [a] (-> (Codec Text a) Binary (Try a)))
+  (let [(^open "_@.") try.monad]
+    (|> data
+        encoding.from-utf8
+        (_@map (:: codec decode))
+        _@join)))
+
+(def: #export (read-one system [artifact type])
+  (-> (file.System Promise) Dependency (Promise (Try Package)))
+  (let [prefix (format (//.path system artifact)
+                       (:: system separator)
+                       (//artifact.identity artifact))]
+    (do (try.with promise.monad)
+      [pom (..read! system (format prefix //artifact/extension.pom))
+       library (..read! system (format prefix (//artifact/extension.extension type)))
+       sha-1 (..read! system (format prefix //artifact/extension.sha-1))
+       md5 (..read! system (format prefix //artifact/extension.md5))]
+      (:: promise.monad wrap
+          (do try.monad
+            [pom (..decode xml.codec pom)
+             sha-1 (..decode //hash.sha-1-codec sha-1)
+             md5 (..decode //hash.md5-codec md5)]
+            (wrap {#//package.library library
+                   #//package.pom pom
+                   #//package.sha-1 sha-1
+                   #//package.md5 md5}))))))
+
+(def: #export (read-all system dependencies resolution)
+  (-> (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
+  (case dependencies
+    #.Nil
+    (:: (try.with promise.monad) wrap resolution)
+    
+    (#.Cons head tail)
+    (do promise.monad
+      [package (case (dictionary.get head resolution)
+                 (#.Some package)
+                 (wrap (#try.Success package))
+
+                 #.None
+                 (..read-one system head))]
+      (with-expansions [<next> (as-is (read-all system tail resolution))]
+        (case package
+          (#try.Success package)
+          (do (try.with promise.monad)
+            [sub-dependencies (|> package
+                                  //package.dependencies
+                                  (:: promise.monad wrap))
+             resolution (|> resolution
+                            (dictionary.put head package)
+                            (read-all system (set.to-list sub-dependencies)))]
+            <next>)
+          
+          (#try.Failure error)
+          <next>)))))
diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux
index 2d8ffb763..2e3e464a2 100644
--- a/stdlib/source/program/aedifex/command/build.lux
+++ b/stdlib/source/program/aedifex/command/build.lux
@@ -25,6 +25,7 @@
    ["#." action]
    ["#." command (#+ Command)]
    ["#." local]
+   ["#." cache]
    ["#." dependency (#+ Dependency)
     ["#/." resolution (#+ Resolution)]]
    ["#." shell]
@@ -124,14 +125,14 @@
     
     [(#.Some program) (#.Some target)]
     (do ///action.monad
-      [cache (///local.all-cached (file.async file.default)
-                                  (set.to-list (get@ #///.dependencies profile))
-                                  ///dependency/resolution.empty)
+      [cache (///cache.read-all (file.async file.default)
+                                (set.to-list (get@ #///.dependencies profile))
+                                ///dependency/resolution.empty)
        resolution (promise.future
                    (///dependency/resolution.resolve-all (set.to-list (get@ #///.repositories profile))
                                                          (set.to-list (get@ #///.dependencies profile))
                                                          cache))
-       _ (///local.cache-all (file.async file.default)
+       _ (///cache.write-all (file.async file.default)
                              resolution)
        [resolution compiler] (promise@wrap (..compiler resolution))
        working-directory (promise.future ..working-directory)
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index 7e48610e3..10874cbfc 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -3,6 +3,7 @@
    ["." host (#+ import:)]
    [abstract
     [codec (#+ Codec)]
+    [equivalence (#+ Equivalence)]
     [monad (#+ do)]]
    [control
     ["." io (#+ IO)]
@@ -133,6 +134,10 @@
   Resolution
   (dictionary.new //.hash))
 
+(def: #export equivalence
+  (Equivalence Resolution)
+  (dictionary.equivalence ///package.equivalence))
+
 (exception: #export (cannot-resolve {dependency Dependency})
   (let [artifact (get@ #//.artifact dependency)
         type (get@ #//.type dependency)]
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
index dc769bcc1..17ddeb4cf 100644
--- a/stdlib/source/program/aedifex/local.lux
+++ b/stdlib/source/program/aedifex/local.lux
@@ -1,45 +1,12 @@
 (.module:
   [lux #*
-   [abstract
-    ["." monad (#+ do)]]
-   [control
-    ["." io (#+ IO)]
-    ["." try (#+ Try)]
-    ["." exception]
-    [concurrency
-     ["." promise (#+ Promise)]]
-    [security
-     ["!" capability]]
-    ["<>" parser
-     ["<.>" xml]]]
    [data
-    [binary (#+ Binary)]
     [text
-     ["%" format (#+ format)]
-     ["." encoding]]
-    [collection
-     ["." list ("#@." monoid)]
-     ["." dictionary]
-     ["." set]]
-    [format
-     ["." binary]
-     ["." tar]
-     ["." xml]]]
+     ["%" format (#+ format)]]]
    [world
-    ["." file (#+ Path File Directory)]]]
-  [program
-   [compositor
-    ["." export]]]
+    ["." file (#+ Path)]]]
   ["." // #_
-   ["/" profile (#+ Profile)]
-   ["#." pom]
-   ["#." hash]
-   ["#." package (#+ Package)]
-   ["#." artifact (#+ Artifact)
-    ["#/." type]
-    ["#/." extension]]
-   ["#." dependency (#+ Dependency)
-    ["#/." resolution (#+ Resolution)]]])
+   ["#." artifact (#+ Artifact)]])
 
 (def: #export (repository system)
   (All [a] (-> (file.System a) Path))
@@ -51,103 +18,3 @@
   (format (..repository system)
           (:: system separator)
           (//artifact.path system artifact)))
-
-(def: (save! system content file)
-  (-> (file.System Promise) Binary Path (Promise (Try Any)))
-  (do (try.with promise.monad)
-    [file (: (Promise (Try (File Promise)))
-             (file.get-file promise.monad system file))]
-    (!.use (:: file over-write) [content])))
-
-(def: #export (cache system [artifact type] package)
-  (-> (file.System Promise) Dependency Package (Promise (Try Any)))
-  (do (try.with promise.monad)
-    [directory (: (Promise (Try Path))
-                  (file.make-directories promise.monad system (..path system artifact)))
-     #let [prefix (format directory (:: system separator) (//artifact.identity artifact))]
-     directory (: (Promise (Try (Directory Promise)))
-                  (file.get-directory promise.monad system directory))
-     _ (..save! system
-                (get@ #//package.library package)
-                (format prefix (//artifact/extension.extension type)))
-     _ (..save! system
-                (|> package
-                    (get@ #//package.sha-1)
-                    (:: //hash.sha-1-codec encode)
-                    encoding.to-utf8)
-                (format prefix //artifact/extension.sha-1))
-     _ (..save! system
-                (|> package
-                    (get@ #//package.md5)
-                    (:: //hash.md5-codec encode)
-                    encoding.to-utf8)
-                (format prefix //artifact/extension.md5))
-     _ (..save! system
-                (|> package (get@ #//package.pom) (:: xml.codec encode) encoding.to-utf8)
-                (format prefix //artifact/extension.pom))]
-    (wrap [])))
-
-(def: #export (cache-all system resolution)
-  (-> (file.System Promise) Resolution (Promise (Try Any)))
-  (do {! (try.with promise.monad)}
-    [_ (monad.map ! (function (_ [dependency package])
-                      (..cache system dependency package))
-                  (dictionary.entries resolution))]
-    (wrap [])))
-
-(def: (read! system path)
-  (-> (file.System Promise) Path (Promise (Try Binary)))
-  (do (try.with promise.monad)
-    [file (: (Promise (Try (File Promise)))
-             (!.use (:: system file) path))]
-    (!.use (:: file content) [])))
-
-(def: #export (cached system [artifact type])
-  (-> (file.System Promise) Dependency (Promise (Try Package)))
-  (do (try.with promise.monad)
-    [directory (: (Promise (Try Path))
-                  (file.make-directories promise.monad system (..path system artifact)))
-     #let [prefix (format directory (:: system separator) (//artifact.identity artifact))]
-     pom (..read! system (format prefix //artifact/extension.pom))
-     library (..read! system (format prefix (//artifact/extension.extension type)))
-     sha-1 (..read! system (format prefix //artifact/extension.sha-1))
-     md5 (..read! system (format prefix //artifact/extension.md5))]
-    (:: promise.monad wrap
-        (do try.monad
-          [pom (encoding.from-utf8 pom)
-           pom (:: xml.codec decode pom)
-           sha-1 (//hash.as-sha-1 sha-1)
-           md5 (//hash.as-md5 md5)]
-          (wrap {#//package.library library
-                 #//package.pom pom
-                 #//package.sha-1 sha-1
-                 #//package.md5 md5})))))
-
-(def: #export (all-cached system dependencies resolution)
-  (-> (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
-  (case dependencies
-    #.Nil
-    (:: (try.with promise.monad) wrap resolution)
-    
-    (#.Cons head tail)
-    (do promise.monad
-      [package (case (dictionary.get head resolution)
-                 (#.Some package)
-                 (wrap (#try.Success package))
-
-                 #.None
-                 (..cached system head))]
-      (with-expansions [<next> (as-is (all-cached system tail resolution))]
-        (case package
-          (#try.Success package)
-          (do (try.with promise.monad)
-            [sub-dependencies (|> package
-                                  //package.dependencies
-                                  (:: promise.monad wrap))
-             resolution (|> resolution
-                            (dictionary.put head package)
-                            (all-cached system (set.to-list sub-dependencies)))]
-            <next>)
-          
-          (#try.Failure error)
-          <next>)))))
diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux
index 757f116e6..31376c6f5 100644
--- a/stdlib/source/program/aedifex/package.lux
+++ b/stdlib/source/program/aedifex/package.lux
@@ -1,13 +1,15 @@
 (.module:
   [lux #*
+   [abstract
+    ["." equivalence (#+ Equivalence)]]
    [control
     ["." try (#+ Try) ("#@." functor)]
     [parser
      ["<.>" xml]]]
    [data
-    [binary (#+ Binary)]
+    ["." binary (#+ Binary)]
     [format
-     [xml (#+ XML)]]
+     ["." xml (#+ XML)]]
     [collection
      [set (#+ Set)]]]]
   ["." // #_
@@ -34,3 +36,12 @@
   (|>> (get@ #pom)
        (<xml>.run //pom.parser)
        (try@map (get@ #/.dependencies))))
+
+(def: #export equivalence
+  (Equivalence Package)
+  ($_ equivalence.product
+      binary.equivalence
+      xml.equivalence
+      //hash.equivalence
+      //hash.equivalence
+      ))
-- 
cgit v1.2.3