Simplified the API for file-system operations.

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)
+      ))