From 5bc58409d87da0f4966d94224e6dd9c2a5a2a408 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 8 Jul 2018 00:56:39 -0400 Subject: - Moved LuxC's I/O to stdlib. - Improved "lux/world/file". --- new-luxc/source/luxc/io.jvm.lux | 121 -------- stdlib/source/lux/control/pipe.lux | 5 + stdlib/source/lux/lang/compiler/meta/io.lux | 16 + .../source/lux/lang/compiler/meta/io/archive.lux | 70 +++++ .../source/lux/lang/compiler/meta/io/context.lux | 89 ++++++ stdlib/source/lux/world/file.lux | 345 ++++++++++++++------- 6 files changed, 408 insertions(+), 238 deletions(-) delete mode 100644 new-luxc/source/luxc/io.jvm.lux create mode 100644 stdlib/source/lux/lang/compiler/meta/io.lux create mode 100644 stdlib/source/lux/lang/compiler/meta/io/archive.lux create mode 100644 stdlib/source/lux/lang/compiler/meta/io/context.lux diff --git a/new-luxc/source/luxc/io.jvm.lux b/new-luxc/source/luxc/io.jvm.lux deleted file mode 100644 index c0c913772..000000000 --- a/new-luxc/source/luxc/io.jvm.lux +++ /dev/null @@ -1,121 +0,0 @@ -(.module: - lux - (lux (control monad - ["ex" exception #+ exception:]) - [io #+ Process] - (data ["e" error] - [text "text/" Eq] - text/format) - [macro] - [host] - (world [file #+ File] - [blob #+ Blob]))) - -(host.import: java/lang/String - (new [(Array byte)])) - -(def: host-extension Text ".jvm") -(def: lux-extension Text ".lux") - -(do-template [] - [(exception: #export ( {message Text}) - message)] - - [File-Not-Found] - [Module-Not-Found] - [Could-Not-Prepare-Module] - ) - -(def: sanitize - (-> Text Text) - (text.replace-all "/" file.separator)) - -(def: (find-source dirs path) - (-> (List File) Text (Process [Text File])) - (case dirs - #.Nil - (io.fail (ex.construct File-Not-Found path)) - - (#.Cons dir dirs') - (do io.Monad - [#let [file (format dir file.separator path)] - ? (file.exists? file)] - (if ? - (wrap [path file]) - (find-source dirs' path))))) - -(def: (either left right) - (All [a] (-> (Process a) (Process a) (Process a))) - (do io.Monad - [?output left] - (case ?output - (#e.Success output) - (wrap (#e.Success output)) - - (#e.Error error) - right))) - -(def: #export blob-to-text - (-> Blob Text) - (|>> [] String::new)) - -(def: #export (read dirs name) - (-> (List File) Text (Process [File Text])) - (do io.Monad - [[path file] (: (Process [Text File]) - ($_ either - (find-source dirs (format name host-extension lux-extension)) - (find-source dirs (format name lux-extension)) - (io.fail (ex.construct Module-Not-Found name)))) - blob (file.read file)] - (wrap [path (blob-to-text blob)]))) - -(def: #export (platform-target root-target) - (-> File File) - (format root-target "/" (for {"JVM" "jvm" - "JS" "js"}))) - -(def: #export (prepare-target target-dir) - (-> File (Process Bool)) - (do io.Monad - [_ (file.make-directory (sanitize target-dir))] - (file.make-directory (sanitize (platform-target target-dir))))) - -(def: #export (prepare-module target-dir module-name) - (-> File Text (Process Any)) - (do io.Monad - [#let [module-path (|> module-name - (format (platform-target target-dir) "/") - sanitize)] - module-exists? (file.exists? module-path) - made-dir? (if module-exists? - (wrap module-exists?) - (file.make-directory module-path))] - (if made-dir? - (wrap []) - (io.fail (ex.construct Could-Not-Prepare-Module - (format "Module: " module-name "\n" - "Target: " target-dir "\n")))))) - -(def: #export (write target name content) - (-> File Text Blob (Process Any)) - (|> name - (format (platform-target target) "/") - sanitize - (file.write content))) - -(def: #export (module target-dir module-dir) - (-> File File (Maybe Text)) - (case (text.split-with target-dir module-dir) - (#.Some ["" post]) - (let [raw (text.replace-all file.separator "/" post)] - (if (text.starts-with? "/" raw) - (text.clip' +1 raw) - (#.Some raw))) - - _ - #.None)) - -(def: #export (file target-dir file-name) - (-> File Text File) - (format target-dir file.separator (sanitize file-name))) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 4cbfe3504..de058307b 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -59,6 +59,11 @@ (` (|> (~ g!temp) (~+ then)))))) (|> (~ g!temp) (~+ else))))))))) +(syntax: #export (if> {then body^} {else body^} prev) + (wrap (list (` (cond> [] [(new> (~+ then))] + [(new> (~+ else))] + (~ prev)))))) + (syntax: #export (loop> {test body^} {then body^} prev) diff --git a/stdlib/source/lux/lang/compiler/meta/io.lux b/stdlib/source/lux/lang/compiler/meta/io.lux new file mode 100644 index 000000000..6be4605f2 --- /dev/null +++ b/stdlib/source/lux/lang/compiler/meta/io.lux @@ -0,0 +1,16 @@ +(.module: + [lux #- Module] + (lux (control monad + ["ex" exception #+ exception:]) + (data [error] + [text] + (text format + [encoding])) + (world [file #+ File System] + [blob #+ Blob]))) + +(type: #export Module Text) + +(def: #export (sanitize system) + (All [m] (-> (System m) Text Text)) + (text.replace-all "/" (:: system separator))) diff --git a/stdlib/source/lux/lang/compiler/meta/io/archive.lux b/stdlib/source/lux/lang/compiler/meta/io/archive.lux new file mode 100644 index 000000000..534c9e20c --- /dev/null +++ b/stdlib/source/lux/lang/compiler/meta/io/archive.lux @@ -0,0 +1,70 @@ +(.module: + [lux #- Module] + (lux (control monad + ["ex" exception #+ exception:]) + (data [error] + [text] + text/format) + (world [file #+ File System] + [blob #+ Blob])) + [/////host] + [// #+ Module]) + +(type: #export Document File) + +(exception: #export (cannot-prepare {archive File} {module Module}) + (ex.report ["Archive" archive] + ["Module" module])) + +(def: #export (archive System root) + (All [m] (-> (System m) File File)) + (<| (format root (:: System separator)) + (`` (for {(~~ (static /////host.common-lisp)) /////host.common-lisp + (~~ (static /////host.js)) /////host.js + (~~ (static /////host.jvm)) /////host.jvm + (~~ (static /////host.lua)) /////host.lua + (~~ (static /////host.php)) /////host.php + (~~ (static /////host.python)) /////host.python + (~~ (static /////host.r)) /////host.r + (~~ (static /////host.ruby)) /////host.ruby + (~~ (static /////host.scheme)) /////host.scheme})))) + +(def: #export (document System root module) + (All [m] (-> (System m) File Module Document)) + (let [archive (..archive System root)] + (|> module + (//.sanitize System) + (format archive (:: System separator))))) + +(def: #export (prepare System root module) + (All [m] (-> (System m) File Module (m Any))) + (do (:: System &monad) + [#let [archive (..archive System root) + document (..document System root module)] + document-exists? (file.exists? System document)] + (if document-exists? + (wrap []) + (do @ + [outcome (:: System try (:: System make-directory document))] + (case outcome + (#error.Success output) + (wrap output) + + (#error.Error _) + (:: System throw cannot-prepare [archive module])))))) + +(def: #export (write System root content name) + (All [m] (-> (System m) File Blob Text (m Any))) + (:: System write content (..document System root name))) + +(def: #export (module System root document) + (All [m] (-> (System m) File Document (Maybe Module))) + (case (text.split-with (..archive System root) document) + (#.Some ["" post]) + (let [raw (text.replace-all (:: System separator) "/" post)] + (if (text.starts-with? "/" raw) + (text.clip' +1 raw) + (#.Some raw))) + + _ + #.None)) diff --git a/stdlib/source/lux/lang/compiler/meta/io/context.lux b/stdlib/source/lux/lang/compiler/meta/io/context.lux new file mode 100644 index 000000000..d03dcbdd8 --- /dev/null +++ b/stdlib/source/lux/lang/compiler/meta/io/context.lux @@ -0,0 +1,89 @@ +(.module: + [lux #- Module] + (lux (control monad + ["ex" exception #+ Exception exception:]) + (data [error] + (text format + [encoding])) + (world [file #+ File System] + [blob #+ Blob])) + [/////host] + [// #+ Module]) + +(type: #export Context File) + +(type: #export Extension Text) + +(def: #export (file System context module) + (All [m] (-> (System m) Context Module File)) + (|> module + (//.sanitize System) + (format context (:: System separator)))) + +(def: host-extension + Extension + (`` (for {(~~ (static /////host.common-lisp)) ".cl" + (~~ (static /////host.js)) ".js" + (~~ (static /////host.jvm)) ".jvm" + (~~ (static /////host.lua)) ".lua" + (~~ (static /////host.php)) ".php" + (~~ (static /////host.python)) ".py" + (~~ (static /////host.r)) ".r" + (~~ (static /////host.ruby)) ".rb" + (~~ (static /////host.scheme)) ".scm"}))) + +(def: lux-extension Extension ".lux") + +(do-template [] + [(exception: #export ( {module Module}) + (ex.report ["Module" module]))] + + [module-not-found] + [cannot-read-module] + ) + +(def: (find-source System contexts module extension) + (All [m] (-> (System m) (List Context) Module Text (m (Maybe [Module File])))) + (case contexts + #.Nil + (:: (:: System &monad) wrap #.None) + + (#.Cons context contexts') + (do (:: System &monad) + [#let [file (format (..file System context module) extension)] + ? (file.exists? System file)] + (if ? + (wrap (#.Some [module file])) + (find-source System contexts' module))))) + +(def: (try System computations exception message) + (All [m a e] (-> (System m) (List (m (Maybe a))) (Exception e) e (m a))) + (case computations + #.Nil + (:: System throw exception message) + + (#.Cons computation computations') + (do (:: System &monad) + [outcome computation] + (case outcome + (#.Some output) + (wrap output) + + #.None + (try System computations' exception message))))) + +(def: #export (read System contexts name) + (All [m] (-> (System m) (List Context) Module (m [Module Text]))) + (let [find-source' (find-source System contexts name)] + (do (:: System &monad) + [[path file] (try System + (list (find-source' (format host-extension lux-extension)) + (find-source' lux-extension)) + module-not-found [name]) + blob (:: System read file)] + (case (encoding.from-utf8 blob) + (#error.Success code) + (wrap [path code]) + + (#error.Error _) + (:: System throw cannot-read-module [name]))))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 176f7ccf8..21f5c1d3c 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -1,129 +1,240 @@ (.module: lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data (coll [array])) - (time ["i" instant] - ["d" duration]) + (lux (control [monad #+ Monad do] + ["ex" exception #+ Exception exception:] + pipe) + (data [error #+ Error] + text/format + (coll [array])) + (time [instant #+ Instant] + [duration]) (world [blob #+ Blob]) [io #+ Process] - [host])) + [host #+ import:] + [lang/host])) (type: #export File Text) -(exception: #export (could-not-read-all-data {file File}) - file) - -(exception: #export (not-a-directory {file File}) - file) - -(host.import: #long java/io/File - (new [String]) - (exists [] #io #try boolean) - (mkdirs [] #io #try boolean) - (delete [] #io #try boolean) - (length [] #io #try long) - (listFiles [] #io #try #? (Array java/io/File)) - (getAbsolutePath [] #io #try String) - (renameTo [java/io/File] #io #try boolean) - (isFile [] #io #try boolean) - (isDirectory [] #io #try boolean) - (lastModified [] #io #try long) - (setLastModified [long] #io #try boolean) - (canRead [] #io #try boolean) - (canWrite [] #io #try boolean) - (canExecute [] #io #try boolean) - (#static separator String)) - -(host.import: java/lang/AutoCloseable - (close [] #io #try void)) - -(host.import: java/io/OutputStream - (write [(Array byte)] #io #try void) - (flush [] #io #try void)) - -(host.import: java/io/FileOutputStream - (new [java/io/File boolean] #io #try)) - -(host.import: java/io/InputStream - (read [(Array byte)] #io #try int)) - -(host.import: java/io/FileInputStream - (new [java/io/File] #io #try)) - -(do-template [ ] - [(def: #export ( data file) - (-> Blob File (Process Any)) - (do io.Monad - [stream (FileOutputStream::new [(java/io/File::new file) ]) - _ (OutputStream::write [data] stream) - _ (OutputStream::flush [] stream)] - (AutoCloseable::close [] stream)))] - - [append true] - [write false] - ) +(type: #export Permission + #Read + #Write + #Execute) -(def: #export (read file) - (-> File (Process Blob)) - (do io.Monad - [#let [file' (java/io/File::new file)] - size (java/io/File::length [] file') - #let [data (blob.create (.nat size))] - stream (FileInputStream::new [file']) - bytes-read (InputStream::read [data] stream) - _ (AutoCloseable::close [] stream)] - (if (i/= size bytes-read) - (wrap data) - (io.io (ex.throw could-not-read-all-data file))))) - -(def: #export (size file) - (-> File (Process Nat)) - (do io.Monad - [size (java/io/File::length [] (java/io/File::new file))] - (wrap (.nat size)))) - -(def: #export (files dir) - (-> File (Process (List File))) - (do io.Monad - [?files (java/io/File::listFiles [] (java/io/File::new dir))] - (case ?files - (#.Some files) - (monad.map @ (java/io/File::getAbsolutePath []) - (array.to-list files)) - - #.None - (io.throw not-a-directory dir)))) - -(do-template [ ] - [(def: #export ( file) - (-> File (Process Bool)) - ( [] (java/io/File::new file)))] - - [exists? java/io/File::exists] - [make-directory java/io/File::mkdirs] - [delete java/io/File::delete] - [file? java/io/File::isFile] - [directory? java/io/File::isDirectory] - [can-read? java/io/File::canRead] - [can-write? java/io/File::canWrite] - [can-execute? java/io/File::canExecute] - ) +(sig: #export (System m) + (: (Monad m) + &monad) + + (: (All [e a] (-> (Exception e) e (m a))) + throw) + + (: (All [a] (-> (m a) (m (Error a)))) + try) + + (do-template [] + [(: (-> Blob File (m Any)) + )] + + [append] [write]) + + (do-template [ ] + [(: (-> File (m )) + )] + + [read Blob] + [size Nat] + [files (List File)] + [last-modified Instant]) + + (do-template [] + [(: (-> File (m Bool)) + )] -(def: #export (move target source) - (-> File File (Process Bool)) - (java/io/File::renameTo [(java/io/File::new target)] - (java/io/File::new source))) + [file?] + [directory?] + ) -(def: #export (last-modified file) - (-> File (Process i.Instant)) - (do io.Monad - [millis (java/io/File::lastModified [] (java/io/File::new file))] - (wrap (|> millis d.from-millis i.absolute)))) + (: (-> Permission File (m Bool)) + can?) -(def: #export (modify time file) - (-> i.Instant File (Process Bool)) - (java/io/File::setLastModified [(|> time i.relative d.to-millis)] - (java/io/File::new file))) + (do-template [] + [(: (-> File (m Any)) + )] + + [make-directory] + [delete] + ) + + (: (-> File File (m Any)) + move) + + (: (-> Instant File (m Any)) + modify) + + (: Text + separator) + ) + +(do-template [] + [(exception: #export ( {file File}) + (ex.report ["File" file]))] + + [cannot-read-all-data] + [not-a-directory] + [cannot-make-directory] + [cannot-delete] + ) -(def: #export separator Text java/io/File::separator) +(exception: #export (cannot-move {target File} {source File}) + (ex.report ["Source" source] + ["Target" target])) + +(exception: #export (cannot-modify {instant Instant} {file File}) + (ex.report ["Instant" (%instant instant)] + ["File" file])) + +(`` (for {(~~ (static lang/host.jvm)) + (as-is (import: #long java/io/File + (new [String]) + (exists [] #io #try boolean) + (mkdirs [] #io #try boolean) + (delete [] #io #try boolean) + (length [] #io #try long) + (listFiles [] #io #try #? (Array java/io/File)) + (getAbsolutePath [] #io #try String) + (renameTo [java/io/File] #io #try boolean) + (isFile [] #io #try boolean) + (isDirectory [] #io #try boolean) + (lastModified [] #io #try long) + (setLastModified [long] #io #try boolean) + (canRead [] #io #try boolean) + (canWrite [] #io #try boolean) + (canExecute [] #io #try boolean) + (#static separator String)) + + (import: java/lang/AutoCloseable + (close [] #io #try void)) + + (import: java/io/OutputStream + (write [(Array byte)] #io #try void) + (flush [] #io #try void)) + + (import: java/io/FileOutputStream + (new [java/io/File boolean] #io #try)) + + (import: java/io/InputStream + (read [(Array byte)] #io #try int)) + + (import: java/io/FileInputStream + (new [java/io/File] #io #try)) + + (struct: #export JVM@System (System Process) + (def: &monad io.Monad) + + (def: throw io.throw) + + (def: (try computation) + (do io.Monad + [outcome computation] + (:: io.Monad wrap outcome))) + + (do-template [ ] + [(def: ( data file) + (do io.Monad + [stream (FileOutputStream::new [(java/io/File::new file) ]) + _ (OutputStream::write [data] stream) + _ (OutputStream::flush [] stream)] + (AutoCloseable::close [] stream)))] + + [append true] + [write false] + ) + + (def: (read file) + (do io.Monad + [#let [file' (java/io/File::new file)] + size (java/io/File::length [] file') + #let [data (blob.create (.nat size))] + stream (FileInputStream::new [file']) + bytes-read (InputStream::read [data] stream) + _ (AutoCloseable::close [] stream)] + (if (i/= size bytes-read) + (wrap data) + (io.io (ex.throw cannot-read-all-data file))))) + + (def: size + (|>> [] java/io/File::new + (java/io/File::length []) + (:: io.Monad map .nat))) + + (def: (files dir) + (do io.Monad + [?files (java/io/File::listFiles [] (java/io/File::new dir))] + (case ?files + (#.Some files) + (monad.map @ (java/io/File::getAbsolutePath []) + (array.to-list files)) + + #.None + (io.throw not-a-directory dir)))) + + (do-template [ ] + [(def: (|>> [] java/io/File::new ( [])))] + + [file? java/io/File::isFile] + [directory? java/io/File::isDirectory] + ) + + (def: (can? permission file) + (let [jvm-file (java/io/File::new file)] + (case permission + #Read (java/io/File::canRead [] jvm-file) + #Write (java/io/File::canWrite [] jvm-file) + #Execute (java/io/File::canExecute [] jvm-file)))) + + (def: last-modified + (|>> [] java/io/File::new + (java/io/File::lastModified []) + (:: io.Monad map (|>> duration.from-millis instant.absolute)))) + + (do-template [ ] + [(def: ( subject) + (do io.Monad + [outcome ( [] (java/io/File::new subject))] + (case outcome + (#error.Success true) + (wrap (#error.Success [])) + + _ + (io.throw [subject]))))] + + [make-directory cannot-make-directory java/io/File::mkdirs] + [delete cannot-delete java/io/File::delete] + ) + + (do-template [ ] + [(def: ( parameter subject) + (do io.Monad + [outcome ( [(|> parameter )] + (java/io/File::new subject))] + (case outcome + (#error.Success true) + (wrap (#error.Success [])) + + _ + (io.throw [parameter subject]))))] + + [move cannot-move java/io/File::renameTo java/io/File::new] + [modify cannot-modify java/io/File::setLastModified (<| duration.to-millis instant.relative)] + ) + + (def: separator java/io/File::separator) + )) + })) + +(def: #export (exists? System file) + (All [m] (-> (System m) File (m Bool))) + (|> file + (do> (:: System &monad) + [(:: System file?)] + [(if> [(wrap true)] + [(:: System directory? file)])]))) -- cgit v1.2.3