diff options
Diffstat (limited to 'stdlib/source/test/aedifex')
| -rw-r--r-- | stdlib/source/test/aedifex/command/auto.lux | 93 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/clean.lux | 17 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/deploy.lux | 82 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/install.lux | 84 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/pom.lux | 37 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/dependency/resolution.lux | 22 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/input.lux | 25 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/metadata.lux | 30 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/repository.lux | 2 |
9 files changed, 192 insertions, 200 deletions
diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 0808c7d21..effc80871 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -4,51 +4,47 @@ [abstract [monad (#+ do)]] [control + [pipe (#+ case>)] ["." try] [parser - ["." environment (#+ Environment)]] + ["." environment]] [concurrency ["." atom (#+ Atom)] ["." promise (#+ Promise)]]] [data + ["." binary] ["." text ["%" format (#+ format)] [encoding ["." utf8]]] [collection - ["." dictionary] - ["." set] - ["." list ("#\." functor)]]] + ["." set]]] [math - ["." random (#+ Random)] + ["." random] [number ["n" nat]]] + [time + ["." instant]] [world [console (#+ Console)] ["." shell (#+ Shell)] ["." program (#+ Program)] - ["." file (#+ Path File) + ["." file ["." watch]]]] ["." // #_ - ["@." version] - ["@." build] - ["$/#" // #_ - ["#." package]]] + ["$." version] + ["$." build]] {#program ["." / - ["/#" // #_ - ["#." build] - ["/#" // #_ - [command (#+ Command)] - ["#" profile (#+ Profile)] - ["#." action] - ["#." artifact - ["#/." type]] - ["#." dependency - ["#/." resolution (#+ Resolution)]]]]]}) + ["//#" /// #_ + [command (#+ Command)] + ["#" profile (#+ Profile)] + ["#." action] + [dependency + [resolution (#+ Resolution)]]]]}) -(def: (command expected_runs end_signal dummy_file) - (-> Nat Text (File Promise) +(def: (command expected_runs end_signal fs dummy_file) + (-> Nat Text (file.System Promise) file.Path [(Atom Nat) (-> (Console Promise) (Program Promise) (file.System Promise) (Shell Promise) Resolution (Command Any))]) (let [@runs (: (Atom Nat) @@ -60,18 +56,18 @@ (if (n.= expected_runs actual_runs) (wrap (#try.Failure end_signal)) (do (try.with !) - [_ (\ dummy_file over_write (\ utf8.codec encode (%.nat actual_runs)))] - (do ! - [_ (promise.future (atom.write actual_runs @runs))] - (wrap (#try.Success [])))))))])) + [_ (\ fs write (\ utf8.codec encode (%.nat actual_runs)) dummy_file)] + (\ fs modify + (|> actual_runs .int instant.from_millis) + dummy_file)))))])) (def: #export test Test (<| (_.covering /._) (do {! random.monad} - [#let [/ (\ file.default separator) + [end_signal (random.ascii/alpha 5) + #let [/ (\ file.default separator) [fs watcher] (watch.mock /)] - end_signal (random.ascii/alpha 5) program (random.ascii/alpha 5) target (random.ascii/alpha 5) @@ -93,30 +89,33 @@ expected_runs (\ ! map (|>> (n.% 10) (n.max 2)) random.nat) dummy_path (\ ! map (|>> (format source /)) (random.ascii/alpha 5)) - resolution @build.resolution] + resolution $build.resolution] ($_ _.and (wrap (do promise.monad [verdict (do ///action.monad - [_ (\ fs create_directory source) - dummy_file (\ fs create_file dummy_path) - #let [[@runs command] (..command expected_runs end_signal dummy_file)] + [_ (\ fs make_directory source) + _ (\ fs write (binary.create 0) dummy_path) + #let [[@runs command] (..command expected_runs end_signal fs dummy_path)] _ (\ watcher poll [])] - (do promise.monad - [outcome ((/.do! 1 watcher command) - (@version.echo "") - (program.async (program.mock environment.empty home working_directory)) - fs - (shell.async (@build.good_shell [])) - resolution - profile) - actual_runs (promise.future (atom.read @runs))] - (wrap (#try.Success (and (n.= expected_runs actual_runs) - (case outcome - (#try.Failure error) - (is? end_signal error) + (do {! promise.monad} + [no_dangling_process! (|> profile + ((/.do! 1 watcher command) + ($version.echo "") + (program.async (program.mock environment.empty home working_directory)) + fs + (shell.async ($build.good_shell [])) + resolution) + (\ ! map (|>> (case> (#try.Failure error) + (is? end_signal error) - (#try.Success _) - false))))))] + (#try.Success _) + false)))) + correct_number_of_runs! (|> @runs + atom.read + promise.future + (\ ! map (n.= expected_runs)))] + (wrap (#try.Success (and correct_number_of_runs! + no_dangling_process!)))))] (_.cover' [/.do!] (try.default false verdict)))) )))) diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index 18997e02e..e23e99b96 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -20,7 +20,7 @@ [number ["n" nat]]] [world - ["." file (#+ Path File)]]] + ["." file (#+ Path)]]] [// ["@." version] [// @@ -28,7 +28,7 @@ [// [lux [data - ["_." binary]]]]]] + ["$." binary]]]]]] {#program ["." / ["//#" /// #_ @@ -44,32 +44,29 @@ (do {! random.monad} [count (\ ! map (n.% 10) random.nat) names (random.set text.hash count ..node_name) - contents (random.list count (_binary.random 100))] + 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))] - (\ file over_write content))) + (\ fs write content path)) (def: (create_directory! fs path files) (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Any))) (do {! (try.with promise.monad)} - [_ (: (Promise (Try Path)) + [_ (: (Promise (Try Any)) (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))) + (|>> (\ fs directory?) (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))) + (|>> (\ fs file?) (try.lift promise.monad))) (def: (assets_exist? fs directory_path files) (-> (file.System Promise) Path (List [Path Binary]) (Promise (Try Bit))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index fd4395935..a40d8e394 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -2,17 +2,16 @@ [lux #* ["_" test (#+ Test)] [abstract - ["." monad (#+ do)]] + [monad (#+ do)]] [control - ["." try (#+ Try) ("#\." functor)] - ["." exception] + ["." try (#+ Try)] [concurrency ["." promise (#+ Promise)]] [parser - ["." environment (#+ Environment)]]] + ["." environment]]] [data ["." maybe] - ["." binary] + ["." binary ("#\." equivalence)] ["." text ("#\." equivalence) ["%" format (#+ format)] [encoding @@ -22,61 +21,40 @@ ["." tar] ["." xml]] [collection - ["." set (#+ Set)] - ["." dictionary (#+ Dictionary)]]] + ["." set]]] [math - ["." random (#+ Random)]] + ["." random]] [world - ["." file (#+ Path File)] + ["." file] ["." program (#+ Program)]]] [program [compositor ["." export]]] [// - ["@." version] + ["$." install] + ["$." version] [// - ["@." profile] - ["@." repository]]] + ["$." profile] + ["$." repository]]] {#program ["." / - ["/#" // #_ - ["#." clean] - ["/#" // #_ - ["#" profile] - ["#." action] - ["#." pom] - ["#." local] - ["#." hash] - ["#." repository (#+ Repository) - [identity (#+ Identity)] - ["#/." remote]] - ["#." artifact (#+ 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))))) + ["//#" /// #_ + ["#" profile] + ["#." action] + ["#." pom] + ["#." hash] + ["#." repository (#+ Repository) + ["#/." remote]] + ["#." artifact (#+ Artifact) + ["#/." extension]]]]}) (def: (execute! program repository fs artifact profile) (-> (Program Promise) (Repository Promise) (file.System Promise) Artifact ///.Profile (Promise (Try Text))) (do ///action.monad - [#let [console (@version.echo "")] - _ (..make_sources! fs (get@ #///.sources profile)) + [#let [console ($version.echo "")] + _ ($install.make_sources! fs (get@ #///.sources profile)) _ (/.do! console repository fs artifact profile)] (\ console read_line []))) @@ -90,12 +68,12 @@ [artifact (get@ #///.identity profile) expected_pom (try.to_maybe (///pom.write profile))] (wrap [artifact expected_pom profile]))) - @profile.random) + $profile.random) home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) - #let [repository (///repository.mock @repository.mock - @repository.empty) + #let [repository (///repository.mock $repository.mock + $repository.empty) fs (file.mock (\ file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] (wrap (do {! promise.monad} @@ -124,14 +102,12 @@ (text\= /.success logging) deployed_library! - (\ binary.equivalence = - expected_library - actual_library) + (binary\= expected_library + actual_library) deployed_pom! - (\ binary.equivalence = - (|> expected_pom (\ xml.codec encode) (\ utf8.codec encode)) - actual_pom) + (binary\= (|> expected_pom (\ xml.codec encode) (\ utf8.codec encode)) + actual_pom) deployed_sha-1! (\ ///hash.equivalence = diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index bb52b3cca..5800bca6d 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -9,63 +9,52 @@ [concurrency ["." promise (#+ Promise)]] [parser - ["." environment (#+ Environment)]]] + ["." environment]]] [data - ["." maybe] ["." binary] ["." text ("#\." equivalence) ["%" format (#+ format)]] - [format - ["." xml]] [collection ["." set (#+ Set)]]] [math - ["." random (#+ Random)]] + ["." random]] [world - ["." file (#+ Path File)] - ["." program (#+ Program)] - [net - ["." uri]]]] + ["." file] + ["." program (#+ Program)]]] [// - ["@." version] + ["$." version] [// - ["@." profile] - ["@." artifact]]] + ["$." profile] + ["$." artifact]]] {#program ["." / ["/#" // #_ - ["#." clean] ["/#" // #_ ["#" profile] - ["#." action] - ["#." pom] + ["#." action (#+ Action)] ["#." local] ["#." artifact ["#/." extension]] ["#." repository #_ ["#/." local]]]]]}) -(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: #export (make_sources! fs sources) + (-> (file.System Promise) (Set file.Path) (Action (List Any))) + (let [/ (\ fs separator) + ! ///action.monad] + (|> sources + set.to_list + (monad.map ! (function (_ head) + (do ! + [_ (: (Promise (Try Any)) + (file.make_directories promise.monad fs head))] + (: (Promise (Try Any)) + (file.make_file promise.monad fs (binary.create 0) (format head / head ".lux"))))))))) (def: (execute! program fs sample) (-> (Program Promise) (file.System Promise) ///.Profile (Promise (Try Text))) (do ///action.monad - [#let [console (@version.echo "")] + [#let [console ($version.echo "")] _ (..make_sources! fs (get@ #///.sources sample)) _ (/.do! console fs (///repository/local.repository program fs) sample)] (\ console read_line []))) @@ -74,29 +63,28 @@ Test (<| (_.covering /._) (do {! random.monad} - [identity @artifact.random + [identity $artifact.random sample (\ ! map (set@ #///.identity (#.Some identity)) - @profile.random) + $profile.random) home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5)] ($_ _.and (wrap (do {! promise.monad} [#let [fs (file.mock (\ file.default separator)) - program (program.async (program.mock environment.empty home working_directory))] - verdict (do ///action.monad - [logging (..execute! program fs sample) - #let [/ uri.separator - artifact_path (///local.uri (get@ #///artifact.version identity) identity) - library_path (format artifact_path ///artifact/extension.lux_library) - pom_path (format artifact_path ///artifact/extension.pom)] + program (program.async (program.mock environment.empty home working_directory)) - #let [succeeded! (text\= /.success logging)] - 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))] + artifact_path (///local.uri (get@ #///artifact.version identity) identity) + library_path (format artifact_path ///artifact/extension.lux_library) + pom_path (format artifact_path ///artifact/extension.pom)] + verdict (do {! ///action.monad} + [succeeded! (\ ! map (text\= /.success) + (..execute! program fs sample)) + library_exists! (|> library_path + (\ fs file?) + (\ promise.monad map exception.return)) + pom_exists! (|> pom_path + (\ fs file?) + (\ promise.monad map exception.return))] (wrap (and succeeded! library_exists! pom_exists!)))] diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index 0338bf7c4..2ac23ec7a 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -4,32 +4,30 @@ [abstract [monad (#+ do)]] [control - ["." try (#+ Try) ("#\." functor)] + ["." try ("#\." functor)] [concurrency - ["." promise (#+ Promise)]]] + ["." promise]]] [data - ["." binary] + ["." binary ("#\." equivalence)] ["." text ("#\." equivalence) [encoding ["." utf8]]] [format ["." xml]]] [math - ["." random (#+ Random)]] + ["." random]] [world - ["." file (#+ File)]]] + ["." file]]] [// ["@." version] [// ["@." profile]]] {#program ["." / - ["/#" // #_ - ["#." clean] - ["/#" // #_ - ["#" profile] - ["#." action] - ["#." pom]]]]}) + ["//#" /// #_ + ["#" profile] + ["#." action] + ["#." pom]]]}) (def: #export test Test @@ -41,27 +39,22 @@ [#let [console (@version.echo "")] outcome (/.do! console fs sample)] (case outcome - (#try.Success path) + (#try.Success _) (do ! [verdict (do ///action.monad [expected (|> (///pom.write sample) - (try\map (|>> (\ xml.codec encode) (\ utf8.codec encode))) + (try\map (|>> (\ xml.codec encode) + (\ utf8.codec encode))) (\ ! wrap)) - file (: (Promise (Try (File Promise))) - (file.get_file promise.monad fs path)) - actual (\ file content []) + actual (\ fs read ///pom.file) logging! (\ ///action.monad map (text\= /.success) (\ console read_line [])) - #let [expected_path! - (text\= ///pom.file path) - - expected_content! - (\ binary.equivalence = expected actual)]] + #let [expected_content! + (binary\= expected actual)]] (wrap (and logging! - expected_path! expected_content!)))] (_.cover' [/.do! /.success] (try.default false verdict))) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 7dcf46d3a..42116844f 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -30,7 +30,9 @@ ["$." /// #_ ["#." package] ["#." repository] - ["#." artifact]] + ["#." artifact] + [command + ["#." version]]] {#program ["." / ["//#" /// #_ @@ -88,6 +90,8 @@ (-> Artifact Package (Mock Any)) (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)] (implementation + (def: the_description + "[1]") (def: (on_download uri state) (if (text.contains? expected uri) (let [library (: Binary @@ -127,6 +131,8 @@ (def: (bad_sha-1 expected_artifact expected_package dummy_package) (-> Artifact Package Package (Mock Any)) (implementation + (def: the_description + "[~SHA-1]") (def: (on_download uri state) (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) @@ -178,6 +184,8 @@ (def: (bad_md5 expected_artifact expected_package dummy_package) (-> Artifact Package Package (Mock Any)) (implementation + (def: the_description + "[~MD5]") (def: (on_download uri state) (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) @@ -289,7 +297,9 @@ ($_ _.and (wrap (do promise.monad - [actual_package (/.any (list (///repository.mock bad_sha-1 []) + [#let [console ($///version.echo "")] + actual_package (/.any console + (list (///repository.mock bad_sha-1 []) (///repository.mock bad_md5 []) (///repository.mock good [])) {#///dependency.artifact expected_artifact @@ -305,7 +315,9 @@ false)))) (wrap (do promise.monad - [actual_package (/.any (list (///repository.mock bad_sha-1 []) + [#let [console ($///version.echo "")] + actual_package (/.any console + (list (///repository.mock bad_sha-1 []) (///repository.mock bad_md5 [])) {#///dependency.artifact expected_artifact #///dependency.type ///artifact/type.lux_library})] @@ -390,7 +402,9 @@ ($_ _.and (wrap (do promise.monad - [[successes failures resolution] (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) + [#let [console ($///version.echo "")] + [successes failures resolution] (/.all console + (list (///repository.mock (..single dependee_artifact dependee_package) []) (///repository.mock (..single depender_artifact depender_package) []) (///repository.mock (..single ignored_artifact ignored_package) [])) (list depender) diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index 0241b27a9..c379a8b0c 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -8,19 +8,18 @@ [concurrency ["." promise (#+ Promise)]]] [data - ["." binary] - ["." text - ["%" format (#+ format)] + [text + ["%" format] [encoding ["." utf8]]] [collection ["." set (#+ Set)]]] [math - ["." random (#+ Random)]] + ["." random]] [world - ["." file (#+ File)]]] + ["." file]]] [// - ["@." profile]] + ["$." profile]] {#program ["." / ["/#" // #_ @@ -45,18 +44,16 @@ Test (<| (_.covering /._) (do {! random.monad} - [expected (\ ! map (set@ #//.parents (list)) @profile.random) + [expected (\ ! map (set@ #//.parents (list)) $profile.random) #let [fs (: (file.System Promise) (file.mock (\ file.default separator)))]] (wrap (do promise.monad [verdict (do //action.monad - [file (: (Promise (Try (File Promise))) - (file.get_file promise.monad fs //project.file)) - _ (|> expected - //format.profile - %.code - (\ utf8.codec encode) - (\ file over_write)) + [#let [profile (|> expected + //format.profile + %.code + (\ utf8.codec encode))] + _ (\ fs write profile //project.file) actual (: (Promise (Try Profile)) (/.read promise.monad fs //.default))] (wrap (\ //.equivalence = diff --git a/stdlib/source/test/aedifex/metadata.lux b/stdlib/source/test/aedifex/metadata.lux index 33104330b..224ce4d80 100644 --- a/stdlib/source/test/aedifex/metadata.lux +++ b/stdlib/source/test/aedifex/metadata.lux @@ -4,14 +4,14 @@ [abstract [monad (#+ do)]] [data - ["." text]] + ["." text ("#\." equivalence)]] [math ["." random]]] ["." / #_ ["#." artifact] ["#." snapshot] [// - ["@." artifact]]] + ["$." artifact]]] {#program ["." /]}) @@ -19,6 +19,32 @@ Test (<| (_.covering /._) ($_ _.and + (do random.monad + [sample $artifact.random] + ($_ _.and + (_.cover [/.remote_artifact_uri /.remote_project_uri] + (not (text\= (/.remote_artifact_uri sample) + (/.remote_project_uri sample)))) + (_.cover [/.local_uri] + (let [remote_artifact_uri (/.remote_artifact_uri sample) + remote_project_uri (/.remote_project_uri sample)] + (and (not (text\= remote_artifact_uri (/.local_uri remote_artifact_uri))) + (not (text\= remote_project_uri (/.local_uri remote_project_uri)))))) + (_.cover [/.remote_uri] + (let [remote_artifact_uri (/.remote_artifact_uri sample) + remote_project_uri (/.remote_project_uri sample)] + (and (text\= remote_artifact_uri (/.remote_uri remote_artifact_uri)) + (text\= remote_project_uri (/.remote_uri remote_project_uri)) + (|> remote_artifact_uri + /.local_uri + /.remote_uri + (text\= remote_artifact_uri)) + (|> remote_project_uri + /.local_uri + /.remote_uri + (text\= remote_project_uri))))) + )) + /artifact.test /snapshot.test ))) diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index 98d869b5b..d16734a60 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -66,6 +66,8 @@ (implementation: #export mock (/.Mock Store) + (def: the_description + "@") (def: (on_download uri state) (case (dictionary.get uri state) (#.Some content) |