diff options
Diffstat (limited to 'stdlib/source/lux/lang/compiler/meta')
| -rw-r--r-- | stdlib/source/lux/lang/compiler/meta/io.lux | 16 | ||||
| -rw-r--r-- | stdlib/source/lux/lang/compiler/meta/io/archive.lux | 70 | ||||
| -rw-r--r-- | stdlib/source/lux/lang/compiler/meta/io/context.lux | 89 |
3 files changed, 175 insertions, 0 deletions
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]))))) |