From a82bd1eabe94763162c2b0707d9c198fbe9835e3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 18 Jun 2021 14:21:41 -0400 Subject: Refactored the machinery to make local macros into its own module. --- stdlib/source/test/aedifex/command.lux | 30 +-- stdlib/source/test/aedifex/command/build.lux | 9 +- stdlib/source/test/aedifex/command/deploy.lux | 36 ++-- stdlib/source/test/aedifex/command/deps.lux | 43 +++- stdlib/source/test/aedifex/command/test.lux | 4 +- .../source/test/aedifex/dependency/resolution.lux | 232 +++++++++++---------- 6 files changed, 199 insertions(+), 155 deletions(-) (limited to 'stdlib/source/test/aedifex') diff --git a/stdlib/source/test/aedifex/command.lux b/stdlib/source/test/aedifex/command.lux index 0ef18f044..e0cb2da79 100644 --- a/stdlib/source/test/aedifex/command.lux +++ b/stdlib/source/test/aedifex/command.lux @@ -2,16 +2,19 @@ [lux #* ["_" test (#+ Test)]] ["." / #_ + ["#." version] + ["#." pom] + ["#." clean] ["#." install] - ["#." pom] - ["#." version]] + + ["#." deps] + ["#." deploy] + + ["#." build] + ["#." test]] {#program ["." / - ## ["#." deploy] - ## ["#." deps] - ## ["#." build] - ## ["#." test] ## ["#." auto] ]}) @@ -20,13 +23,16 @@ (<| (_.covering /._) (_.for [/.Command]) ($_ _.and + /version.test + /pom.test + /clean.test /install.test - /pom.test - /version.test - ## /deploy.test - ## /deps.test - ## /build.test - ## /test.test + + /deps.test + /deploy.test + + /build.test + /test.test ## /auto.test ))) diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 8a4df9a7e..85231ae33 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -4,6 +4,7 @@ [abstract [monad (#+ do)]] [control + [io (#+ IO)] ["." try] ["." exception] [concurrency @@ -37,7 +38,7 @@ ["#/." resolution]]]]}) (def: #export good_shell - (-> Any (Shell Promise)) + (-> Any (Shell IO)) (shell.mock (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success @@ -55,7 +56,7 @@ (#try.Success [state shell.normal])))))))) (def: #export bad_shell - (-> Any (Shell Promise)) + (-> Any (Shell IO)) (shell.mock (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success @@ -98,7 +99,7 @@ (<| (_.covering /._) (do {! random.monad} [#let [fs (file.mock (\ file.default separator)) - shell (..good_shell [])] + shell (shell.async (..good_shell []))] program (random.ascii/alpha 5) target (random.ascii/alpha 5) home (random.ascii/alpha 5) @@ -162,7 +163,7 @@ resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (..bad_shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (..bad_shell [])) resolution profile) start (!.use (\ console read_line) []) end (!.use (\ console read_line) [])] (wrap (and (text\= /.start start) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 617b3386a..cc99f2e48 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -17,7 +17,8 @@ ["." binary] ["." text ("#\." equivalence) ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] ["." format #_ ["#" binary] ["." tar] @@ -108,31 +109,42 @@ (export.library fs) (\ ! map (format.run tar.writer))) - actual_pom (\ repository download (///repository/remote.uri artifact ///artifact/extension.pom)) - actual_library (\ repository download (///repository/remote.uri artifact ///artifact/extension.lux_library)) - actual_sha-1 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) - actual_md5 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) + actual_pom (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact ///artifact/extension.pom)) + actual_library (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact ///artifact/extension.lux_library)) + actual_sha-1 (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) + actual_sha-1 (\ promise.monad wrap + (do try.monad + [actual_sha-1 (\ utf8.codec decode actual_sha-1)] + (\ ///hash.sha-1_codec decode actual_sha-1))) + actual_md5 (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) + actual_md5 (\ promise.monad wrap + (do try.monad + [actual_md5 (\ utf8.codec decode actual_md5)] + (\ ///hash.md5_codec decode actual_md5))) - #let [deployed_library! + #let [succeeded! + (text\= //clean.success logging) + + deployed_library! (\ binary.equivalence = expected_library actual_library) deployed_pom! (\ binary.equivalence = - (|> expected_pom (\ xml.codec encode) (\ encoding.utf8 encode)) + (|> expected_pom (\ xml.codec encode) (\ utf8.codec encode)) actual_pom) deployed_sha-1! - (\ binary.equivalence = - (///hash.data (///hash.sha-1 expected_library)) + (\ ///hash.equivalence = + (///hash.sha-1 expected_library) actual_sha-1) deployed_md5! - (\ binary.equivalence = - (///hash.data (///hash.md5 expected_library)) + (\ ///hash.equivalence = + (///hash.md5 expected_library) actual_md5)]] - (wrap (and (text\= //clean.success logging) + (wrap (and succeeded! deployed_library! deployed_pom! deployed_sha-1! diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 99856c83c..8b5e3820e 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -14,10 +14,14 @@ ["." environment]]] [data ["." text ("#\." equivalence) - ["%" format (#+ format)]] + ["%" format (#+ format)] + [encoding + ["." utf8]]] [collection ["." dictionary] - ["." set]]] + ["." set]] + [format + ["." xml]]] [math ["." random (#+ Random)]] [world @@ -81,10 +85,14 @@ dependee_package (|> dependee_package (set@ #///package.origin (#///repository/origin.Remote "")) - (set@ #///package.pom [dependee_pom #///dependency/status.Unverified])) + (set@ #///package.pom [dependee_pom + (|> dependee_pom (\ xml.codec encode) (\ utf8.codec encode)) + #///dependency/status.Unverified])) depender_package (|> depender_package (set@ #///package.origin (#///repository/origin.Remote "")) - (set@ #///package.pom [depender_pom #///dependency/status.Unverified])) + (set@ #///package.pom [depender_pom + (|> depender_pom (\ xml.codec encode) (\ utf8.codec encode)) + #///dependency/status.Unverified])) fs (file.mock (\ file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] @@ -97,14 +105,29 @@ (///dependency/deployment.all local)) post (|> (\ ///.monoid identity) (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee depender))) - (/.do! console local (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) [])))) + (/.do! console local (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) + [])))) logging! (\ ///action.monad map (text\= //clean.success) - (!.use (\ console read_line) []))] + (!.use (\ console read_line) [])) + + #let [had_dependee_before! + (set.member? pre dependee_artifact) + + lacked_depender_before! + (not (set.member? pre depender_artifact)) + + had_dependee_after! + (dictionary.key? post dependee) + + had_depender_after! + (dictionary.key? post depender)]] (wrap (and logging! - (and (set.member? pre dependee_artifact) - (not (set.member? pre depender_artifact))) - (and (dictionary.key? post dependee) - (dictionary.key? post depender)))))] + + had_dependee_before! + lacked_depender_before! + + had_dependee_after! + had_depender_after!)))] (_.cover' [/.do!] (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 2d077ab87..9dd76ca08 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -62,7 +62,7 @@ console (@version.echo "")] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (@build.good_shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (@build.good_shell [])) resolution profile) build_start (!.use (\ console read_line) []) build_end (!.use (\ console read_line) []) test_start (!.use (\ console read_line) []) @@ -96,7 +96,7 @@ shell.normal shell.error)])))))) [])] - _ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs bad_shell resolution profile) + _ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async bad_shell) resolution profile) build_start (!.use (\ console read_line) []) build_end (!.use (\ console read_line) []) test_start (!.use (\ console read_line) []) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 4404cb32f..e9cd26a82 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -16,7 +16,8 @@ ["." product] ["." binary] ["." text - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml]] [collection @@ -59,38 +60,39 @@ (def: #export (single artifact package) (-> Artifact Package (Simulation Any)) - (structure - (def: (on_download uri state) - (if (text.contains? (///artifact.uri artifact) uri) - (cond (text.ends_with? ///artifact/extension.lux_library uri) - (#try.Success [state (|> package - (get@ #///package.library) - product.left)]) - - (text.ends_with? ///artifact/extension.pom uri) - (#try.Success [state (|> package - (get@ #///package.pom) - product.left - (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)] + (structure + (def: (on_download uri state) + (if (text.contains? expected uri) + (cond (text.ends_with? ///artifact/extension.lux_library uri) + (#try.Success [state (|> package + (get@ #///package.library) + product.left)]) + + (text.ends_with? ///artifact/extension.pom uri) + (#try.Success [state (|> package + (get@ #///package.pom) + product.left + (\ xml.codec encode) + (\ utf8.codec encode))]) - ## (text.ends_with? ///artifact/extension.sha-1 uri) - ## (#try.Success [state (|> package - ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) - - ## (text.ends_with? ///artifact/extension.md5 uri) - ## (#try.Success [state (|> package - ## (get@ #///package.md5) - ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (text.ends_with? ///artifact/extension.sha-1 uri) + ## (#try.Success [state (|> package + ## (get@ #///package.sha-1) + ## (\ ///hash.sha-1_codec encode) + ## (\ utf8.codec encode))]) + + ## (text.ends_with? ///artifact/extension.md5 uri) + ## (#try.Success [state (|> package + ## (get@ #///package.md5) + ## (\ ///hash.md5_codec encode) + ## (\ utf8.codec encode))]) - ## else - (#try.Failure "NOPE")) - (#try.Failure "NOPE"))) - (def: (on_upload uri binary state) - (#try.Failure "NOPE")))) + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on_upload uri binary state) + (#try.Failure "NOPE"))))) (def: one Test @@ -106,7 +108,7 @@ bad_sha-1 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -117,19 +119,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> dummy_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> expected_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -139,7 +141,7 @@ bad_md5 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -150,19 +152,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> expected_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> dummy_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -217,7 +219,7 @@ bad_sha-1 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -228,19 +230,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> dummy_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> expected_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -250,7 +252,7 @@ bad_md5 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -261,19 +263,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> expected_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> dummy_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -312,77 +314,77 @@ false)))) ))) -(def: all - Test - (do {! random.monad} - [dependee_artifact $///artifact.random - depender_artifact (random.filter (predicate.complement - (\ ///artifact.equivalence = dependee_artifact)) - $///artifact.random) - ignored_artifact (random.filter (predicate.complement - (predicate.unite (\ ///artifact.equivalence = dependee_artifact) - (\ ///artifact.equivalence = depender_artifact))) - $///artifact.random) +## (def: all +## Test +## (do {! random.monad} +## [dependee_artifact $///artifact.random +## depender_artifact (random.filter (predicate.complement +## (\ ///artifact.equivalence = dependee_artifact)) +## $///artifact.random) +## ignored_artifact (random.filter (predicate.complement +## (predicate.unite (\ ///artifact.equivalence = dependee_artifact) +## (\ ///artifact.equivalence = depender_artifact))) +## $///artifact.random) - [_ dependee_package] $///package.random - [_ depender_package] $///package.random - [_ ignored_package] $///package.random +## [_ dependee_package] $///package.random +## [_ depender_package] $///package.random +## [_ ignored_package] $///package.random - #let [dependee {#///dependency.artifact dependee_artifact - #///dependency.type ///artifact/type.lux_library} - depender {#///dependency.artifact depender_artifact - #///dependency.type ///artifact/type.lux_library} - ignored {#///dependency.artifact ignored_artifact - #///dependency.type ///artifact/type.lux_library} +## #let [dependee {#///dependency.artifact dependee_artifact +## #///dependency.type ///artifact/type.lux_library} +## depender {#///dependency.artifact depender_artifact +## #///dependency.type ///artifact/type.lux_library} +## ignored {#///dependency.artifact ignored_artifact +## #///dependency.type ///artifact/type.lux_library} - dependee_pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some dependee_artifact)) - ///pom.write - try.assume) - depender_pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some depender_artifact)) - (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee))) - ///pom.write - try.assume) - ignored_pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some ignored_artifact)) - ///pom.write - try.assume) - - dependee_package (set@ #///package.pom [dependee_pom #///dependency/status.Unverified] dependee_package) - depender_package (set@ #///package.pom [depender_pom #///dependency/status.Unverified] depender_package) - ignored_package (set@ #///package.pom [ignored_pom #///dependency/status.Unverified] ignored_package)]] - ($_ _.and - (wrap - (do promise.monad - [resolution (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) - (///repository.mock (..single depender_artifact depender_package) []) - (///repository.mock (..single ignored_artifact ignored_package) [])) - (list depender) - /.empty)] - (_.cover' [/.all] - (case resolution - (#try.Success resolution) - (and (dictionary.key? resolution depender) - (dictionary.key? resolution dependee) - (not (dictionary.key? resolution ignored))) +## dependee_pom (|> (\ ///.monoid identity) +## (set@ #///.identity (#.Some dependee_artifact)) +## ///pom.write +## try.assume) +## depender_pom (|> (\ ///.monoid identity) +## (set@ #///.identity (#.Some depender_artifact)) +## (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee))) +## ///pom.write +## try.assume) +## ignored_pom (|> (\ ///.monoid identity) +## (set@ #///.identity (#.Some ignored_artifact)) +## ///pom.write +## try.assume) - (#try.Failure error) - false)))) - ))) +## dependee_package (set@ #///package.pom [dependee_pom #///dependency/status.Unverified] dependee_package) +## depender_package (set@ #///package.pom [depender_pom #///dependency/status.Unverified] depender_package) +## ignored_package (set@ #///package.pom [ignored_pom #///dependency/status.Unverified] ignored_package)]] +## ($_ _.and +## (wrap +## (do promise.monad +## [resolution (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) +## (///repository.mock (..single depender_artifact depender_package) []) +## (///repository.mock (..single ignored_artifact ignored_package) [])) +## (list depender) +## /.empty)] +## (_.cover' [/.all] +## (case resolution +## (#try.Success resolution) +## (and (dictionary.key? resolution depender) +## (dictionary.key? resolution dependee) +## (not (dictionary.key? resolution ignored))) -(def: #export test - Test - (<| (_.covering /._) - (_.for [/.Resolution]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) +## (#try.Failure error) +## false)))) +## ))) + +## (def: #export test +## Test +## (<| (_.covering /._) +## (_.for [/.Resolution]) +## ($_ _.and +## (_.for [/.equivalence] +## ($equivalence.spec /.equivalence ..random)) + +## (_.cover [/.empty] +## (dictionary.empty? /.empty)) - (_.cover [/.empty] - (dictionary.empty? /.empty)) - - ..one - ..any - ..all - ))) +## ..one +## ..any +## ..all +## ))) -- cgit v1.2.3