From 94e5802f594a73245fce0fbd885103b8bf210d57 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 2 Dec 2022 19:33:00 -0400 Subject: Added some simple time-series handling machinery. --- stdlib/source/test/aedifex/command/auto.lux | 22 ++++++++-------- stdlib/source/test/aedifex/command/build.lux | 22 ++++++++-------- stdlib/source/test/aedifex/command/clean.lux | 14 +++++----- stdlib/source/test/aedifex/command/deploy.lux | 36 +++++++++++++------------- stdlib/source/test/aedifex/command/deps.lux | 14 +++++----- stdlib/source/test/aedifex/command/install.lux | 18 ++++++------- stdlib/source/test/aedifex/command/pom.lux | 14 +++++----- stdlib/source/test/aedifex/command/test.lux | 22 ++++++++-------- stdlib/source/test/aedifex/command/version.lux | 2 +- 9 files changed, 82 insertions(+), 82 deletions(-) (limited to 'stdlib/source/test/aedifex/command') diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index c46b474ac..9f3769b00 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -59,8 +59,8 @@ (if (n.= expected_runs actual_runs) (in {try.#Failure end_signal}) (do (try.with !) - [_ (at fs write dummy_file (at utf8.codec encoded (%.nat actual_runs))) - _ (at fs modify dummy_file (|> actual_runs .int instant.of_millis))] + [_ (of fs write dummy_file (of utf8.codec encoded (%.nat actual_runs))) + _ (of fs modify dummy_file (|> actual_runs .int instant.of_millis))] (in [shell.normal []])))))])) (def .public test @@ -68,7 +68,7 @@ (<| (_.covering /._) (do [! random.monad] [end_signal (random.alphabetic 5) - .let [/ (at file.default separator) + .let [/ (of file.default separator) [fs watcher] (watch.mock /)] program (random.and (random.alphabetic 5) @@ -76,7 +76,7 @@ target (random.alphabetic 5) source (random.alphabetic 5) .let [empty_profile (is Profile - (at ///.monoid identity)) + (of ///.monoid identity)) with_target (is (-> Profile Profile) (has ///.#target target)) with_program (is (-> Profile Profile) @@ -90,18 +90,18 @@ home (random.alphabetic 5) working_directory (random.alphabetic 5) - expected_runs (at ! each (|>> (n.% 10) (n.max 2)) random.nat) - dummy_path (at ! each (|>> (format source /)) (random.alphabetic 5)) + expected_runs (of ! each (|>> (n.% 10) (n.max 2)) random.nat) + dummy_path (of ! each (|>> (format source /)) (random.alphabetic 5)) [compiler resolution] $build.resolution] (all _.and (_.coverage [/.delay] (n.> 0 /.delay)) (in (do async.monad [verdict (do ///action.monad - [_ (at fs make_directory source) - _ (at fs write dummy_path (binary.empty 0)) + [_ (of fs make_directory source) + _ (of fs write dummy_path (binary.empty 0)) .let [[@runs command] (..command expected_runs end_signal fs dummy_path)] - _ (at watcher poll [])] + _ (of watcher poll [])] (do [! async.monad] [no_dangling_process! (|> profile (has ///.#lux compiler) @@ -111,7 +111,7 @@ fs (shell.async ($build.good_shell [])) resolution) - (at ! each (|>> (pipe.when + (of ! each (|>> (pipe.when {try.#Failure error} (same? end_signal error) @@ -120,7 +120,7 @@ correct_number_of_runs! (|> @runs atom.read! async.future - (at ! each (n.= expected_runs)))] + (of ! each (n.= expected_runs)))] (in {try.#Success (and correct_number_of_runs! no_dangling_process!)})))] (unit.coverage [/.do!] diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 674a04e93..205866e1f 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -144,7 +144,7 @@ (do [! random.monad] [last_read (random.alphabetic 5) last_error (random.alphabetic 5) - .let [fs (file.mock (at file.default separator)) + .let [fs (file.mock (of file.default separator)) shell (shell.async (..good_shell []))] program (random.and (random.alphabetic 5) (random.alphabetic 5)) @@ -152,7 +152,7 @@ home (random.alphabetic 5) working_directory (random.alphabetic 5) .let [empty_profile (is Profile - (at ///.monoid identity)) + (of ///.monoid identity)) with_target (is (-> Profile Profile) (has ///.#target target)) with_program (is (-> Profile Profile) @@ -189,8 +189,8 @@ [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs shell resolution (has ///.#lux compiler profile)) - start (at console read_line []) - end (at console read_line [])] + start (of console read_line []) + end (of console read_line [])] (in (and (text#= /.start start) (text#= /.success end))))] (unit.coverage [/.do! @@ -211,8 +211,8 @@ [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (..bad_shell [])) resolution (has ///.#lux compiler profile)) - start (at console read_line []) - end (at console read_line [])] + start (of console read_line []) + end (of console read_line [])] (in (and (text#= /.start start) (text#= /.failure end))))] (unit.coverage [/.failure] @@ -231,11 +231,11 @@ [verdict (do ///action.monad [process (shell [environment.empty working_directory "" (list "")]) _ ( console process) - actual/0 (at console read_line []) - actual/1 (at console read_line []) - actual/2 (at console read_line []) - end! (|> (at console read_line []) - (at ! each (|>> (pipe.when + actual/0 (of console read_line []) + actual/1 (of console read_line []) + actual/2 (of console read_line []) + end! (|> (of console read_line []) + (of ! each (|>> (pipe.when {try.#Failure error} true diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index b33d6d911..6ead0475f 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -45,7 +45,7 @@ (def (files prefix) (-> Path (Random (List [Path Binary]))) (do [! random.monad] - [count (at ! each (n.% 10) random.nat) + [count (of ! each (n.% 10) random.nat) names (random.set text.hash count ..node_name) contents (random.list count ($binary.random 100))] (in (list.zipped_2 (list#each (|>> (format prefix)) (set.list names)) @@ -53,7 +53,7 @@ (def (create_file! fs [path content]) (-> (file.System Async) [Path Binary] (Async (Try Any))) - (at fs write path content)) + (of fs write path content)) (def (create_directory! fs path files) (-> (file.System Async) Path (List [Path Binary]) (Async (Try Any))) @@ -65,11 +65,11 @@ (def (directory_exists? fs) (-> (file.System Async) Path (Async (Try Bit))) - (|>> (at fs directory?) (try.lifted async.monad))) + (|>> (of fs directory?) (try.lifted async.monad))) (def (file_exists? fs) (-> (file.System Async) Path (Async (Try Bit))) - (|>> (at fs file?) (try.lifted async.monad))) + (|>> (of fs file?) (try.lifted async.monad))) (def (assets_exist? fs directory_path files) (-> (file.System Async) Path (List [Path Binary]) (Async (Try Bit))) @@ -89,8 +89,8 @@ [context ..node_name target ..node_name sub ..node_name - .let [fs (file.mock (at file.default separator)) - / (at fs separator) + .let [fs (file.mock (of file.default separator)) + / (of fs separator) target_path (format context / target) sub_path (format target_path / sub)] direct_files (..files (format target_path /)) @@ -109,7 +109,7 @@ 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) - logging (at console read_line [])] + logging (of console read_line [])] (in (and (and context_exists!/pre context_exists!/post) (and target_exists!/pre diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 88da67576..d970427d2 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -62,7 +62,7 @@ (implementation (def (execute [environment working_directory command arguments]) (do [! ///action.monad] - [files (at fs directory_files working_directory) + [files (of fs directory_files working_directory) _ (monad.each ! (function (_ file) (do ! @@ -94,8 +94,8 @@ [.let [console ($version.echo "")] _ ($install.make_sources! fs (the ///.#sources profile)) _ (/.do! program (..shell fs) console local remote fs artifact profile) - locally_installed! (at console read_line []) - deployed! (at console read_line [])] + locally_installed! (of console read_line []) + deployed! (of console read_line [])] (in [locally_installed! deployed!]))) (def .public test @@ -112,7 +112,7 @@ home (random.alphabetic 5) working_directory (random.alphabetic 5) - .let [fs (file.mock (at file.default separator)) + .let [fs (file.mock (of file.default separator)) program (program.async (program.mock environment.empty home working_directory)) local (///repository/local.repository program fs) remote (///repository.mock $repository.mock @@ -124,20 +124,20 @@ (the ///.#sources) set.list (export.library fs) - (at ! each (\\format.result tar.format))) + (of ! each (\\format.result tar.format))) - actual_pom (at remote download (///repository/remote.uri (the ///artifact.#version artifact) artifact ///artifact/extension.pom)) - actual_library (at remote download (///repository/remote.uri (the ///artifact.#version artifact) artifact ///artifact/extension.lux_library)) - actual_sha1 (at remote download (///repository/remote.uri (the ///artifact.#version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.sha1))) - actual_sha1 (at async.monad in + actual_pom (of remote download (///repository/remote.uri (the ///artifact.#version artifact) artifact ///artifact/extension.pom)) + actual_library (of remote download (///repository/remote.uri (the ///artifact.#version artifact) artifact ///artifact/extension.lux_library)) + actual_sha1 (of remote download (///repository/remote.uri (the ///artifact.#version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.sha1))) + actual_sha1 (of async.monad in (do try.monad - [actual_sha1 (at utf8.codec decoded actual_sha1)] - (at ///hash.sha1_codec decoded actual_sha1))) - actual_md5 (at remote download (///repository/remote.uri (the ///artifact.#version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) - actual_md5 (at async.monad in + [actual_sha1 (of utf8.codec decoded actual_sha1)] + (of ///hash.sha1_codec decoded actual_sha1))) + actual_md5 (of remote download (///repository/remote.uri (the ///artifact.#version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) + actual_md5 (of async.monad in (do try.monad - [actual_md5 (at utf8.codec decoded actual_md5)] - (at ///hash.md5_codec decoded actual_md5))) + [actual_md5 (of utf8.codec decoded actual_md5)] + (of ///hash.md5_codec decoded actual_md5))) .let [succeeded! (and (text#= //install.success locally_installed!) @@ -148,16 +148,16 @@ actual_library) deployed_pom! - (binary#= (|> expected_pom (at xml.codec encoded) (at utf8.codec encoded)) + (binary#= (|> expected_pom (of xml.codec encoded) (of utf8.codec encoded)) actual_pom) deployed_sha1! - (at ///hash.equivalence = + (of ///hash.equivalence = (///hash.sha1 expected_library) actual_sha1) deployed_md5! - (at ///hash.equivalence = + (of ///hash.equivalence = (///hash.md5 expected_library) actual_md5)]] (in (and succeeded! diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 64060127b..6f681c74d 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -64,7 +64,7 @@ dependee_artifact $///artifact.random depender_artifact (random.only (predicate.complement - (at ///artifact.equivalence = dependee_artifact)) + (of ///artifact.equivalence = dependee_artifact)) $///artifact.random) [_ dependee_package] $///package.random @@ -75,11 +75,11 @@ depender [///dependency.#artifact depender_artifact ///dependency.#type ///artifact/type.lux_library] - dependee_pom (|> (at ///.monoid identity) + dependee_pom (|> (of ///.monoid identity) (has ///.#identity {.#Some dependee_artifact}) ///pom.write try.trusted) - depender_pom (|> (at ///.monoid identity) + depender_pom (|> (of ///.monoid identity) (has ///.#identity {.#Some depender_artifact}) (has ///.#dependencies (set.of_list ///dependency.hash (list dependee))) ///pom.write @@ -88,15 +88,15 @@ dependee_package (|> dependee_package (has ///package.#origin {///repository/origin.#Remote ""}) (has ///package.#pom [dependee_pom - (|> dependee_pom (at xml.codec encoded) (at utf8.codec encoded)) + (|> dependee_pom (of xml.codec encoded) (of utf8.codec encoded)) {///dependency/status.#Unverified}])) depender_package (|> depender_package (has ///package.#origin {///repository/origin.#Remote ""}) (has ///package.#pom [depender_pom - (|> depender_pom (at xml.codec encoded) (at utf8.codec encoded)) + (|> depender_pom (of xml.codec encoded) (of utf8.codec encoded)) {///dependency/status.#Unverified}])) - fs (file.mock (at file.default separator)) + fs (file.mock (of file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] (in (do async.monad [verdict (do ///action.monad @@ -105,7 +105,7 @@ pre (|> ///dependency/resolution.empty (dictionary.has dependee dependee_package) (///dependency/deployment.all local)) - post (|> (at ///.monoid identity) + post (|> (of ///.monoid identity) (has ///.#dependencies (set.of_list ///dependency.hash (list dependee depender))) (/.do! console local (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index d942a9d17..5127ca1fc 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -42,7 +42,7 @@ (def .public (make_sources! fs sources) (-> (file.System Async) (Set file.Path) (Action (List Any))) - (let [/ (at fs separator) + (let [/ (of fs separator) ! ///action.monad] (|> sources set.list @@ -59,18 +59,18 @@ [.let [console ($version.echo "")] _ (..make_sources! fs (the ///.#sources sample)) _ (/.do! console fs (///repository/local.repository program fs) sample)] - (at console read_line []))) + (of console read_line []))) (def .public test Test (<| (_.covering /._) (do [! random.monad] [identity $artifact.random - sample (at ! each (has ///.#identity {.#Some identity}) + sample (of ! each (has ///.#identity {.#Some identity}) $profile.random) home (random.alphabetic 5) working_directory (random.alphabetic 5) - .let [/ (at file.default separator)]] + .let [/ (of file.default separator)]] (all _.and (in (do [! async.monad] [.let [fs (file.mock /) @@ -80,16 +80,16 @@ library_path (format artifact_path ///artifact/extension.lux_library) pom_path (format artifact_path ///artifact/extension.pom)] verdict (do [! ///action.monad] - [succeeded! (at ! each (text#= /.success) + [succeeded! (of ! each (text#= /.success) (..execute! program fs sample)) library_exists! (|> library_path (format home /) - (at fs file?) - (at async.monad each (|>> {try.#Success}))) + (of fs file?) + (of async.monad each (|>> {try.#Success}))) pom_exists! (|> pom_path (format home /) - (at fs file?) - (at async.monad each (|>> {try.#Success})))] + (of fs file?) + (of async.monad each (|>> {try.#Success})))] (in (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 0d304f19d..a8e75ef1d 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -37,7 +37,7 @@ (<| (_.covering /._) (do random.monad [sample @profile.random - .let [fs (file.mock (at file.default separator))]] + .let [fs (file.mock (of file.default separator))]] (in (do [! async.monad] [.let [console (@version.echo "")] outcome (/.do! console fs sample)] @@ -46,14 +46,14 @@ (do ! [verdict (do ///action.monad [expected (|> (///pom.write sample) - (try#each (|>> (at xml.codec encoded) - (at utf8.codec encoded))) - (at ! in)) - actual (at fs read ///pom.file) + (try#each (|>> (of xml.codec encoded) + (of utf8.codec encoded))) + (of ! in)) + actual (of fs read ///pom.file) - logging! (at ///action.monad each + logging! (of ///action.monad each (text#= /.success) - (at console read_line [])) + (of console read_line [])) .let [expected_content! (binary#= expected actual)]] diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 31afea06b..f8f5bb935 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -51,7 +51,7 @@ home (random.alphabetic 5) working_directory (random.alphabetic 5) .let [empty_profile (is Profile - (at ///.monoid identity)) + (of ///.monoid identity)) with_target (is (-> Profile Profile) (has ///.#target target)) with_test (is (-> Profile Profile) @@ -62,17 +62,17 @@ with_target)] [compiler resolution] @build.resolution] (all _.and - (let [fs (file.mock (at file.default separator)) + (let [fs (file.mock (of file.default separator)) console (@version.echo "")] (in (do async.monad [verdict (do ///action.monad [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (@build.good_shell [])) resolution (has ///.#lux compiler profile)) - build_start (at console read_line []) - build_end (at console read_line []) - test_start (at console read_line []) - test_end (at console read_line [])] + build_start (of console read_line []) + build_end (of console read_line []) + test_start (of console read_line []) + test_end (of console read_line [])] (in (and (and (text#= //build.start build_start) (text#= //build.success build_end)) (and (text#= /.start test_start) @@ -80,7 +80,7 @@ (unit.coverage [/.do! /.start /.success] (try.else false verdict))))) - (let [fs (file.mock (at file.default separator)) + (let [fs (file.mock (of file.default separator)) console (@version.echo "")] (in (do async.monad [verdict (do ///action.monad @@ -105,10 +105,10 @@ _ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async bad_shell) resolution (has ///.#lux compiler profile)) - build_start (at console read_line []) - build_end (at console read_line []) - test_start (at console read_line []) - test_end (at console read_line [])] + build_start (of console read_line []) + build_end (of console read_line []) + test_start (of console read_line []) + test_end (of console read_line [])] (in (and (and (text#= //build.start build_start) (text#= //build.success build_end)) (and (text#= /.start test_start) diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux index 169b20ef6..e1e34170e 100644 --- a/stdlib/source/test/aedifex/command/version.lux +++ b/stdlib/source/test/aedifex/command/version.lux @@ -72,7 +72,7 @@ [.let [console (..echo "")] verdict (do (try.with async.monad) [_ (/.do! console profile) - logging (at console read_line [])] + logging (of console read_line [])] (in (text#= (version.format lux_version.latest) logging)))] (unit.coverage [/.do!] -- cgit v1.2.3