aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--new-luxc/source/luxc/io.jvm.lux121
-rw-r--r--stdlib/source/lux/control/pipe.lux5
-rw-r--r--stdlib/source/lux/lang/compiler/meta/io.lux16
-rw-r--r--stdlib/source/lux/lang/compiler/meta/io/archive.lux70
-rw-r--r--stdlib/source/lux/lang/compiler/meta/io/context.lux89
-rw-r--r--stdlib/source/lux/world/file.lux345
6 files changed, 408 insertions, 238 deletions
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>]
- 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 [<name>]
- [(exception: #export (<name> {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<Process>
- [#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<IO>
- [?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<Process>
- [[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<Process>
- [_ (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<Process>
- [#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<m> root)
+ (All [m] (-> (System m) File File))
+ (<| (format root (:: System<m> 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<m> root module)
+ (All [m] (-> (System m) File Module Document))
+ (let [archive (..archive System<m> root)]
+ (|> module
+ (//.sanitize System<m>)
+ (format archive (:: System<m> separator)))))
+
+(def: #export (prepare System<m> root module)
+ (All [m] (-> (System m) File Module (m Any)))
+ (do (:: System<m> &monad)
+ [#let [archive (..archive System<m> root)
+ document (..document System<m> root module)]
+ document-exists? (file.exists? System<m> document)]
+ (if document-exists?
+ (wrap [])
+ (do @
+ [outcome (:: System<m> try (:: System<m> make-directory document))]
+ (case outcome
+ (#error.Success output)
+ (wrap output)
+
+ (#error.Error _)
+ (:: System<m> throw cannot-prepare [archive module]))))))
+
+(def: #export (write System<m> root content name)
+ (All [m] (-> (System m) File Blob Text (m Any)))
+ (:: System<m> write content (..document System<m> root name)))
+
+(def: #export (module System<m> root document)
+ (All [m] (-> (System m) File Document (Maybe Module)))
+ (case (text.split-with (..archive System<m> root) document)
+ (#.Some ["" post])
+ (let [raw (text.replace-all (:: System<m> 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<m> context module)
+ (All [m] (-> (System m) Context Module File))
+ (|> module
+ (//.sanitize System<m>)
+ (format context (:: System<m> 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 [<name>]
+ [(exception: #export (<name> {module Module})
+ (ex.report ["Module" module]))]
+
+ [module-not-found]
+ [cannot-read-module]
+ )
+
+(def: (find-source System<m> contexts module extension)
+ (All [m] (-> (System m) (List Context) Module Text (m (Maybe [Module File]))))
+ (case contexts
+ #.Nil
+ (:: (:: System<m> &monad) wrap #.None)
+
+ (#.Cons context contexts')
+ (do (:: System<m> &monad)
+ [#let [file (format (..file System<m> context module) extension)]
+ ? (file.exists? System<m> file)]
+ (if ?
+ (wrap (#.Some [module file]))
+ (find-source System<m> contexts' module)))))
+
+(def: (try System<m> computations exception message)
+ (All [m a e] (-> (System m) (List (m (Maybe a))) (Exception e) e (m a)))
+ (case computations
+ #.Nil
+ (:: System<m> throw exception message)
+
+ (#.Cons computation computations')
+ (do (:: System<m> &monad)
+ [outcome computation]
+ (case outcome
+ (#.Some output)
+ (wrap output)
+
+ #.None
+ (try System<m> computations' exception message)))))
+
+(def: #export (read System<m> contexts name)
+ (All [m] (-> (System m) (List Context) Module (m [Module Text])))
+ (let [find-source' (find-source System<m> contexts name)]
+ (do (:: System<m> &monad)
+ [[path file] (try System<m>
+ (list (find-source' (format host-extension lux-extension))
+ (find-source' lux-extension))
+ module-not-found [name])
+ blob (:: System<m> read file)]
+ (case (encoding.from-utf8 blob)
+ (#error.Success code)
+ (wrap [path code])
+
+ (#error.Error _)
+ (:: System<m> 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 [<name> <flag>]
- [(def: #export (<name> data file)
- (-> Blob File (Process Any))
- (do io.Monad<Process>
- [stream (FileOutputStream::new [(java/io/File::new file) <flag>])
- _ (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<Process>
- [#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<Process>
- [size (java/io/File::length [] (java/io/File::new file))]
- (wrap (.nat size))))
-
-(def: #export (files dir)
- (-> File (Process (List File)))
- (do io.Monad<Process>
- [?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 [<name> <method>]
- [(def: #export (<name> file)
- (-> File (Process Bool))
- (<method> [] (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 [<name>]
+ [(: (-> Blob File (m Any))
+ <name>)]
+
+ [append] [write])
+
+ (do-template [<name> <output>]
+ [(: (-> File (m <output>))
+ <name>)]
+
+ [read Blob]
+ [size Nat]
+ [files (List File)]
+ [last-modified Instant])
+
+ (do-template [<name>]
+ [(: (-> File (m Bool))
+ <name>)]
-(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<Process>
- [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 [<name>]
+ [(: (-> File (m Any))
+ <name>)]
+
+ [make-directory]
+ [delete]
+ )
+
+ (: (-> File File (m Any))
+ move)
+
+ (: (-> Instant File (m Any))
+ modify)
+
+ (: Text
+ separator)
+ )
+
+(do-template [<name>]
+ [(exception: #export (<name> {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<Process>)
+
+ (def: throw io.throw)
+
+ (def: (try computation)
+ (do io.Monad<IO>
+ [outcome computation]
+ (:: io.Monad<Process> wrap outcome)))
+
+ (do-template [<name> <flag>]
+ [(def: (<name> data file)
+ (do io.Monad<Process>
+ [stream (FileOutputStream::new [(java/io/File::new file) <flag>])
+ _ (OutputStream::write [data] stream)
+ _ (OutputStream::flush [] stream)]
+ (AutoCloseable::close [] stream)))]
+
+ [append true]
+ [write false]
+ )
+
+ (def: (read file)
+ (do io.Monad<Process>
+ [#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<Process> map .nat)))
+
+ (def: (files dir)
+ (do io.Monad<Process>
+ [?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 [<name> <method>]
+ [(def: <name> (|>> [] java/io/File::new (<method> [])))]
+
+ [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<Process> map (|>> duration.from-millis instant.absolute))))
+
+ (do-template [<name> <exception> <method>]
+ [(def: (<name> subject)
+ (do io.Monad<IO>
+ [outcome (<method> [] (java/io/File::new subject))]
+ (case outcome
+ (#error.Success true)
+ (wrap (#error.Success []))
+
+ _
+ (io.throw <exception> [subject]))))]
+
+ [make-directory cannot-make-directory java/io/File::mkdirs]
+ [delete cannot-delete java/io/File::delete]
+ )
+
+ (do-template [<name> <exception> <method> <parameter-pre>]
+ [(def: (<name> parameter subject)
+ (do io.Monad<IO>
+ [outcome (<method> [(|> parameter <parameter-pre>)]
+ (java/io/File::new subject))]
+ (case outcome
+ (#error.Success true)
+ (wrap (#error.Success []))
+
+ _
+ (io.throw <exception> [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<m> file)
+ (All [m] (-> (System m) File (m Bool)))
+ (|> file
+ (do> (:: System<m> &monad)
+ [(:: System<m> file?)]
+ [(if> [(wrap true)]
+ [(:: System<m> directory? file)])])))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 07:55:13 +0000