From 2b909032e7a0bd10cd7db52067d2fb701bfa95e5 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 6 Jul 2021 21:34:21 -0400 Subject: Simplified the API for file-system operations. --- stdlib/source/spec/lux/world/file.lux | 351 ++++++++++++++++++++++++++++++++++ 1 file changed, 351 insertions(+) create mode 100644 stdlib/source/spec/lux/world/file.lux (limited to 'stdlib/source/spec') diff --git a/stdlib/source/spec/lux/world/file.lux b/stdlib/source/spec/lux/world/file.lux new file mode 100644 index 000000000..8a13279ad --- /dev/null +++ b/stdlib/source/spec/lux/world/file.lux @@ -0,0 +1,351 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + ["." predicate]] + [control + [pipe (#+ case>)] + [io (#+ IO)] + ["." try ("#\." functor)] + ["." exception] + [concurrency + ["." promise (#+ Promise)]]] + [data + ["." maybe ("#\." functor)] + ["." text ("#\." equivalence) + ["%" format (#+ format)] + [encoding + ["." utf8 ("#\." codec)]]] + ["." binary (#+ Binary) ("#\." equivalence monoid) + {[0 #test] + ["$#" /]}] + [collection + ["." list]]] + [math + ["." random] + [number + ["n" nat]]] + [time + ["." instant (#+ Instant) ("#\." equivalence)]]] + {1 + ["." /]}) + +(def: (for_path fs) + (-> (IO (/.System Promise)) Test) + (<| (_.for [/.Path]) + (do {! random.monad} + [parent (random.ascii/numeric 2) + child (random.ascii/numeric 2)]) + wrap + (do promise.monad + [fs (promise.future fs)] + ($_ _.and' + (_.cover' [/.un_nest] + (and (|> (/.un_nest fs parent) + (case> (#.Some _) + false + + #.None + true)) + (|> (/.un_nest fs child) + (case> (#.Some _) + false + + #.None + true)))) + (_.cover' [/.nest] + (|> (/.nest fs parent child) + (/.un_nest fs) + (case> (#.Some [parent' child']) + (and (text\= parent parent') + (text\= child child')) + + #.None + false))) + (_.cover' [/.parent] + (|> (/.nest fs parent child) + (/.parent fs) + (maybe\map (text\= parent)) + (maybe.default false))) + (_.cover' [/.name] + (|> (/.nest fs parent child) + (/.name fs) + (text\= child))) + )))) + +(def: (directory?&make_directory fs parent) + (-> (/.System Promise) /.Path (Promise Bit)) + (do promise.monad + [directory_pre! (\ fs directory? parent) + made? (\ fs make_directory parent) + directory_post! (\ fs directory? parent)] + (wrap (and (not directory_pre!) + (case made? + (#try.Success _) true + (#try.Failure _) false) + directory_post!)))) + +(def: (file?&write fs content path) + (-> (/.System Promise) Binary /.Path (Promise Bit)) + (do promise.monad + [file_pre! (\ fs file? path) + made? (\ fs write content path) + file_post! (\ fs file? path)] + (wrap (and (not file_pre!) + (case made? + (#try.Success _) true + (#try.Failure _) false) + file_post!)))) + +(def: (file_size&read&append fs expected_file_size content appendix path) + (-> (/.System Promise) Nat Binary Binary /.Path (Promise Bit)) + (do promise.monad + [pre_file_size (\ fs file_size path) + pre_content (\ fs read path) + appended? (\ fs append appendix path) + post_file_size (\ fs file_size path) + post_content (\ fs read path)] + (wrap (<| (try.default false) + (do {! try.monad} + [pre_file_size! + (\ ! map (n.= expected_file_size) pre_file_size) + + pre_content! + (\ ! map (binary\= content) pre_content) + + _ appended? + + post_file_size! + (\ ! map (n.= (n.* 2 expected_file_size)) post_file_size) + + post_content! + (\ ! map (binary\= (binary\compose content appendix)) post_content)] + (wrap (and pre_file_size! + pre_content! + post_file_size! + post_content!))))))) + +(def: (modified?&last_modified fs expected_time path) + (-> (/.System Promise) Instant /.Path (Promise Bit)) + (do promise.monad + [modified? (\ fs modify expected_time path) + last_modified (\ fs last_modified path)] + (wrap (<| (try.default false) + (do {! try.monad} + [_ modified?] + (\ ! map (instant\= expected_time) last_modified)))))) + +(def: (directory_files&sub_directories fs parent sub_dir child) + (-> (/.System Promise) /.Path /.Path /.Path (Promise Bit)) + (let [sub_dir (/.nest fs parent sub_dir) + child (/.nest fs parent child)] + (do promise.monad + [made_sub? (\ fs make_directory sub_dir) + directory_files (\ fs directory_files parent) + sub_directories (\ fs sub_directories parent) + #let [(^open "list\.") (list.equivalence text.equivalence)]] + (wrap (<| (try.default false) + (do try.monad + [_ made_sub?] + (wrap (and (|> directory_files + (try\map (list\= (list child))) + (try.default false)) + (|> sub_directories + (try\map (list\= (list sub_dir))) + (try.default false)))))))))) + +(def: (move&delete fs parent child alternate_child) + (-> (/.System Promise) /.Path Text Text (Promise Bit)) + (let [origin (/.nest fs parent child) + destination (/.nest fs parent alternate_child)] + (do {! promise.monad} + [moved? (\ fs move destination origin) + lost? (|> origin + (\ fs file?) + (\ ! map not)) + found? (\ fs file? destination) + deleted? (\ fs delete destination)] + (wrap (<| (try.default false) + (do try.monad + [_ moved? + _ deleted?] + (wrap (and lost? + found?)))))))) + +(def: (for_system fs) + (-> (IO (/.System Promise)) Test) + (<| (do {! random.monad} + [parent (random.ascii/numeric 2) + child (random.ascii/numeric 2) + sub_dir (random.filter (|>> (text\= child) not) + (random.ascii/numeric 2)) + alternate_child (random.filter (predicate.intersect + (|>> (text\= child) not) + (|>> (text\= sub_dir) not)) + (random.ascii/numeric 2)) + expected_file_size (\ ! map (|>> (n.% 10) inc) random.nat) + content ($binary.random expected_file_size) + appendix ($binary.random expected_file_size) + expected_time random.instant]) + wrap + (do {! promise.monad} + [fs (promise.future fs) + #let [path (/.nest fs parent child)] + + directory?&make_directory + (..directory?&make_directory fs parent) + + file?&write + (..file?&write fs content path) + + file_size&read&append + (..file_size&read&append fs expected_file_size content appendix path) + + modified?&last_modified + (..modified?&last_modified fs expected_time path) + + can_execute? + (|> path + (\ fs can_execute?) + (\ ! map (|>> (try.default true) not))) + + directory_files&sub_directories + (..directory_files&sub_directories fs parent sub_dir child) + + move&delete + (..move&delete fs parent child alternate_child)]) + (_.cover' [/.System] + (and directory?&make_directory + file?&write + file_size&read&append + modified?&last_modified + can_execute? + directory_files&sub_directories + move&delete)))) + +(def: (make_directories&cannot_make_directory fs) + (-> (IO (/.System Promise)) Test) + (<| (do {! random.monad} + [dir/0 (random.ascii/numeric 2) + dir/1 (random.ascii/numeric 2) + dir/2 (random.ascii/numeric 2)]) + wrap + (do {! promise.monad} + [fs (promise.future fs) + #let [dir/1 (/.nest fs dir/0 dir/1) + dir/2 (/.nest fs dir/1 dir/2)] + pre_dir/0 (\ fs directory? dir/0) + pre_dir/1 (\ fs directory? dir/1) + pre_dir/2 (\ fs directory? dir/2) + made? (/.make_directories ! fs dir/2) + post_dir/0 (\ fs directory? dir/0) + post_dir/1 (\ fs directory? dir/1) + post_dir/2 (\ fs directory? dir/2) + + cannot_make_directory!/0 (/.make_directories ! fs "") + cannot_make_directory!/1 (/.make_directories ! fs (\ fs separator))]) + ($_ _.and' + (_.cover' [/.make_directories] + (and (not pre_dir/0) + (not pre_dir/1) + (not pre_dir/2) + (case made? + (#try.Success _) true + (#try.Failure _) false) + post_dir/0 + post_dir/1 + post_dir/2)) + (_.cover' [/.cannot_make_directory] + (and (case cannot_make_directory!/0 + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.cannot_make_directory error)) + (case cannot_make_directory!/1 + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.cannot_make_directory error)))) + ))) + +(def: (make_file&cannot_make_file fs) + (-> (IO (/.System Promise)) Test) + (<| (do {! random.monad} + [file/0 (random.ascii/numeric 3)]) + wrap + (do {! promise.monad} + [fs (promise.future fs) + make_file!/0 (/.make_file ! fs (utf8\encode file/0) file/0) + make_file!/1 (/.make_file ! fs (utf8\encode file/0) file/0)]) + ($_ _.and' + (_.cover' [/.make_file] + (case make_file!/0 + (#try.Success _) true + (#try.Failure error) false)) + (_.cover' [/.cannot_make_file] + (case make_file!/1 + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.cannot_make_file error))) + ))) + +(def: (for_utilities fs) + (-> (IO (/.System Promise)) Test) + ($_ _.and + (..make_directories&cannot_make_directory fs) + (..make_file&cannot_make_file fs) + )) + +(def: (exists? fs) + (-> (IO (/.System Promise)) Test) + (<| (do {! random.monad} + [file (random.ascii/numeric 2) + dir (random.filter (|>> (text\= file) not) + (random.ascii/numeric 2))]) + wrap + (do {! promise.monad} + [fs (promise.future fs) + + pre_file/0 (\ fs file? file) + pre_file/1 (/.exists? ! fs file) + pre_dir/0 (\ fs directory? dir) + pre_dir/1 (/.exists? ! fs dir) + + made_file? (/.make_file ! fs (utf8\encode file) file) + made_dir? (\ fs make_directory dir) + + post_file/0 (\ fs file? file) + post_file/1 (/.exists? ! fs file) + post_dir/0 (\ fs directory? dir) + post_dir/1 (/.exists? ! fs dir)]) + (_.cover' [/.exists?] + (and (not pre_file/0) + (not pre_file/1) + (not pre_dir/0) + (not pre_dir/1) + + (case made_file? + (#try.Success _) true + (#try.Failure _) false) + (case made_dir? + (#try.Success _) true + (#try.Failure _) false) + + post_file/0 + post_file/1 + post_dir/0 + post_dir/1)))) + +(def: #export (spec fs) + (-> (IO (/.System Promise)) Test) + ($_ _.and + (..for_path fs) + (..for_utilities fs) + (..for_system fs) + (..exists? fs) + )) -- cgit v1.2.3