diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux/world/file/watch.lux | 155 |
1 files changed, 155 insertions, 0 deletions
diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux new file mode 100644 index 000000000..8d27ab307 --- /dev/null +++ b/stdlib/source/test/lux/world/file/watch.lux @@ -0,0 +1,155 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [predicate (#+ Predicate)] + [monad (#+ do)]] + [control + ["." try] + ["." exception] + [concurrency + ["." promise]] + [security + ["!" capability]]] + [data + ["." binary ("#\." equivalence)] + ["." text ("#\." equivalence) + ["%" format (#+ format)]] + [collection + ["." list]]] + [math + ["." random (#+ Random) ("#\." monad)]]] + {1 + ["." /]} + [//// + [data + ["_." binary]]]) + +(def: concern + (Random [/.Concern (Predicate /.Concern)]) + ($_ random.either + (random\wrap [/.creation /.creation?]) + (random\wrap [/.modification /.modification?]) + (random\wrap [/.deletion /.deletion?]) + )) + +(def: concern\\test + Test + (<| (_.with-cover [/.Concern]) + ($_ _.and + (_.cover [/.creation /.creation?] + (and (/.creation? /.creation) + (not (/.creation? /.modification)) + (not (/.creation? /.deletion)))) + (_.cover [/.modification /.modification?] + (and (not (/.modification? /.creation)) + (/.modification? /.modification) + (not (/.modification? /.deletion)))) + (_.cover [/.deletion /.deletion?] + (and (not (/.deletion? /.creation)) + (not (/.deletion? /.modification)) + (/.deletion? /.deletion))) + (do random.monad + [left ..concern + right (random.filter (|>> (is? left) not) + ..concern) + #let [[left left?] left + [right right?] right]] + (_.cover [/.also] + (let [composition (/.also left right)] + (and (left? composition) + (right? composition))))) + (_.cover [/.all] + (and (/.creation? /.all) + (/.modification? /.all) + (/.deletion? /.all))) + ))) + +(def: exception + Test + (do {! random.monad} + [directory (random.ascii/alpha 5) + #let [[fs watcher] (/.mock "/")]] + ($_ _.and + (wrap (do promise.monad + [?concern (:: watcher concern directory) + ?stop (:: watcher stop directory)] + (_.cover' [/.not-being-watched] + (and (case ?concern + (#try.Failure error) + (exception.match? /.not-being-watched error) + + (#try.Success _) + false) + (case ?stop + (#try.Failure error) + (exception.match? /.not-being-watched error) + + (#try.Success _) + false))))) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Watcher]) + ($_ _.and + ..concern\\test + ..exception + + (do {! random.monad} + [directory (random.ascii/alpha 5) + #let [/ "/" + [fs watcher] (/.mock /)] + expected-path (:: ! map (|>> (format directory /)) + (random.ascii/alpha 5)) + data (_binary.random 10)] + (wrap (do {! promise.monad} + [verdict (do (try.with !) + [_ (!.use (:: fs create-directory) [directory]) + _ (:: watcher start /.all directory) + poll/0 (:: watcher poll []) + #let [no-events-prior-to-creation! + (list.empty? poll/0)] + file (!.use (:: fs create-file) [expected-path]) + poll/1 (:: watcher poll []) + #let [after-creation! + (case poll/1 + (^ (list [actual-path concern])) + (and (text\= expected-path actual-path) + (and (/.creation? concern) + (not (/.modification? concern)) + (not (/.deletion? concern)))) + + _ + false)] + _ (!.use (:: file over-write) data) + poll/2 (:: watcher poll []) + #let [after-modification! + (case poll/2 + (^ (list [actual-path concern])) + (and (text\= expected-path actual-path) + (and (not (/.creation? concern)) + (/.modification? concern) + (not (/.deletion? concern)))) + + _ + false)] + _ (!.use (:: file delete) []) + poll/3 (:: watcher poll []) + #let [after-deletion! + (case poll/3 + (^ (list [actual-path concern])) + (and (not (/.creation? concern)) + (not (/.modification? concern)) + (/.deletion? concern)) + + _ + false)]] + (wrap (and no-events-prior-to-creation! + after-creation! + after-modification! + after-deletion!)))] + (_.cover' [/.mock /.polling] + (try.default false verdict))))) + ))) |