From 69272f598d831e89da83bdc8c9290d5607dfb14d Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 31 Oct 2020 20:26:37 -0400
Subject: Re-named the directory for my bookmarks to better reflect what they
 are.

---
 stdlib/source/test/aedifex/command/install.lux | 101 +++++++++++++++++++++++++
 1 file changed, 101 insertions(+)
 create mode 100644 stdlib/source/test/aedifex/command/install.lux

(limited to 'stdlib/source/test/aedifex/command/install.lux')

diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux
new file mode 100644
index 000000000..7f8a4557f
--- /dev/null
+++ b/stdlib/source/test/aedifex/command/install.lux
@@ -0,0 +1,101 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." try (#+ Try) ("#@." functor)]
+    ["." exception]
+    [concurrency
+     ["." promise (#+ Promise)]]
+    [security
+     ["!" capability]]]
+   [data
+    ["." maybe]
+    ["." binary]
+    ["." text ("#@." equivalence)
+     ["%" format (#+ format)]
+     ["." encoding]]
+    [format
+     ["." xml]]
+    [collection
+     ["." set (#+ Set)]]]
+   [math
+    ["." random (#+ Random)]]
+   [world
+    ["." file (#+ Path File)]]]
+  [///
+   ["@." profile]]
+  {#program
+   ["." /
+    ["//#" /// #_
+     ["#" profile]
+     ["#." action]
+     ["#." pom]
+     ["#." local]
+     ["#." artifact
+      ["#/." extension]]]]})
+
+(def: (make-sources! fs sources)
+  (-> (file.System Promise) (Set Path) (Promise (Try Any)))
+  (loop [sources (set.to-list sources)]
+    (case sources
+      #.Nil
+      (|> []
+          (:: try.monad wrap)
+          (:: promise.monad wrap))
+      
+      (#.Cons head tail)
+      (do (try.with promise.monad)
+        [_ (: (Promise (Try Path))
+              (file.make-directories promise.monad fs head))
+         _ (: (Promise (Try (File Promise)))
+              (file.get-file promise.monad fs (format head (:: fs separator) head ".lux")))]
+        (recur tail)))))
+
+(def: (execute! fs sample)
+  (-> (file.System Promise) ///.Profile (Promise (Try Any)))
+  (do ///action.monad
+    [_ (..make-sources! fs (get@ #///.sources sample))
+     _ (: (Promise (Try Path))
+          (file.make-directories promise.monad fs (///local.repository fs)))]
+    (/.do! fs sample)))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (do random.monad
+        [sample @profile.random
+         #let [fs (file.mock (:: file.default separator))]]
+        (wrap (case (get@ #///.identity sample)
+                (#.Some identity)
+                (do {@ promise.monad}
+                  [verdict (do ///action.monad
+                             [_ (..execute! fs sample)
+                              #let [artifact-path (format (///local.path fs identity)
+                                                          (:: fs separator)
+                                                          (///artifact.identity identity))
+                                    library-path (format artifact-path ///artifact/extension.lux-library)
+                                    pom-path (format artifact-path ///artifact/extension.pom)]
+
+                              library-exists! (:: promise.monad map
+                                                  exception.return
+                                                  (file.file-exists? promise.monad fs library-path))
+                              pom-exists! (:: promise.monad map
+                                              exception.return
+                                              (file.file-exists? promise.monad fs pom-path))]
+                             (wrap (and library-exists!
+                                        pom-exists!)))]
+                  (_.claim [/.do!]
+                           (try.default false verdict)))
+
+                #.None
+                (do {@ promise.monad}
+                  [outcome (..execute! fs sample)]
+                  (_.claim [/.do!]
+                           (case outcome
+                             (#try.Success _)
+                             false
+
+                             (#try.Failure error)
+                             true))))))))
-- 
cgit v1.2.3