aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/world/file.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test/lux/world/file.lux')
-rw-r--r--stdlib/source/test/lux/world/file.lux252
1 files changed, 237 insertions, 15 deletions
diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux
index 39e8d13dd..ee313599f 100644
--- a/stdlib/source/test/lux/world/file.lux
+++ b/stdlib/source/test/lux/world/file.lux
@@ -1,19 +1,239 @@
(.using
- [library
- [lux "*"
- ["_" test {"+" Test}]
- [abstract
- [monad {"+" do}]]
- [control
- ["[0]" io]]
- [math
- ["[0]" random]]]]
- ["[0]" / "_"
- ["[1][0]" watch]]
- [\\library
- ["[0]" /]]
- [\\specification
- ["$[0]" /]])
+ [library
+ [lux "*"
+ ["_" test {"+" Test}]
+ [abstract
+ ["[0]" monad {"+" do}]]
+ [control
+ ["[0]" io {"+" IO}]
+ ["[0]" try {"+" Try}]
+ [concurrency
+ [async {"+" Async}]
+ ["[0]" atom {"+" Atom}]]]
+ [data
+ ["[0]" binary {"+" Binary} ("[1]#[0]" monoid)]
+ ["[0]" text ("[1]#[0]" equivalence)]
+ [collection
+ ["[0]" dictionary {"+" Dictionary}]
+ ["[0]" list]]]
+ [math
+ ["[0]" random]]
+ [time
+ ["[0]" instant {"+" Instant}]]]]
+ ["[0]" / "_"
+ ["[1][0]" watch]]
+ [\\library
+ ["[0]" /]]
+ [\\specification
+ ["$[0]" /]])
+
+(type: Disk
+ (Dictionary /.Path (Either [Instant Binary] (List Text))))
+
+(def: (file? disk @)
+ (-> (Atom Disk) (-> /.Path (IO Bit)))
+ (do io.monad
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#None} false
+ {.#Some {.#Left _}} true
+ {.#Some {.#Right _}} false))))
+
+(def: (directory? disk @)
+ (-> (Atom Disk) (-> /.Path (IO Bit)))
+ (do io.monad
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#None} false
+ {.#Some {.#Left _}} false
+ {.#Some {.#Right _}} true))))
+
+(def: (alert_parent! disk alert @)
+ (-> (Atom Disk)
+ (-> (List /.Path) (List /.Path))
+ (-> /.Path (IO (Try Any))))
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#Some {.#Right siblings}}
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Right (alert siblings)} disk') disk)]
+ (in {try.#Success []}))
+
+ _
+ (in {try.#Failure ""}))))
+
+(def: (write fs disk it @)
+ (-> (/.System Async) (Atom Disk) (-> Binary /.Path (IO (Try Any))))
+ (do [! io.monad]
+ [now instant.now
+ disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ (^or {.#None}
+ {.#Some {.#Left _}})
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Left [now it]} disk') disk)]
+ (case (/.parent fs @)
+ {.#Some parent}
+ (alert_parent! disk (|>> (list& @)) parent)
+
+ {.#None}
+ (in {try.#Success []})))
+
+ _
+ (in {try.#Failure ""}))))
+
+(def: (read disk @)
+ (-> (Atom Disk) (-> /.Path (IO (Try Binary))))
+ (do io.monad
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#Some {.#Left [_ it]}}
+ {try.#Success it}
+
+ _
+ {try.#Failure ""}))))
+
+(def: (delete fs disk @)
+ (-> (/.System Async) (Atom Disk)
+ (-> /.Path (IO (Try Any))))
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#Some {.#Right children}}
+ (if (list.empty? children)
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.lacks @ disk') disk)]
+ (in {try.#Success []}))
+ (in {try.#Failure ""}))
+
+ {.#Some {.#Left [_ data]}}
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.lacks @ disk') disk)]
+ (case (/.parent fs @)
+ {.#Some parent}
+ (alert_parent! disk (list.only (|>> (text#= @) not)) parent)
+
+ {.#None}
+ (in {try.#Success []})))
+
+ _
+ (in {try.#Failure ""}))))
+
+(def: (fs /)
+ (-> Text (/.System IO))
+ (let [disk (: (Atom Disk)
+ (atom.atom (dictionary.empty text.hash)))
+ mock (/.mock /)]
+ (implementation
+ (def: separator /)
+
+ (def: file? (..file? disk))
+ (def: directory? (..directory? disk))
+ (def: write (..write mock disk))
+ (def: read (..read disk))
+ (def: delete (..delete mock disk))
+
+ (def: (file_size @)
+ (do [! io.monad]
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#Some {.#Left [_ it]}}
+ {try.#Success (binary.size it)}
+
+ _
+ {try.#Failure ""}))))
+ (def: (last_modified @)
+ (do [! io.monad]
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#Some {.#Left [it _]}}
+ {try.#Success it}
+
+ _
+ {try.#Failure ""}))))
+ (def: (can_execute? @)
+ (do [! io.monad]
+ [disk (atom.read! disk)]
+ (in (case (dictionary.value @ disk)
+ {.#Some {.#Left _}}
+ {try.#Success false}
+
+ _
+ {try.#Failure ""}))))
+
+ (def: (make_directory @)
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#None}
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Right (list)} disk') disk)]
+ (case (/.parent mock @)
+ {.#Some parent}
+ (alert_parent! disk (|>> (list& @)) parent)
+
+ {.#None}
+ (in {try.#Success []})))
+
+ _
+ (in {try.#Failure ""}))))
+ (def: (directory_files @)
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#Some {.#Right children}}
+ (|> children
+ (monad.only ! (..file? disk))
+ (# ! each (|>> {try.#Success})))
+
+ _
+ (in {try.#Failure ""}))))
+ (def: (sub_directories @)
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#Some {.#Right children}}
+ (|> children
+ (monad.only ! (..directory? disk))
+ (# ! each (|>> {try.#Success})))
+
+ _
+ (in {try.#Failure ""}))))
+ (def: (append it @)
+ (do [! io.monad]
+ [now instant.now
+ disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#None}
+ (..write mock disk it @)
+
+ {.#Some {.#Left [_ old]}}
+ (do !
+ [_ (atom.compare_and_swap! disk'
+ (dictionary.has @ {.#Left [now (binary#composite old it)]} disk')
+ disk)]
+ (in {try.#Success []}))
+
+ _
+ (in {try.#Failure ""}))))
+ (def: (modify it @)
+ (do [! io.monad]
+ [disk' (atom.read! disk)]
+ (case (dictionary.value @ disk')
+ {.#Some {.#Left [_ data]}}
+ (do !
+ [_ (atom.compare_and_swap! disk' (dictionary.has @ {.#Left [it data]} disk') disk)]
+ (in {try.#Success []}))
+
+ _
+ (in {try.#Failure ""}))))
+ (def: (move it @)
+ (do [! (try.with io.monad)]
+ [data (..read disk @)
+ write (..write mock disk data it)]
+ (..delete mock disk @)))
+ )))
(def: .public test
Test
@@ -23,6 +243,8 @@
($_ _.and
(_.for [/.mock]
($/.spec (io.io (/.mock /))))
+ (_.for [/.async]
+ ($/.spec (io.io (/.async (..fs /)))))
/watch.test
))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 12:40:02 +0000