(.`` (.`` (.require [library [lux (.except open) [abstract ["[0]" monad (.only Monad do)]] [control ["[0]" pipe] ["[0]" maybe (.use "[1]#[0]" functor)] ["[0]" try (.only Try) (.use "[1]#[0]" functor)] ["[0]" exception (.only Exception)] ["[0]" io (.only IO) (.use "[1]#[0]" functor)] ["[0]" function] [concurrency ["[0]" async (.only Async)] ["[0]" stm (.only Var STM)]]] [data ["[0]" bit (.use "[1]#[0]" equivalence)] ["[0]" product] ["[0]" binary (.only Binary)] ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)]] [collection ["[0]" array (.only Array)] ["[0]" list (.use "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)]]] ["[0]" ffi (.only) (.,, (.for "JavaScript" (.,, (.these ["[0]" node_js])) "{old}" (.,, (.these ["node_js" //control/thread])) (.,, (.these))))] [math [number ["i" int] ["f" frac]]] [meta ["@" target] [macro ["[0]" template]]]]] [// [time ["[0]" instant (.only Instant)] ["[0]" duration]]]))) (type .public Path Text) (`` (type .public (System !) (Interface (is Text separator) (,, (with_template [ ] [(is (-> Path (! )) )] [file? Bit] [directory? Bit] )) (,, (with_template [ ] [(is (-> Path (! (Try ))) )] [make_directory Any] [directory_files (List Path)] [sub_directories (List Path)] [file_size Nat] [last_modified Instant] [can_execute? Bit] [read Binary] [delete Any] )) (,, (with_template [ ] [(is (-> Path (! (Try Any))) )] [modify Instant] [write Binary] [append Binary] [move Path] ))) )) (def (un_rooted fs path) (All (_ !) (-> (System !) Path (Maybe [Path Text]))) (let [/ (at fs separator)] (when (text.last_index / path) {.#None} {.#None} {.#Some last_separator} (do maybe.monad [[parent temp] (text.split_at last_separator path) [_ child] (text.split_at (text.size /) temp)] (in [parent child]))))) (def .public (parent fs path) (All (_ !) (-> (System !) Path (Maybe Path))) (|> path (..un_rooted fs) (maybe#each product.left))) (def .public (name fs path) (All (_ !) (-> (System !) Path Text)) (|> path (..un_rooted fs) (maybe#each product.right) (maybe.else path))) (def .public (async fs) (-> (System IO) (System Async)) (`` (implementation (def separator (at fs separator)) (,, (with_template [] [(def (|>> (at fs ) async.future))] [file?] [directory?] [make_directory] [directory_files] [sub_directories] [file_size] [last_modified] [can_execute?] [read] [delete])) (,, (with_template [] [(def ( path input) (async.future (at fs path input)))] [modify] [write] [append] [move])) ))) (def .public (rooted fs parent child) (All (_ !) (-> (System !) Path Text Path)) (format parent (at fs separator) child)) (with_template [] [(exception.def .public ( file) (Exception Path) (exception.report (list ["Path" file])))] [cannot_make_file] [cannot_find_file] [cannot_delete] [cannot_make_directory] [cannot_find_directory] ) (with_expansions [ (these (ffi.import java/lang/String "[1]::[0]") (`` (ffi.import java/io/File "[1]::[0]" (new [java/lang/String]) (,, (with_template [] [( [] "io" "try" boolean)] [createNewFile] [mkdir] [delete] [isFile] [isDirectory] [canRead] [canWrite] [canExecute])) (length [] "io" "try" long) (listFiles [] "io" "try" "?" [java/io/File]) (getAbsolutePath [] "io" "try" java/lang/String) (renameTo [java/io/File] "io" "try" boolean) (lastModified [] "io" "try" long) (setLastModified [long] "io" "try" boolean) ("read_only" "static" separator java/lang/String))) (ffi.import java/lang/AutoCloseable "[1]::[0]" (close [] "io" "try" void)) (ffi.import java/io/OutputStream "[1]::[0]" (write [[byte]] "io" "try" void) (flush [] "io" "try" void)) (ffi.import java/io/FileOutputStream "[1]::[0]" (new [java/io/File boolean] "io" "try")) (ffi.import java/io/InputStream "[1]::[0]" (read [[byte]] "io" "try" int)) (ffi.import java/io/FileInputStream "[1]::[0]" (new [java/io/File] "io" "try")) (`` (def .public default (System IO) (implementation (def separator (ffi.of_string (java/io/File::separator))) (,, (with_template [ ] [(def (|>> ffi.as_string java/io/File::new (io#each (|>> (try#each (|>> ffi.of_boolean)) (try.else false)))))] [file? java/io/File::isFile] [directory? java/io/File::isDirectory] )) (def make_directory (|>> ffi.as_string java/io/File::new java/io/File::mkdir)) (,, (with_template [ ] [(def ( path) (do [! (try.with io.monad)] [?children (java/io/File::listFiles (java/io/File::new (ffi.as_string path)))] (when ?children {.#Some children} (|> children (array.list {.#None}) (monad.only ! (|>> (at ! each (|>> ffi.of_boolean)))) (at ! each (monad.each ! (|>> java/io/File::getAbsolutePath (at ! each (|>> ffi.of_string))))) (at ! conjoint)) {.#None} (at io.monad in (exception.except ..cannot_find_directory [path])))))] [directory_files java/io/File::isFile] [sub_directories java/io/File::isDirectory] )) (def file_size (|>> ffi.as_string java/io/File::new java/io/File::length (at (try.with io.monad) each (|>> ffi.of_long .nat)))) (def last_modified (|>> ffi.as_string java/io/File::new (java/io/File::lastModified) (at (try.with io.monad) each (|>> ffi.of_long duration.of_millis instant.absolute)))) (def can_execute? (|>> ffi.as_string java/io/File::new java/io/File::canExecute (io#each (try#each (|>> ffi.of_boolean))))) (def (read path) (do (try.with io.monad) [.let [file (java/io/File::new (ffi.as_string path))] size (java/io/File::length file) stream (java/io/FileInputStream::new file) .let [data (binary.empty (.nat (ffi.of_long size)))] bytes_read (java/io/InputStream::read data stream) _ (java/lang/AutoCloseable::close stream)] (in data))) (def (delete path) (|> path ffi.as_string java/io/File::new java/io/File::delete)) (def (modify path time_stamp) (|> path ffi.as_string java/io/File::new (java/io/File::setLastModified (|> time_stamp instant.relative duration.millis ffi.as_long)))) (,, (with_template [ ] [(def ( path data) (do (try.with io.monad) [stream (java/io/FileOutputStream::new (java/io/File::new (ffi.as_string path)) (ffi.as_boolean )) _ (java/io/OutputStream::write data stream) _ (java/io/OutputStream::flush stream)] (java/lang/AutoCloseable::close stream)))] [#0 write] [#1 append] )) (def (move origin destination) (|> origin ffi.as_string java/io/File::new (java/io/File::renameTo (java/io/File::new (ffi.as_string destination))))) ))))] (for @.old (these ) @.jvm (these ) @.js (these (ffi.import Buffer "[1]::[0]" ("static" from [Binary] ..Buffer)) (ffi.import FileDescriptor "[1]::[0]") (ffi.import Stats "[1]::[0]" (size ffi.Number) (mtimeMs ffi.Number) (isFile [] ffi.Boolean) (isDirectory [] ffi.Boolean)) (ffi.import FsConstants "[1]::[0]" (F_OK ffi.Number) (R_OK ffi.Number) (W_OK ffi.Number) (X_OK ffi.Number)) (ffi.import Error "[1]::[0]" (toString [] ffi.String)) (def with_async (template (_ ) [(template.with_locals [] (let [[ ] (is [(Async ) (async.Resolver )] (async.async []))] (exec )))])) (ffi.import Fs "[1]::[0]" (constants FsConstants) (readFile [ffi.String ffi.Function] Any) (appendFile [ffi.String Buffer ffi.Function] Any) (writeFile [ffi.String Buffer ffi.Function] Any) (stat [ffi.String ffi.Function] Any) (access [ffi.String ffi.Number ffi.Function] Any) (rename [ffi.String ffi.String ffi.Function] Any) (utimes [ffi.String ffi.Number ffi.Number ffi.Function] Any) (readdir [ffi.String ffi.Function] Any) (mkdir [ffi.String ffi.Function] Any) (unlink [ffi.String ffi.Function] Any) (rmdir [ffi.String ffi.Function] Any)) (def (any_callback write!) (-> (async.Resolver (Try Any)) ffi.Function) (<| (ffi.function (_ [error Error]) Any) io.run! write! (if (ffi.null? error) {try.#Success []} {try.#Failure (Error::toString error)}))) (def (value_callback write!) (All (_ a) (-> (async.Resolver (Try a)) ffi.Function)) (<| (ffi.function (_ [error Error datum Any]) Any) io.run! write! (if (ffi.null? error) {try.#Success (as_expected datum)} {try.#Failure (Error::toString error)}))) (ffi.import JsPath "[1]::[0]" (sep ffi.String)) (def .public default (Maybe (System Async)) (do maybe.monad [node_fs (node_js.require "fs") node_path (node_js.require "path") .let [node_fs (as ..Fs node_fs) js_separator (if ffi.on_node_js? (JsPath::sep (as ..JsPath node_path)) "/")]] (in (is (System Async) (`` (implementation (def separator js_separator) (,, (with_template [ ] [(def ( path) (do async.monad [?stats (with_async write! (Try Stats) (Fs::stat path (..value_callback write!) node_fs))] (in (when ?stats {try.#Success stats} ( stats) {try.#Failure _} false))))] [file? Stats::isFile] [directory? Stats::isDirectory] )) (def (make_directory path) (do async.monad [outcome (with_async write! (Try Any) (Fs::access path (|> node_fs Fs::constants FsConstants::F_OK) (..any_callback write!) node_fs))] (when outcome {try.#Success _} (in (exception.except ..cannot_make_directory [path])) {try.#Failure _} (with_async write! (Try Any) (Fs::mkdir path (..any_callback write!) node_fs))))) (,, (with_template [ ] [(def ( path) (do [! (try.with async.monad)] [subs (with_async write! (Try (Array ffi.String)) (Fs::readdir path (..value_callback write!) node_fs))] (|> subs (array.list {.#None}) (list#each (|>> (format path js_separator))) (monad.each ! (function (_ sub) (at ! each (|>> [sub]) (with_async write! (Try Stats) (Fs::stat sub (..value_callback write!) node_fs))))) (at ! each (|>> (list.only product.right) (list#each product.left))))))] [directory_files Stats::isFile] [sub_directories Stats::isDirectory] )) (def (file_size path) (do (try.with async.monad) [stats (with_async write! (Try Stats) (Fs::stat path (..value_callback write!) node_fs))] (in (|> stats Stats::size f.nat)))) (def (last_modified path) (do (try.with async.monad) [stats (with_async write! (Try Stats) (Fs::stat path (..value_callback write!) node_fs))] (in (|> stats Stats::mtimeMs f.int duration.of_millis instant.absolute)))) (def (can_execute? path) (at async.monad each (|>> (pipe.when {try.#Success _} true {try.#Failure _} false) {try.#Success}) (with_async write! (Try Any) (Fs::access path (|> node_fs Fs::constants FsConstants::X_OK) (..any_callback write!) node_fs)))) (def (read path) (with_async write! (Try Binary) (Fs::readFile path (..value_callback write!) node_fs))) (def (delete path) (do (try.with async.monad) [stats (with_async write! (Try Stats) (Fs::stat path (..value_callback write!) node_fs))] (with_async write! (Try Any) (if (Stats::isFile stats) (Fs::unlink path (..any_callback write!) node_fs) (Fs::rmdir path (..any_callback write!) node_fs))))) (def (modify path time_stamp) (with_async write! (Try Any) (let [when (|> time_stamp instant.relative duration.millis i.frac)] (Fs::utimes path when when (..any_callback write!) node_fs)))) (,, (with_template [ ] [(def ( path data) (with_async write! (Try Any) ( path (Buffer::from data) (..any_callback write!) node_fs)))] [write Fs::writeFile] [append Fs::appendFile] )) (def (move origin destination) (with_async write! (Try Any) (Fs::rename origin destination (..any_callback write!) node_fs)))))))))) @.python (these (type (Tuple/2 left right) (Primitive "python_tuple[2]" [left right])) (ffi.import PyFile "[1]::[0]" (read [] "io" "try" Binary) (write [Binary] "io" "try" "?" Any) (close [] "io" "try" "?" Any)) (ffi.import (open [ffi.String ffi.String] "io" "try" PyFile)) (ffi.import (tuple [[ffi.Integer ffi.Integer]] (Tuple/2 ffi.Integer ffi.Integer))) (ffi.import os "[1]::[0]" ("static" F_OK ffi.Integer) ("static" R_OK ffi.Integer) ("static" W_OK ffi.Integer) ("static" X_OK ffi.Integer) ("static" mkdir [ffi.String] "io" "try" "?" Any) ("static" access [ffi.String ffi.Integer] "io" "try" ffi.Boolean) ("static" remove [ffi.String] "io" "try" "?" Any) ("static" rmdir [ffi.String] "io" "try" "?" Any) ("static" rename [ffi.String ffi.String] "io" "try" "?" Any) ("static" utime [ffi.String (Tuple/2 ffi.Integer ffi.Integer)] "io" "try" "?" Any) ("static" listdir [ffi.String] "io" "try" (Array ffi.String))) (ffi.import os/path "[1]::[0]" ("static" isfile [ffi.String] "io" "try" ffi.Boolean) ("static" isdir [ffi.String] "io" "try" ffi.Boolean) ("static" sep ffi.String) ("static" getsize [ffi.String] "io" "try" ffi.Integer) ("static" getmtime [ffi.String] "io" "try" ffi.Float)) (def python_separator (os/path::sep)) (`` (def .public default (System IO) (implementation (def separator ..python_separator) (,, (with_template [ ] [(def (|>> (io#each (|>> (try.else false)))))] [file? os/path::isfile] [directory? os/path::isdir] )) (def make_directory os::mkdir) (,, (with_template [ ] [(def ( path) (let [! (try.with io.monad)] (|> path os::listdir (at ! each (|>> (array.list {.#None}) (list#each (|>> (format path ..python_separator))) (monad.each ! (function (_ sub) (at ! each (|>> [sub]) ( sub)))) (at ! each (|>> (list.only product.right) (list#each product.left))))) (at ! conjoint))))] [directory_files os/path::isfile] [sub_directories os/path::isdir] )) (def file_size (|>> os/path::getsize (at (try.with io.monad) each (|>> .nat)))) (def last_modified (|>> os/path::getmtime (at (try.with io.monad) each (|>> f.int (i.* +1,000) duration.of_millis instant.absolute)))) (def (can_execute? path) (os::access path (os::X_OK))) (def (read path) (do (try.with io.monad) [file (..open path "rb") data (PyFile::read file) _ (PyFile::close file)] (in data))) (def (delete path) (do (try.with io.monad) [? (os/path::isfile path)] (if ? (os::remove path) (os::rmdir path)))) (def (modify path time_stamp) (let [when (|> time_stamp instant.relative duration.millis (i./ +1,000))] (os::utime path (..tuple [when when])))) (,, (with_template [ ] [(def ( path data) (do (try.with io.monad) [file (..open path ) _ (PyFile::write data file)] (PyFile::close file)))] [write "w+b"] [append "ab"] )) (def (move origin destination) (os::rename origin destination)) )))) @.ruby (these (ffi.import Time "[1]::[0]" ("static" at [Frac] Time) (to_f [] Frac)) (ffi.import Stat "[1]::[0]" (executable? [] Bit) (size Int) (mtime [] Time)) (ffi.import File "as" RubyFile "[1]::[0]" ("static" SEPARATOR ffi.String) ("static" open [Path ffi.String] "io" "try" RubyFile) ("static" stat [Path] "io" "try" Stat) ("static" delete [Path] "io" "try" Int) ("static" file? [Path] "io" "try" Bit) ("static" directory? [Path] "io" "try" Bit) ("static" utime [Time Time Path] "io" "try" Int) (read [] "io" "try" Binary) (write [Binary] "io" "try" Int) (flush [] "io" "try" "?" Any) (close [] "io" "try" "?" Any)) (ffi.import Dir "[1]::[0]" ("static" open [Path] "io" "try" Dir) (children [] "io" "try" (Array Path)) (close [] "io" "try" "?" Any)) (ffi.import "fileutils" FileUtils "[1]::[0]" ("static" move [Path Path] "io" "try" "?" Any) ("static" rmdir [Path] "io" "try" "?" Any) ("static" mkdir [Path] "io" "try" "?" Any)) (def ruby_separator Text (..RubyFile::SEPARATOR)) (`` (def .public default (System IO) (implementation (def separator ..ruby_separator) (,, (with_template [ ] [(def (|>> (io#each (|>> (try.else false)))))] [file? RubyFile::file?] [directory? RubyFile::directory?] )) (def make_directory FileUtils::mkdir) (,, (with_template [ ] [(def ( path) (do [! (try.with io.monad)] [self (Dir::open path) children (Dir::children self) output (loop (again [input (|> children (array.list {.#None}) (list#each (|>> (format path ..ruby_separator)))) output (is (List ..Path) (list))]) (when input {.#End} (in output) {.#Item head tail} (do ! [verdict ( head)] (again tail (if verdict {.#Item head output} output))))) _ (Dir::close self)] (in output)))] [directory_files RubyFile::file?] [sub_directories RubyFile::directory?] )) (,, (with_template [ ] [(def (let [! (try.with io.monad)] (|>> RubyFile::stat (at ! each (`` (|>> (,, (template.spliced ))))))))] [file_size [Stat::size .nat]] [last_modified [Stat::mtime Time::to_f (f.* +1,000.0) f.int duration.of_millis instant.absolute]] [can_execute? [Stat::executable?]] )) (def (read path) (do (try.with io.monad) [file (RubyFile::open path "rb") data (RubyFile::read file) _ (RubyFile::close file)] (in data))) (def (delete path) (do (try.with io.monad) [? (RubyFile::file? path)] (if ? (RubyFile::delete path) (FileUtils::rmdir path)))) (def (modify path moment) (let [moment (|> moment instant.relative duration.millis i.frac (f./ +1,000.0) Time::at)] (RubyFile::utime moment moment path))) (,, (with_template [ ] [(def ( path data) (do [! (try.with io.monad)] [file (RubyFile::open path ) data (RubyFile::write data file) _ (RubyFile::flush file) _ (RubyFile::close file)] (in [])))] ["wb" write] ["ab" append] )) (def (move origin destination) (do (try.with io.monad) [_ (FileUtils::move origin destination)] (in []))) )))) ... @.php ... (these (ffi.import (FILE_APPEND Int)) ... ... https://www.php.net/manual/en/dir.constants.php ... (ffi.import (DIRECTORY_SEPARATOR ffi.String)) ... ... https://www.php.net/manual/en/function.pack.php ... ... https://www.php.net/manual/en/function.unpack.php ... (ffi.import (unpack [ffi.String ffi.String] Binary)) ... ... https://www.php.net/manual/en/ref.filesystem.php ... ... https://www.php.net/manual/en/function.file-get-contents.php ... (ffi.import (file_get_contents [Path] "io" "try" ffi.String)) ... ... https://www.php.net/manual/en/function.file-put-contents.php ... (ffi.import (file_put_contents [Path ffi.String Int] "io" "try" ffi.Integer)) ... (ffi.import (filemtime [Path] "io" "try" ffi.Integer)) ... (ffi.import (filesize [Path] "io" "try" ffi.Integer)) ... (ffi.import (is_executable [Path] "io" "try" ffi.Boolean)) ... (ffi.import (touch [Path ffi.Integer] "io" "try" ffi.Boolean)) ... (ffi.import (rename [Path Path] "io" "try" ffi.Boolean)) ... (ffi.import (unlink [Path] "io" "try" ffi.Boolean)) ... ... https://www.php.net/manual/en/function.rmdir.php ... (ffi.import (rmdir [Path] "io" "try" ffi.Boolean)) ... ... https://www.php.net/manual/en/function.scandir.php ... (ffi.import (scandir [Path] "io" "try" (Array Path))) ... ... https://www.php.net/manual/en/function.is-file.php ... (ffi.import (is_file [Path] "io" "try" ffi.Boolean)) ... ... https://www.php.net/manual/en/function.is-dir.php ... (ffi.import (is_dir [Path] "io" "try" ffi.Boolean)) ... ... https://www.php.net/manual/en/function.mkdir.php ... (ffi.import (mkdir [Path] "io" "try" ffi.Boolean)) ... (def byte_array_format "C*") ... (def default_separator (..DIRECTORY_SEPARATOR)) ... (with_template [] ... [(exception.def .public ( file) ... (Exception Path) ... (exception.report ... (list ["Path" file])))] ... [cannot_write_to_file] ... ) ... (`` (def (file path) ... (-> Path (File IO)) ... (implementation ... (,, (with_template [ ] ... [(def ( data) ... (do [! (try.with io.monad)] ... [outcome (..file_put_contents [path ("php pack" ..byte_array_format data) ])] ... (if (bit#= false (as Bit outcome)) ... (at io.monad in (exception.except ..cannot_write_to_file [path])) ... (in []))))] ... [over_write +0] ... [append (..FILE_APPEND)] ... )) ... (def (content _) ... (do [! (try.with io.monad)] ... [data (..file_get_contents [path])] ... (if (bit#= false (as Bit data)) ... (at io.monad in (exception.except ..cannot_find_file [path])) ... (in (..unpack [..byte_array_format data]))))) ... (def path ... path) ... (,, (with_template [ ] ... [(def ( _) ... (do [! (try.with io.monad)] ... [value ( [path])] ... (if (bit#= false (as Bit value)) ... (at io.monad in (exception.except ..cannot_find_file [path])) ... (in (`` (|> value (,, (template.spliced ))))))))] ... [size ..filesize [.nat]] ... [last_modified ..filemtime [(i.* +1,000) duration.of_millis instant.absolute]] ... )) ... (def (can_execute? _) ... (..is_executable [path])) ... (def (modify moment) ... (do [! (try.with io.monad)] ... [verdict (..touch [path (|> moment instant.relative duration.millis (i./ +1,000))])] ... (if (bit#= false (as Bit verdict)) ... (at io.monad in (exception.except ..cannot_find_file [path])) ... (in [])))) ... (def (move destination) ... (do [! (try.with io.monad)] ... [verdict (..rename [path destination])] ... (if (bit#= false (as Bit verdict)) ... (at io.monad in (exception.except ..cannot_find_file [path])) ... (in (file destination))))) ... (def (delete _) ... (do (try.with io.monad) ... [verdict (..unlink [path])] ... (if (bit#= false (as Bit verdict)) ... (at io.monad in (exception.except ..cannot_find_file [path])) ... (in [])))) ... ))) ... (`` (def (directory path) ... (-> Path (Directory IO)) ... (implementation ... (def scope ... path) ... (,, (with_template [ ] ... [(def ( _) ... (do [! (try.with io.monad)] ... [children (..scandir [path])] ... (loop (again [input (|> children ... (array.list {.#None}) ... (list.only (function (_ child) ... (not (or (text#= "." child) ... (text#= ".." child)))))) ... output (is (List ( IO)) ... (list))]) ... (when input ... {.#End} ... (in output) ... {.#Item head tail} ... (do ! ... [verdict ( head)] ... (if verdict ... (again tail {.#Item ( head) output}) ... (again tail output)))))))] ... [files ..is_file ..file File] ... [directories ..is_dir directory Directory] ... )) ... (def (discard _) ... (do (try.with io.monad) ... [verdict (..rmdir [path])] ... (if (bit#= false (as Bit verdict)) ... (at io.monad in (exception.except ..cannot_find_directory [path])) ... (in [])))) ... ))) ... (`` (def .public default ... (System IO) ... (implementation ... (,, (with_template [ ] ... [(def ( path) ... (do [! (try.with io.monad)] ... [verdict ( path)] ... (at io.monad in ... (if verdict ... {try.#Success ( path)} ... (exception.except [path])))))] ... [file ..is_file ..file ..cannot_find_file] ... [directory ..is_dir ..directory ..cannot_find_directory] ... )) ... (def (make_file path) ... (do [! (try.with io.monad)] ... [verdict (..touch [path (|> instant.now io.run! instant.relative duration.millis (i./ +1,000))])] ... (at io.monad in ... (if verdict ... {try.#Success (..file path)} ... (exception.except ..cannot_make_file [path]))))) ... (def (make_directory path) ... (do [! (try.with io.monad)] ... [verdict (..mkdir path)] ... (at io.monad in ... (if verdict ... {try.#Success (..directory path)} ... (exception.except ..cannot_make_directory [path]))))) ... (def separator ... ..default_separator) ... ))) ... ) (these))) (def .public (exists? monad fs path) (All (_ !) (-> (Monad !) (System !) Path (! Bit))) (do monad [verdict (at fs file? path)] (if verdict (in verdict) (at fs directory? path)))) (type Mock_File (Record [#mock_last_modified Instant #mock_can_execute Bit #mock_content Binary])) (type Mock (Rec Mock (Dictionary Text (Either Mock_File Mock)))) (def empty_mock Mock (dictionary.empty text.hash)) (def (retrieve_mock_file! separator path mock) (-> Text Path Mock (Try [Text Mock_File])) (loop (again [directory mock trail (text.all_split_by separator path)]) (when trail {.#Item head tail} (when (dictionary.value head directory) {.#None} (exception.except ..cannot_find_file [path]) {.#Some node} (when [node tail] [{.#Left file} {.#End}] {try.#Success [head file]} [{.#Right sub_directory} {.#Item _}] (again sub_directory tail) _ (exception.except ..cannot_find_file [path]))) {.#End} (exception.except ..cannot_find_file [path])))) (def (update_mock_file! / path now content mock) (-> Text Path Instant Binary Mock (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) (when trail {.#Item head tail} (when (dictionary.value head directory) {.#None} (when tail {.#End} {try.#Success (dictionary.has head {.#Left [#mock_last_modified now #mock_can_execute false #mock_content content]} directory)} {.#Item _} (exception.except ..cannot_find_file [path])) {.#Some node} (when [node tail] [{.#Left file} {.#End}] {try.#Success (dictionary.has head {.#Left (|> file (has #mock_last_modified now) (has #mock_content content))} directory)} [{.#Right sub_directory} {.#Item _}] (do try.monad [sub_directory (again sub_directory tail)] (in (dictionary.has head {.#Right sub_directory} directory))) _ (exception.except ..cannot_find_file [path]))) {.#End} (exception.except ..cannot_find_file [path])))) (def (delete_mock_node! / path mock) (-> Text Path Mock (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) (when trail {.#Item head tail} (when (dictionary.value head directory) {.#None} (exception.except ..cannot_delete [path]) {.#Some node} (when tail {.#End} (when node {.#Left file} {try.#Success (dictionary.lacks head directory)} {.#Right sub_directory} (if (dictionary.empty? sub_directory) {try.#Success (dictionary.lacks head directory)} (exception.except ..cannot_delete [path]))) {.#Item _} (when node {.#Left file} (exception.except ..cannot_delete [path]) {.#Right sub_directory} (do try.monad [sub_directory' (again sub_directory tail)] (in (dictionary.has head {.#Right sub_directory'} directory)))))) {.#End} (exception.except ..cannot_delete [path])))) (def (attempt! transform var) (All (_ a) (-> (-> a (Try a)) (Var a) (STM (Try Any)))) (do [! stm.monad] [|var| (stm.read var)] (when (transform |var|) {try.#Success |var|} (do ! [_ (stm.write |var| var)] (in {try.#Success []})) {try.#Failure error} (in {try.#Failure error})))) (def (make_mock_directory! / path mock) (-> Text Path Mock (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) (when trail {.#Item head tail} (when (dictionary.value head directory) {.#None} (when tail {.#End} {try.#Success (dictionary.has head {.#Right ..empty_mock} directory)} {.#Item _} (exception.except ..cannot_make_directory [path])) {.#Some node} (when [node tail] [{.#Right sub_directory} {.#Item _}] (do try.monad [sub_directory (again sub_directory tail)] (in (dictionary.has head {.#Right sub_directory} directory))) _ (exception.except ..cannot_make_directory [path]))) {.#End} (exception.except ..cannot_make_directory [path])))) (def (retrieve_mock_directory! / path mock) (-> Text Path Mock (Try Mock)) (loop (again [directory mock trail (text.all_split_by / path)]) (when trail {.#End} {try.#Success directory} {.#Item head tail} (when (dictionary.value head directory) {.#None} (exception.except ..cannot_find_directory [path]) {.#Some node} (when node {.#Left _} (exception.except ..cannot_find_directory [path]) {.#Right sub_directory} (when tail {.#End} {try.#Success sub_directory} {.#Item _} (again sub_directory tail))))))) (def .public (mock separator) (-> Text (System Async)) (let [store (stm.var ..empty_mock)] (`` (implementation (def separator separator) (,, (with_template [ ] [(def ( path) (|> store stm.read (at stm.monad each (|>> ( separator path) (try#each (function.constant true)) (try.else false))) stm.commit!))] [file? ..retrieve_mock_file!] [directory? ..retrieve_mock_directory!])) (def (make_directory path) (stm.commit! (do [! stm.monad] [|store| (stm.read store)] (when (..make_mock_directory! separator path |store|) {try.#Success |store|} (do ! [_ (stm.write |store| store)] (in {try.#Success []})) {try.#Failure error} (in {try.#Failure error}))))) (,, (with_template [ ] [(def ( path) (stm.commit! (do stm.monad [|store| (stm.read store)] (in (do try.monad [directory (..retrieve_mock_directory! separator path |store|)] (in (|> directory dictionary.entries (list.all (function (_ [node_name node]) (when node { _} {.#Some (format path separator node_name)} _ {.#None}))))))))))] [directory_files .#Left] [sub_directories .#Right] )) (def (file_size path) (stm.commit! (do stm.monad [|store| (stm.read store)] (in (|> |store| (..retrieve_mock_file! separator path) (try#each (|>> product.right (the #mock_content) binary.size))))))) (def (last_modified path) (stm.commit! (do stm.monad [|store| (stm.read store)] (in (|> |store| (..retrieve_mock_file! separator path) (try#each (|>> product.right (the #mock_last_modified)))))))) (def (can_execute? path) (stm.commit! (do stm.monad [|store| (stm.read store)] (in (|> |store| (..retrieve_mock_file! separator path) (try#each (|>> product.right (the #mock_can_execute)))))))) (def (read path) (stm.commit! (do stm.monad [|store| (stm.read store)] (in (|> |store| (..retrieve_mock_file! separator path) (try#each (|>> product.right (the #mock_content)))))))) (def (delete path) (stm.commit! (..attempt! (..delete_mock_node! separator path) store))) (def (modify path now) (stm.commit! (..attempt! (function (_ |store|) (do try.monad [[name file] (..retrieve_mock_file! separator path |store|)] (..update_mock_file! separator path now (the #mock_content file) |store|))) store))) (def (write path content) (do async.monad [now (async.future instant.now)] (stm.commit! (..attempt! (..update_mock_file! separator path now content) store)))) (def (append path content) (do async.monad [now (async.future instant.now)] (stm.commit! (..attempt! (function (_ |store|) (do try.monad [[name file] (..retrieve_mock_file! separator path |store|)] (..update_mock_file! separator path now (at binary.monoid composite (the #mock_content file) content) |store|))) store)))) (def (move origin destination) (stm.commit! (do [! stm.monad] [|store| (stm.read store)] (when (do try.monad [[name file] (..retrieve_mock_file! separator origin |store|) |store| (..delete_mock_node! separator origin |store|)] (..update_mock_file! separator destination (the #mock_last_modified file) (the #mock_content file) |store|)) {try.#Success |store|} (do ! [_ (stm.write |store| store)] (in {try.#Success []})) {try.#Failure error} (in {try.#Failure error}))))) )))) (def (check_or_make_directory monad fs path) (All (_ !) (-> (Monad !) (System !) Path (! (Try Any)))) (do monad [? (at fs directory? path)] (if ? (in {try.#Success []}) (at fs make_directory path)))) (def .public (make_directories monad fs path) (All (_ !) (-> (Monad !) (System !) Path (! (Try Any)))) (let [rooted? (text.starts_with? (at fs separator) path) segments (text.all_split_by (at fs separator) path)] (when (if rooted? (list.after 1 segments) segments) {.#End} (at monad in (exception.except ..cannot_make_directory [path])) {.#Item head tail} (when head "" (at monad in (exception.except ..cannot_make_directory [path])) _ (loop (again [current (if rooted? (format (at fs separator) head) head) next tail]) (do monad [? (..check_or_make_directory monad fs current)] (when ? {try.#Success _} (when next {.#End} (in {try.#Success []}) {.#Item head tail} (again (format current (at fs separator) head) tail)) {try.#Failure error} (in {try.#Failure error})))))))) (def .public (make_file monad fs content path) (All (_ !) (-> (Monad !) (System !) Binary Path (! (Try Any)))) (do monad [? (at fs file? path)] (if ? (in (exception.except ..cannot_make_file [path])) (at fs write path content)))) (def .public (copy monad fs from to) (All (_ !) (-> (Monad !) (System !) Path Path (! (Try Any)))) (do (try.with monad) [data (at fs read from)] (at fs write to data)))