From d29e091e98dabb8dfcf816899ada480ecbf7e357 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 23 Dec 2020 06:33:44 -0400
Subject: Refactored "export" common syntax.

---
 stdlib/source/program/aedifex/cache.lux | 84 ++++++++++++++++++++-------------
 1 file changed, 50 insertions(+), 34 deletions(-)

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

diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux
index 50062c3f7..ce95f65b7 100644
--- a/stdlib/source/program/aedifex/cache.lux
+++ b/stdlib/source/program/aedifex/cache.lux
@@ -26,12 +26,14 @@
     ["." file (#+ Path File Directory)]]]
   ["." // #_
    ["#" local]
-   ["#." hash]
+   ["#." hash (#+ Hash SHA-1 MD5)]
    ["#." package (#+ Package)]
    ["#." artifact (#+ Artifact)
-    ["#/." extension]]
-   [dependency (#+ Dependency)
-    [resolution (#+ Resolution)]]])
+    ["#/." type]
+    ["#/." extension (#+ Extension)]]
+   ["#." dependency (#+ Dependency)
+    [resolution (#+ Resolution)]
+    ["#/." status (#+ Status)]]])
 
 (def: (write! system content file)
   (-> (file.System Promise) Binary Path (Promise (Try Any)))
@@ -40,6 +42,36 @@
              (file.get-file promise.monad system file))]
     (!.use (\ file over-write) [content])))
 
+(def: (write-hashed system directory [artifact type] [data status])
+  (-> (file.System Promise) Path Dependency [Binary Status] (Promise (Try Any)))
+  (let [prefix (format directory
+                       (\ system separator)
+                       (//artifact.identity artifact)
+                       (//artifact/extension.extension type))]
+    (do {! (try.with promise.monad)}
+      [_ (..write! system data prefix)
+       #let [write-hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any))))
+                           (function (_ codec extension hash)
+                             (..write! system
+                                       (|> hash (\ codec encode) (\ encoding.utf8 encode))
+                                       (format prefix extension))))]]
+      (case status
+        #//dependency/status.Unverified
+        (wrap [])
+        
+        (#//dependency/status.Partial partial)
+        (case partial
+          (#.Left sha-1)
+          (write-hash //hash.sha-1-codec //artifact/extension.sha-1 sha-1)
+          
+          (#.Right md5)
+          (write-hash //hash.md5-codec //artifact/extension.md5 md5))
+        
+        (#//dependency/status.Verified sha-1 md5)
+        (do !
+          [_ (write-hash //hash.sha-1-codec //artifact/extension.sha-1 sha-1)]
+          (write-hash //hash.md5-codec //artifact/extension.md5 md5))))))
+
 (def: #export (write-one program system [artifact type] package)
   (-> (Program Promise) (file.System Promise) Dependency Package (Promise (Try Artifact)))
   (do promise.monad
@@ -47,27 +79,12 @@
     (do (try.with promise.monad)
       [directory (: (Promise (Try Path))
                     (file.make-directories promise.monad system (//.path system home 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.utf8 encode))
-                   (format prefix //artifact/extension.sha-1))
-       _ (..write! system
-                   (|> package
-                       (get@ #//package.md5)
-                       (\ //hash.md5-codec encode)
-                       (\ encoding.utf8 encode))
-                   (format prefix //artifact/extension.md5))
-       _ (..write! system
-                   (|> package (get@ #//package.pom) (\ xml.codec encode) (\ encoding.utf8 encode))
-                   (format prefix //artifact/extension.pom))]
+       _ (write-hashed system directory [artifact type] (get@ #//package.library package))
+       _ (let [[pom status] (get@ #//package.pom package)]
+           (write-hashed system directory
+                         [artifact //artifact/type.pom]
+                         [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode))
+                          status]))]
       (wrap artifact))))
 
 (def: #export (write-all program system resolution)
@@ -104,19 +121,18 @@
                           (//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))]
+       #let [extension (//artifact/extension.extension type)]
+       library (..read! system (format prefix extension))
+       library-sha-1 (..read! system (format prefix extension //artifact/extension.sha-1))
+       library-md5 (..read! system (format prefix extension //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)]
+            library-sha-1 (..decode //hash.sha-1-codec library-sha-1)
+            library-md5 (..decode //hash.md5-codec library-md5)]
            (wrap {#//package.origin #//package.Local
-                  #//package.library library
-                  #//package.pom pom
-                  #//package.sha-1 sha-1
-                  #//package.md5 md5}))))))
+                  #//package.library [library (#//dependency/status.Verified library-sha-1 library-md5)]
+                  #//package.pom [pom #//dependency/status.Unverified]}))))))
 
 (def: #export (read-all program system dependencies resolution)
   (-> (Program Promise) (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
-- 
cgit v1.2.3