aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/aedifex/command
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/aedifex/command/clean.lux118
1 files changed, 118 insertions, 0 deletions
diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux
new file mode 100644
index 000000000..73207fa14
--- /dev/null
+++ b/stdlib/source/test/aedifex/command/clean.lux
@@ -0,0 +1,118 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." try (#+ Try)]
+ [concurrency
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability]]]
+ [data
+ [binary (#+ Binary)]
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]]
+ [number
+ ["n" nat]]
+ [collection
+ ["." list ("#@." functor)]
+ ["." set]]]
+ [math
+ ["." random (#+ Random)]]
+ [world
+ ["." file (#+ Path File)]]]
+ [///
+ ["@." profile]
+ [//
+ [lux
+ [data
+ ["_." binary]]]]]
+ {#program
+ ["." /
+ ["//#" /// #_
+ ["#" profile]
+ ["#." action (#+ Action)]]]})
+
+(def: node-name
+ (Random Text)
+ (random.ascii/alpha 10))
+
+(def: (files prefix)
+ (-> Path (Random (List [Path Binary])))
+ (do {! random.monad}
+ [count (:: ! map (n.% 10) random.nat)
+ names (random.set text.hash count ..node-name)
+ contents (random.list count (_binary.random 100))]
+ (wrap (list.zip/2 (list@map (|>> (format prefix)) (set.to-list names))
+ contents))))
+
+(def: (create-file! fs [path content])
+ (-> (file.System Promise) [Path Binary] (Promise (Try Any)))
+ (do {! (try.with promise.monad)}
+ [file (: (Promise (Try (File Promise)))
+ (file.get-file promise.monad fs path))]
+ (!.use (:: file over-write) content)))
+
+(def: (create-directory! fs path files)
+ (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Any)))
+ (do {! (try.with promise.monad)}
+ [_ (: (Promise (Try Path))
+ (file.make-directories promise.monad fs path))
+ _ (monad.map ! (..create-file! fs) files)]
+ (wrap [])))
+
+(def: (directory-exists? fs)
+ (-> (file.System Promise) Path (Promise (Try Bit)))
+ (|>> (file.directory-exists? promise.monad fs) (try.lift promise.monad)))
+
+(def: (file-exists? fs)
+ (-> (file.System Promise) Path (Promise (Try Bit)))
+ (|>> (file.file-exists? promise.monad fs) (try.lift promise.monad)))
+
+(def: (assets-exist? fs directory-path files)
+ (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Bit)))
+ (do {! (try.with promise.monad)}
+ [directory-exists? (..directory-exists? fs directory-path)
+ files-exist? (: (Action (List Bit))
+ (|> files
+ (list@map product.left)
+ (monad.map ///action.monad (..file-exists? fs))))]
+ (wrap (and directory-exists?
+ (list.every? (|>>) files-exist?)))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {! random.monad}
+ [context ..node-name
+ target ..node-name
+ sub ..node-name
+ #let [fs (file.mock (:: file.default separator))
+ / (:: fs separator)
+ target-path (format context / target)
+ sub-path (format target-path / sub)]
+ direct-files (..files (format target-path /))
+ sub-files (..files (format sub-path /))
+
+ dummy @profile.random]
+ (wrap (do promise.monad
+ [verdict (do {! (try.with promise.monad)}
+ [_ (..create-directory! fs target-path direct-files)
+ _ (..create-directory! fs sub-path sub-files)
+ context-exists!/pre (..directory-exists? fs context)
+ target-exists!/pre (..assets-exist? fs target-path direct-files)
+ sub-exists!/pre (..assets-exist? fs sub-path sub-files)
+ _ (/.do! fs (set@ #///.target (#.Some target-path) dummy))
+ context-exists!/post (..directory-exists? fs context)
+ target-exists!/post (..assets-exist? fs target-path direct-files)
+ sub-exists!/post (..assets-exist? fs sub-path sub-files)]
+ (wrap (and (and context-exists!/pre
+ context-exists!/post)
+ (and target-exists!/pre
+ (not target-exists!/post))
+ (and sub-exists!/pre
+ (not sub-exists!/post)))))]
+ (_.claim [/.do!]
+ (try.default false verdict)))))))