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/cache.lux | 138 ++++++++++++++++++++++++++++++++
 1 file changed, 138 insertions(+)
 create mode 100644 stdlib/source/program/aedifex/cache.lux

(limited to 'stdlib/source/program/aedifex/cache.lux')

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>)))))
-- 
cgit v1.2.3