From 0205e5146b50ab066d152fccda0fc8cef4eef852 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 3 Dec 2020 02:09:57 -0400
Subject: Detect duplicate files coming from dependencies.

---
 stdlib/source/program/aedifex.lux                 | 124 ++++++++++++----------
 stdlib/source/program/aedifex/command/auto.lux    |   9 +-
 stdlib/source/program/aedifex/command/build.lux   |  20 ++--
 stdlib/source/program/aedifex/command/clean.lux   |  19 ++--
 stdlib/source/program/aedifex/command/deploy.lux  |  32 +++---
 stdlib/source/program/aedifex/command/deps.lux    |  29 ++---
 stdlib/source/program/aedifex/command/install.lux |  35 +++---
 stdlib/source/program/aedifex/command/pom.lux     |  19 ++--
 stdlib/source/program/aedifex/command/test.lux    |  22 ++--
 stdlib/source/program/aedifex/command/version.lux |  20 ++--
 stdlib/source/program/compositor/import.lux       |  25 ++++-
 11 files changed, 205 insertions(+), 149 deletions(-)

(limited to 'stdlib/source/program')

diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index 2478b4016..06b75afd5 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -33,6 +33,7 @@
    [world
     ["." environment (#+ Environment)]
     ["." shell (#+ Shell)]
+    ["." console (#+ Console)]
     ["." file (#+ Path)
      ["." watch]]]]
   ["." / #_
@@ -64,15 +65,16 @@
        set.to-list
        (list\map (|>> /repository.remote /repository.async))))
 
-(def: (with-dependencies command profile)
+(def: (with-dependencies console command profile)
   (All [a]
-    (-> (-> Environment (file.System Promise) (Shell Promise) Resolution (Command a))
+    (-> (Console Promise)
+        (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command a))
         (Command a)))
   (do promise.monad
     [environment (promise.future environment.read)]
     (do /action.monad
-      [resolution (/command/deps.do! (file.async file.default) (..repositories profile) profile)]
-      ((command environment (file.async file.default) (shell.async shell.default) resolution) profile))))
+      [resolution (/command/deps.do! console (file.async file.default) (..repositories profile) profile)]
+      ((command console environment (file.async file.default) (shell.async shell.default) resolution) profile))))
 
 (exception: (cannot-find-repository {repository Text}
                                     {options (Dictionary Text Address)})
@@ -84,66 +86,70 @@
 
 (program: [{[profile operation] /cli.command}]
   (do {! io.monad}
-    [?profile (/input.read io.monad file.default profile)]
-    (case ?profile
-      (#try.Success profile)
-      (case operation
-        #/cli.Version
-        (exec (/command/version.do! profile)
-          (wrap []))
-        
-        #/cli.Clean
-        (exec (/command/clean.do! (file.async file.default) profile)
-          (wrap []))
+    [?profile (/input.read io.monad file.default profile)
+     ?console console.default]
+    (case [?profile ?console]
+      [(#try.Success profile) (#try.Success console)]
+      (let [console (console.async console)]
+        (case operation
+          #/cli.Version
+          (exec (/command/version.do! console profile)
+            (wrap []))
+          
+          #/cli.Clean
+          (exec (/command/clean.do! console (file.async file.default) profile)
+            (wrap []))
 
-        #/cli.POM
-        (exec (/command/pom.do! (file.async file.default) profile)
-          (wrap []))
-        
-        #/cli.Install
-        (exec (/command/install.do! (file.async file.default) profile)
-          (wrap []))
+          #/cli.POM
+          (exec (/command/pom.do! console (file.async file.default) profile)
+            (wrap []))
+          
+          #/cli.Install
+          (exec (/command/install.do! console (file.async file.default) profile)
+            (wrap []))
 
-        (#/cli.Deploy repository identity)
-        (exec (case [(get@ #/.identity profile)
-                     (dictionary.get repository (get@ #/.deploy-repositories profile))]
-                [(#.Some artifact) (#.Some repository)]
-                (/command/deploy.do! (/repository.async (/repository.remote repository))
-                                     (file.async file.default)
-                                     identity
-                                     artifact
-                                     profile)
+          (#/cli.Deploy repository identity)
+          (exec (case [(get@ #/.identity profile)
+                       (dictionary.get repository (get@ #/.deploy-repositories profile))]
+                  [(#.Some artifact) (#.Some repository)]
+                  (/command/deploy.do! console
+                                       (/repository.async (/repository.remote repository))
+                                       (file.async file.default)
+                                       identity
+                                       artifact
+                                       profile)
 
-                [#.None _]
-                (promise\wrap (exception.throw /.no-identity []))
+                  [#.None _]
+                  (promise\wrap (exception.throw /.no-identity []))
 
-                [_ #.None]
-                (promise\wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])))
-          (wrap []))
-        
-        #/cli.Dependencies
-        (exec (/command/deps.do! (file.async file.default) (..repositories profile) profile)
-          (wrap []))
+                  [_ #.None]
+                  (promise\wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])))
+            (wrap []))
+          
+          #/cli.Dependencies
+          (exec (/command/deps.do! console (file.async file.default) (..repositories profile) profile)
+            (wrap []))
 
-        (#/cli.Compilation compilation)
-        (case compilation
-          #/cli.Build (exec (..with-dependencies /command/build.do! profile)
-                        (wrap []))
-          #/cli.Test (exec (..with-dependencies /command/test.do! profile)
-                       (wrap [])))
+          (#/cli.Compilation compilation)
+          (case compilation
+            #/cli.Build (exec (..with-dependencies console /command/build.do! profile)
+                          (wrap []))
+            #/cli.Test (exec (..with-dependencies console /command/test.do! profile)
+                         (wrap [])))
 
-        (#/cli.Auto auto)
-        (do !
-          [?watcher watch.default]
-          (case ?watcher
-            (#try.Failure error)
-            (wrap (log! error))
-            
-            (#try.Success watcher)
-            (exec (case auto
-                    #/cli.Build (..with-dependencies (/command/auto.do! watcher /command/build.do!) profile)
-                    #/cli.Test (..with-dependencies (/command/auto.do! watcher /command/test.do!) profile))
-              (wrap [])))))
+          (#/cli.Auto auto)
+          (do !
+            [?watcher watch.default]
+            (case ?watcher
+              (#try.Failure error)
+              (wrap (log! error))
+              
+              (#try.Success watcher)
+              (exec (case auto
+                      #/cli.Build (..with-dependencies console (/command/auto.do! watcher /command/build.do!) profile)
+                      #/cli.Test (..with-dependencies console (/command/auto.do! watcher /command/test.do!) profile))
+                (wrap []))))))
       
-      (#try.Failure error)
+      (^or [(#try.Failure error) _]
+           [_ (#try.Failure error)])
       (wrap (log! error)))))
diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux
index c2df31df5..33115c2e4 100644
--- a/stdlib/source/program/aedifex/command/auto.lux
+++ b/stdlib/source/program/aedifex/command/auto.lux
@@ -15,6 +15,7 @@
    [world
     [environment (#+ Environment)]
     [shell (#+ Shell)]
+    ["." console (#+ Console)]
     ["." file (#+ Path)
      ["." watch (#+ Watcher)]]]]
   ["." // #_
@@ -48,11 +49,11 @@
 (def: #export (do! watcher command)
   (All [a]
     (-> (Watcher Promise)
-        (-> Environment (file.System Promise) (Shell Promise) Resolution (Command a))
-        (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any))))
-  (function (_ environment fs shell resolution)
+        (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command a))
+        (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command Any))))
+  (function (_ console environment fs shell resolution)
     (function (_ profile)
-      (with-expansions [<call> ((command environment fs shell resolution) profile)]
+      (with-expansions [<call> ((command console environment fs shell resolution) profile)]
         (do {! promise.monad}
           [targets (|> profile
                        (get@ #///.sources)
diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux
index 85210fd36..be20d2e29 100644
--- a/stdlib/source/program/aedifex/command/build.lux
+++ b/stdlib/source/program/aedifex/command/build.lux
@@ -24,7 +24,8 @@
    [world
     [environment (#+ Environment)]
     ["." file (#+ Path)]
-    ["." shell (#+ Shell)]]]
+    ["." shell (#+ Shell)]
+    ["." console (#+ Console)]]]
   ["." /// #_
    ["#" profile]
    ["#." action]
@@ -118,8 +119,12 @@
   (-> Text (List Text) (List Text))
   (|>> (list\map (|>> (list name))) list.concat))
 
-(def: #export (do! environment fs shell resolution profile)
-  (-> Environment (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path]))
+(def: #export start "[BUILD STARTED]")
+(def: #export success "[BUILD ENDED]")
+(def: #export failure "[BUILD FAILED]")
+
+(def: #export (do! console environment fs shell resolution profile)
+  (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path]))
   (case [(get@ #///.program profile)
          (get@ #///.target profile)]
     [#.None _]
@@ -140,7 +145,7 @@
                                 [(format compiler " build") output])
              / (\ fs separator)
              cache-directory (format working-directory / target)]
-       #let [_ (log! "[BUILD STARTED]")]
+       _ (console.write-line ..start console)
        process (!.use (\ shell execute)
                       [environment
                        working-directory
@@ -150,8 +155,9 @@
                                           (..singular "--target" cache-directory)
                                           (..singular "--module" program)))])
        exit (!.use (\ process await) [])
-       #let [_ (log! (if (i.= shell.normal exit)
-                       "[BUILD ENDED]"
-                       "[BUILD FAILED]"))]]
+       _ (console.write-line (if (i.= shell.normal exit)
+                               ..success
+                               ..failure)
+                             console)]
       (wrap [compiler
              (format cache-directory / output)]))))
diff --git a/stdlib/source/program/aedifex/command/clean.lux b/stdlib/source/program/aedifex/command/clean.lux
index 618125a89..7f942fc00 100644
--- a/stdlib/source/program/aedifex/command/clean.lux
+++ b/stdlib/source/program/aedifex/command/clean.lux
@@ -9,7 +9,8 @@
     [concurrency
      ["." promise (#+ Promise)]]]
    [world
-    ["." file (#+ Path File Directory)]]]
+    ["." file (#+ Path File Directory)]
+    ["." console (#+ Console)]]]
   ["." /// #_
    [command (#+ Command)]
    ["#" profile]
@@ -25,8 +26,14 @@
                   nodes)]
     (wrap [])))
 
-(def: #export (do! fs profile)
-  (-> (file.System Promise) (Command Any))
+(def: #export success
+  "Success")
+
+(def: #export failure
+  "Failure: No 'target' defined for clean-up.")
+
+(def: #export (do! console fs profile)
+  (-> (Console Promise) (file.System Promise) (Command Any))
   (case (get@ #///.target profile)
     (#.Some target)
     (do {! ///action.monad}
@@ -39,9 +46,7 @@
                       (!.use (\ root directories) []))
               _ (monad.map ! recur subs)]
              (!.use (\ root discard) [])))]
-      (exec (log! "No 'target' defined for clean-up.")
-        (wrap [])))
+      (console.write-line ..success console))
     
     #.None
-    (exec (log! "No 'target' defined for clean-up.")
-      (\ ///action.monad wrap []))))
+    (console.write-line ..failure console)))
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index 1f5ccc441..dbe4a88cb 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -16,22 +16,25 @@
      ["." tar]
      ["." xml]]]
    [world
-    ["." file]]]
+    ["." file]
+    ["." console (#+ Console)]]]
   [program
    [compositor
     ["." export]]]
-  ["." /// #_
-   [repository (#+ Identity Repository)]
-   [command (#+ Command)]
-   ["/" profile]
-   ["#." action (#+ Action)]
-   ["#." pom]
-   ["#." hash]
-   ["#." artifact (#+ Artifact)
-    ["#/." extension (#+ Extension)]]])
+  ["." // #_
+   ["#." clean]
+   ["/#" // #_
+    [repository (#+ Identity Repository)]
+    [command (#+ Command)]
+    ["/" profile]
+    ["#." action (#+ Action)]
+    ["#." pom]
+    ["#." hash]
+    ["#." artifact (#+ Artifact)
+     ["#/." extension (#+ Extension)]]]])
 
-(def: #export (do! repository fs identity artifact profile)
-  (-> (Repository Promise) (file.System Promise) Identity Artifact (Command Any))
+(def: #export (do! console repository fs identity artifact profile)
+  (-> (Console Promise) (Repository Promise) (file.System Promise) Identity Artifact (Command Any))
   (let [deploy! (: (-> Extension Binary (Action Any))
                    (\ repository upload identity artifact))]
     (do {! ///action.monad}
@@ -44,6 +47,5 @@
        _ (deploy! ///artifact/extension.pom (|> pom (\ xml.codec encode) encoding.to-utf8))
        _ (deploy! ///artifact/extension.lux-library library)
        _ (deploy! ///artifact/extension.sha-1 (///hash.data (///hash.sha-1 library)))
-       _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library)))
-       #let [_ (log! "Successfully deployed!")]]
-      (wrap []))))
+       _ (deploy! ///artifact/extension.md5 (///hash.data (///hash.md5 library)))]
+      (console.write-line //clean.success console))))
diff --git a/stdlib/source/program/aedifex/command/deps.lux b/stdlib/source/program/aedifex/command/deps.lux
index dfe58d707..67dc19e47 100644
--- a/stdlib/source/program/aedifex/command/deps.lux
+++ b/stdlib/source/program/aedifex/command/deps.lux
@@ -9,23 +9,26 @@
     [collection
      ["." set (#+ Set)]]]
    [world
-    ["." file]]]
-  ["." /// #_
-   [command (#+ Command)]
-   [artifact (#+ Artifact)]
-   [repository (#+ Repository)]
-   ["#" profile]
-   ["#." action (#+ Action)]
-   ["#." cache]
-   ["#." dependency #_
-    ["#/." resolution (#+ Resolution)]]])
+    ["." file]
+    ["." console (#+ Console)]]]
+  ["." // #_
+   ["#." clean]
+   ["/#" // #_
+    [command (#+ Command)]
+    [artifact (#+ Artifact)]
+    [repository (#+ Repository)]
+    ["#" profile]
+    ["#." action (#+ Action)]
+    ["#." cache]
+    ["#." dependency #_
+     ["#/." resolution (#+ Resolution)]]]])
 
-(def: #export (do! fs repositories profile)
-  (-> (file.System Promise) (List (Repository Promise)) (Command Resolution))
+(def: #export (do! console fs repositories profile)
+  (-> (Console Promise) (file.System Promise) (List (Repository Promise)) (Command Resolution))
   (do ///action.monad
     [#let [dependencies (set.to-list (get@ #///.dependencies profile))]
      cache (///cache.read-all fs dependencies ///dependency/resolution.empty)
      resolution (///dependency/resolution.all repositories dependencies cache)
      cached (///cache.write-all fs resolution)
-     #let [_ (log! "Successfully resolved dependencies!")]]
+     _ (console.write-line //clean.success console)]
     (wrap resolution)))
diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux
index b152bc66c..327a0c119 100644
--- a/stdlib/source/program/aedifex/command/install.lux
+++ b/stdlib/source/program/aedifex/command/install.lux
@@ -21,18 +21,21 @@
      ["." tar]
      ["." xml]]]
    [world
-    ["." file (#+ Path File)]]]
+    ["." file (#+ Path File)]
+    ["." console (#+ Console)]]]
   [program
    [compositor
     ["." export]]]
-  ["." /// #_
-   ["/" profile (#+ Profile)]
-   ["#." action (#+ Action)]
-   ["#." command (#+ Command)]
-   ["#." local]
-   ["#." pom]
-   ["#." artifact (#+ Artifact)
-    ["#/." extension]]])
+  ["." // #_
+   ["#." clean]
+   ["/#" // #_
+    ["/" profile (#+ Profile)]
+    ["#." action (#+ Action)]
+    ["#." command (#+ Command)]
+    ["#." local]
+    ["#." pom]
+    ["#." artifact (#+ Artifact)
+     ["#/." extension]]]])
 
 (def: (save! system content file)
   (-> (file.System Promise) Binary Path (Promise (Try Any)))
@@ -41,8 +44,11 @@
              (file.get-file promise.monad system file))]
     (!.use (\ file over-write) [content])))
 
-(def: #export (do! system profile)
-  (-> (file.System Promise) (Command Any))
+(def: #export failure
+  "Failure: No 'identity' defined for the project.")
+
+(def: #export (do! console system profile)
+  (-> (Console Promise) (file.System Promise) (Command Any))
   (case (get@ #/.identity profile)
     (#.Some identity)
     (do ///action.monad
@@ -54,9 +60,8 @@
                   (format artifact-name ///artifact/extension.lux-library))
        pom (\ promise.monad wrap (///pom.write profile))
        _ (..save! system (|> pom (\ xml.codec encode) encoding.to-utf8)
-                  (format artifact-name ///artifact/extension.pom))
-       #let [_ (log! "Successfully installed locally!")]]
-      (wrap []))
+                  (format artifact-name ///artifact/extension.pom))]
+      (console.write-line //clean.success console))
 
     _
-    (\ promise.monad wrap (exception.throw /.no-identity []))))
+    (console.write-line ..failure console)))
diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux
index 28bd23921..cf07ad0e0 100644
--- a/stdlib/source/program/aedifex/command/pom.lux
+++ b/stdlib/source/program/aedifex/command/pom.lux
@@ -15,14 +15,17 @@
     [format
      ["." xml]]]
    [world
-    ["." file (#+ Path File)]]]
-  ["." /// #_
-   [command (#+ Command)]
-   ["#." action (#+ Action)]
-   ["#." pom]])
+    ["." file (#+ Path File)]
+    ["." console (#+ Console)]]]
+  ["." // #_
+   ["#." clean]
+   ["/#" // #_
+    [command (#+ Command)]
+    ["#." action (#+ Action)]
+    ["#." pom]]])
 
-(def: #export (do! fs profile)
-  (-> (file.System Promise) (Command Path))
+(def: #export (do! console fs profile)
+  (-> (Console Promise) (file.System Promise) (Command Path))
   (do ///action.monad
     [pom (promise\wrap (///pom.write profile))
      file (: (Promise (Try (File Promise)))
@@ -31,5 +34,5 @@
                  (\ xml.codec encode)
                  encoding.to-utf8
                  (!.use (\ file over-write)))
-     #let [_ (log! "Successfully wrote POM file!")]]
+     _ (console.write-line //clean.success console)]
     (wrap ///pom.file)))
diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux
index 5c205b7b8..93c705be1 100644
--- a/stdlib/source/program/aedifex/command/test.lux
+++ b/stdlib/source/program/aedifex/command/test.lux
@@ -15,7 +15,8 @@
    [world
     [environment (#+ Environment)]
     ["." file]
-    ["." shell (#+ Shell)]]]
+    ["." shell (#+ Shell)]
+    ["." console (#+ Console)]]]
   ["." // #_
    ["#." build]
    ["/#" // #_
@@ -25,12 +26,16 @@
     [dependency
      [resolution (#+ Resolution)]]]])
 
-(def: #export (do! environment fs shell resolution profile)
-  (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any))
+(def: #export start "[TEST STARTED]")
+(def: #export success "[TEST ENDED]")
+(def: #export failure "[TEST FAILED]")
+
+(def: #export (do! console environment fs shell resolution profile)
+  (-> (Console Promise) Environment (file.System Promise) (Shell Promise) Resolution (Command Any))
   (do ///action.monad
-    [[compiler program] (//build.do! environment fs shell resolution profile)
+    [[compiler program] (//build.do! console environment fs shell resolution profile)
      working-directory (promise\wrap (//build.working-directory environment))
-     #let [_ (log! "[TEST STARTED]")]
+     _ (console.write-line ..start console)
      process (!.use (\ shell execute)
                     [environment
                      working-directory
@@ -39,7 +44,8 @@
                        (#//build.JS artifact) (///runtime.node program))
                      (list)])
      exit (!.use (\ process await) [])
-     #let [_ (log! (if (i.= shell.normal exit)
-                     "[TEST ENDED]"
-                     "[TEST FAILED]"))]]
+     _ (console.write-line (if (i.= shell.normal exit)
+                             ..success
+                             ..failure)
+                           console)]
     (wrap [])))
diff --git a/stdlib/source/program/aedifex/command/version.lux b/stdlib/source/program/aedifex/command/version.lux
index 8f26a7fb7..076d2a71d 100644
--- a/stdlib/source/program/aedifex/command/version.lux
+++ b/stdlib/source/program/aedifex/command/version.lux
@@ -1,16 +1,20 @@
 (.module:
   [lux #*
+   [control
+    [concurrency
+     ["." promise (#+ Promise)]]]
    [tool
     [compiler
      ["." version]
      ["." language #_
       ["#/." lux #_
-       ["#" version]]]]]]
-  ["." /// #_
-   [command (#+ Command)]
-   ["#." action]])
+       ["#" version]]]]]
+   [world
+    ["." console (#+ Console)]]]
+  [///
+   [command (#+ Command)]])
 
-(def: #export (do! profile)
-  (Command Any)
-  (\ ///action.monad wrap
-     (log! (version.format language/lux.version))))
+(def: #export (do! console profile)
+  (-> (Console Promise) (Command Any))
+  (console.write-line (version.format language/lux.version)
+                      console))
diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux
index 318c3705c..edc0160f5 100644
--- a/stdlib/source/program/compositor/import.lux
+++ b/stdlib/source/program/compositor/import.lux
@@ -1,5 +1,5 @@
 (.module:
-  [lux #*
+  [lux (#- Module)
    [abstract
     ["." monad (#+ Monad do)]]
    [control
@@ -13,12 +13,18 @@
      ["<b>" binary]]]
    [data
     [binary (#+ Binary)]
-    ["." text]
+    ["." text
+     ["%" format (#+ format)]]
     [collection
      ["." dictionary (#+ Dictionary)]
      ["." row]]
     [format
      ["." tar]]]
+   [tool
+    [compiler
+     [meta
+      [archive
+       [descriptor (#+ Module)]]]]]
    [world
     ["." file (#+ Path File)]]]
   [//
@@ -29,6 +35,11 @@
 
 (exception: #export useless-tar-entry)
 
+(exception: #export (duplicate {library Library} {module Module})
+  (exception.report
+   ["Module" (%.text module)]
+   ["Library" (%.text library)]))
+
 (type: #export Import
   (Dictionary Path Binary))
 
@@ -44,9 +55,13 @@
        (monad.fold ! (function (_ entry import)
                        (case entry
                          (#tar.Normal [path instant mode ownership content])
-                         (dictionary.try-put (tar.from-path path)
-                                             (tar.data content)
-                                             import)
+                         (let [path (tar.from-path path)]
+                           (case (dictionary.try-put path (tar.data content) import)
+                             (#try.Success import)
+                             (wrap import)
+                             
+                             (#try.Failure error)
+                             (exception.throw ..duplicate [library path])))
                          
                          _
                          (exception.throw ..useless-tar-entry [])))
-- 
cgit v1.2.3