diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/aedifex.lux | 4 | ||||
| -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 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 27 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/file.lux | 199 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/file/watch.lux | 131 |
13 files changed, 292 insertions, 461 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 09ffcd3d8..b6f54f8f4 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -3,7 +3,7 @@ [program (#+ program:)] ["_" test (#+ Test)] [control - [io (#+ io)]]] + ["." io]]] ["." / #_ ["#." artifact] ["#." cli] @@ -54,7 +54,7 @@ )) (program: args - (<| io + (<| io.io _.run! (_.times 100) ..test)) 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) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index bc7231470..beebb2844 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -11,7 +11,7 @@ [monad (#+ do)] [predicate (#+ Predicate)]] [control - ["." io (#+ io)] + ["." io] [concurrency ["." atom (#+ Atom)]]] [data @@ -260,21 +260,14 @@ ))) (program: args - (let [shift (for {@.jvm 1 - @.old 1 - @.js 2 - @.python 6} - 0) - time_out (|> 1 - (i64.left_shift shift) - (n.* 1,000)) - times (: (-> Test Test) - (for {@.js (_.times 10) - @.python (_.times 1) - @.lua (_.times 1) - @.ruby (_.times 1)} - (_.times' (#.Some time_out) 100)))] - (<| io + (let [times (for {@.old 100 + @.jvm 100 + @.js 10 + @.python 1 + @.lua 1 + @.ruby 1} + 100)] + (<| io.io _.run! - times + (_.times times) ..test))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index 8a0c416be..4b9f8655a 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -1,206 +1,27 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] - [abstract/monad (#+ do)] + [abstract + [monad (#+ do)]] [control - ["." io (#+ IO)] - ["." try (#+ Try)] - [concurrency - ["." promise]]] - [data - ["." binary (#+ Binary)] - ["." text] - [collection - ["." list]]] + ["." io]] [math - ["." random (#+ Random) ("#\." monad)] - [number - ["n" nat] - ["i" int]]] - [time - ["." instant] - ["." duration]]] + ["." random]]] ["." / #_ ["#." watch]] {1 - ["." / (#+ Path File)]} - [/// - [data - ["_." binary]]]) - -(def: truncate_millis - (let [millis +1,000] - (|>> (i./ millis) (i.* millis)))) - -## (def: (creation_and_deletion number) -## (-> Nat Test) -## (random\wrap -## (do promise.monad -## [#let [path (format "temp_file_" (%.nat number))] -## result (promise.future -## (do (try.with io.monad) -## [#let [check_existence! (: (IO (Try Bit)) -## (try.lift io.monad (/.exists? io.monad /.default path)))] -## pre! check_existence! -## file (!.use (\ /.default create_file) path) -## post! check_existence! -## _ (!.use (\ file delete) []) -## remains? check_existence!] -## (wrap (and (not pre!) -## post! -## (not remains?)))))] -## (_.assert "Can create/delete files." -## (try.default #0 result))))) - -## (def: (read_and_write number data) -## (-> Nat Binary Test) -## (random\wrap -## (do promise.monad -## [#let [path (format "temp_file_" (%.nat number))] -## result (promise.future -## (do (try.with io.monad) -## [file (!.use (\ /.default create_file) path) -## _ (!.use (\ file over_write) data) -## content (!.use (\ file content) []) -## _ (!.use (\ file delete) [])] -## (wrap (\ binary.equivalence = data content))))] -## (_.assert "Can write/read files." -## (try.default #0 result))))) + ["." /]} + {[1 #spec] + ["$." /]}) (def: #export test Test (<| (_.covering /._) (do {! random.monad} - [file_size (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10)))) - dataL (_binary.random file_size) - dataR (_binary.random file_size) - new_modified (|> random.int (\ ! map (|>> i.abs - (i.% +10,000,000,000,000) - truncate_millis - duration.from_millis - instant.absolute)))] + [/ (random.ascii/upper 1)] ($_ _.and - ## (..creation_and_deletion 0) - ## (..read_and_write 1 dataL) + (_.for [/.mock] + ($/.spec (io.io (/.mock /)))) - ## (wrap (do promise.monad - ## [#let [path "temp_file_2"] - ## result (promise.future - ## (do (try.with io.monad) - ## [file (!.use (\ /.default create_file) path) - ## _ (!.use (\ file over_write) dataL) - ## read_size (!.use (\ file size) []) - ## _ (!.use (\ file delete) [])] - ## (wrap (n.= file_size read_size))))] - ## (_.assert "Can read file size." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [path "temp_file_3"] - ## result (promise.future - ## (do (try.with io.monad) - ## [file (!.use (\ /.default create_file) path) - ## _ (!.use (\ file over_write) dataL) - ## _ (!.use (\ file append) dataR) - ## content (!.use (\ file content) []) - ## read_size (!.use (\ file size) []) - ## _ (!.use (\ file delete) [])] - ## (wrap (and (n.= (n.* 2 file_size) read_size) - ## (\ binary.equivalence = - ## dataL - ## (try.assume (binary.slice 0 file_size content))) - ## (\ binary.equivalence = - ## dataR - ## (try.assume (binary.slice file_size (n.- file_size read_size) content)))))))] - ## (_.assert "Can append to files." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [path "temp_dir_4"] - ## result (promise.future - ## (do (try.with io.monad) - ## [#let [check_existence! (: (IO (Try Bit)) - ## (try.lift io.monad (/.exists? io.monad /.default path)))] - ## pre! check_existence! - ## dir (!.use (\ /.default create_directory) path) - ## post! check_existence! - ## _ (!.use (\ dir discard) []) - ## remains? check_existence!] - ## (wrap (and (not pre!) - ## post! - ## (not remains?)))))] - ## (_.assert "Can create/delete directories." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [file_path "temp_file_5" - ## dir_path "temp_dir_5"] - ## result (promise.future - ## (do (try.with io.monad) - ## [dir (!.use (\ /.default create_directory) dir_path) - ## file (!.use (\ /.default create_file) (format dir_path "/" file_path)) - ## _ (!.use (\ file over_write) dataL) - ## read_size (!.use (\ file size) []) - ## _ (!.use (\ file delete) []) - ## _ (!.use (\ dir discard) [])] - ## (wrap (n.= file_size read_size))))] - ## (_.assert "Can create files inside of directories." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [file_path "temp_file_6" - ## dir_path "temp_dir_6" - ## inner_dir_path "inner_temp_dir_6"] - ## result (promise.future - ## (do (try.with io.monad) - ## [dir (!.use (\ /.default create_directory) dir_path) - ## pre_files (!.use (\ dir files) []) - ## pre_directories (!.use (\ dir directories) []) - - ## file (!.use (\ /.default create_file) (format dir_path "/" file_path)) - ## inner_dir (!.use (\ /.default create_directory) (format dir_path "/" inner_dir_path)) - ## post_files (!.use (\ dir files) []) - ## post_directories (!.use (\ dir directories) []) - - ## _ (!.use (\ file delete) []) - ## _ (!.use (\ inner_dir discard) []) - ## _ (!.use (\ dir discard) [])] - ## (wrap (and (and (n.= 0 (list.size pre_files)) - ## (n.= 0 (list.size pre_directories))) - ## (and (n.= 1 (list.size post_files)) - ## (n.= 1 (list.size post_directories)))))))] - ## (_.assert "Can list files/directories inside a directory." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [path "temp_file_7"] - ## result (promise.future - ## (do (try.with io.monad) - ## [file (!.use (\ /.default create_file) path) - ## _ (!.use (\ file over_write) dataL) - ## _ (!.use (\ file modify) new_modified) - ## current_modified (!.use (\ file last_modified) []) - ## _ (!.use (\ file delete) [])] - ## (wrap (\ instant.equivalence = new_modified current_modified))))] - ## (_.assert "Can change the time of last modification." - ## (try.default #0 result)))) - ## (wrap (do promise.monad - ## [#let [path0 (format "temp_file_8+0") - ## path1 (format "temp_file_8+1")] - ## result (promise.future - ## (do (try.with io.monad) - ## [#let [check_existence! (: (_> Path (IO (Try Bit))) - ## (|>> (/.exists? io.monad /.default) - ## (try.lift io.monad)))] - ## file0 (!.use (\ /.default create_file) path0) - ## _ (!.use (\ file0 over_write) dataL) - ## pre! (check_existence! path0) - ## file1 (: (IO (Try (File IO))) ## TODO: Remove : - ## (!.use (\ file0 move) path1)) - ## post! (check_existence! path0) - ## confirmed? (check_existence! path1) - ## _ (!.use (\ file1 delete) [])] - ## (wrap (and pre! - ## (not post!) - ## confirmed?))))] - ## (_.assert "Can move a file from one path to another." - ## (try.default #0 result)))) - /watch.test )))) diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux index 9c1b31811..57511136e 100644 --- a/stdlib/source/test/lux/world/file/watch.lux +++ b/stdlib/source/test/lux/world/file/watch.lux @@ -5,12 +5,12 @@ [predicate (#+ Predicate)] [monad (#+ do)]] [control - ["." try] + ["." try (#+ Try)] ["." exception] [concurrency - ["." promise]]] + ["." promise (#+ Promise)]]] [data - ["." binary ("#\." equivalence)] + ["." binary (#+ Binary) ("#\." equivalence)] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection @@ -18,10 +18,11 @@ [math ["." random (#+ Random) ("#\." monad)]]] {1 - ["." /]} + ["." / + ["/#" //]]} [//// [data - ["_." binary]]]) + ["$." binary]]]) (def: concern (Random [/.Concern (Predicate /.Concern)]) @@ -87,6 +88,66 @@ false))))) ))) +(def: (no_events_prior_to_creation! fs watcher directory) + (-> (//.System Promise) (/.Watcher Promise) //.Path (Promise (Try Bit))) + (do {! (try.with promise.monad)} + [_ (\ fs make_directory directory) + _ (\ watcher start /.all directory)] + (|> (\ watcher poll []) + (\ ! map list.empty?)))) + +(def: (after_creation! fs watcher expected_path) + (-> (//.System Promise) (/.Watcher Promise) //.Path (Promise (Try Bit))) + (do (try.with promise.monad) + [_ (: (Promise (Try Any)) + (//.make_file promise.monad fs (binary.create 0) expected_path)) + poll/pre (\ watcher poll []) + poll/post (\ watcher poll [])] + (wrap (and (case poll/pre + (^ (list [concern actual_path])) + (and (text\= expected_path actual_path) + (and (/.creation? concern) + (not (/.modification? concern)) + (not (/.deletion? concern)))) + + _ + false) + (list.empty? poll/post))))) + +(def: (after_modification! fs watcher data expected_path) + (-> (//.System Promise) (/.Watcher Promise) Binary //.Path (Promise (Try Bit))) + (do (try.with promise.monad) + [_ (promise.delay 1 (#try.Success "Delay to make sure the over_write time-stamp always changes.")) + _ (\ fs write data expected_path) + poll/2 (\ watcher poll []) + poll/2' (\ watcher poll [])] + (wrap (and (case poll/2 + (^ (list [concern actual_path])) + (and (text\= expected_path actual_path) + (and (not (/.creation? concern)) + (/.modification? concern) + (not (/.deletion? concern)))) + + _ + false) + (list.empty? poll/2'))))) + +(def: (after_deletion! fs watcher expected_path) + (-> (//.System Promise) (/.Watcher Promise) //.Path (Promise (Try Bit))) + (do (try.with promise.monad) + [_ (\ fs delete expected_path) + poll/3 (\ watcher poll []) + poll/3' (\ watcher poll [])] + (wrap (and (case poll/3 + (^ (list [concern actual_path])) + (and (not (/.creation? concern)) + (not (/.modification? concern)) + (/.deletion? concern)) + + _ + false) + (list.empty? poll/3'))))) + (def: #export test Test (<| (_.covering /._) @@ -101,56 +162,20 @@ [fs watcher] (/.mock /)] expected_path (\ ! map (|>> (format directory /)) (random.ascii/alpha 5)) - data (_binary.random 10)] + data ($binary.random 10)] (wrap (do {! promise.monad} [verdict (do (try.with !) - [_ (\ fs create_directory directory) - _ (\ watcher start /.all directory) - poll/0 (\ watcher poll []) - #let [no_events_prior_to_creation! - (list.empty? poll/0)] - file (\ fs create_file expected_path) - poll/1 (\ watcher poll []) - poll/1' (\ watcher poll []) - #let [after_creation! - (and (case poll/1 - (^ (list [actual_path concern])) - (and (text\= expected_path actual_path) - (and (/.creation? concern) - (not (/.modification? concern)) - (not (/.deletion? concern)))) - - _ - false) - (list.empty? poll/1'))] - _ (promise.delay 1 (#try.Success "Delay to make sure the over_write time-stamp always changes.")) - _ (\ file over_write data) - poll/2 (\ watcher poll []) - poll/2' (\ watcher poll []) - #let [after_modification! - (and (case poll/2 - (^ (list [actual_path concern])) - (and (text\= expected_path actual_path) - (and (not (/.creation? concern)) - (/.modification? concern) - (not (/.deletion? concern)))) - - _ - false) - (list.empty? poll/2'))] - _ (\ file delete []) - poll/3 (\ watcher poll []) - poll/3' (\ watcher poll []) - #let [after_deletion! - (and (case poll/3 - (^ (list [actual_path concern])) - (and (not (/.creation? concern)) - (not (/.modification? concern)) - (/.deletion? concern)) - - _ - false) - (list.empty? poll/3'))]] + [no_events_prior_to_creation! + (..no_events_prior_to_creation! fs watcher directory) + + after_creation! + (..after_creation! fs watcher expected_path) + + after_modification! + (..after_modification! fs watcher data expected_path) + + after_deletion! + (..after_deletion! fs watcher expected_path)] (wrap (and no_events_prior_to_creation! after_creation! after_modification! |