aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/spec
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/spec')
-rw-r--r--stdlib/source/spec/lux/world/file.lux351
1 files changed, 351 insertions, 0 deletions
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)
+ ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 15:31:00 +0000