diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/meta/io/context.lux')
-rw-r--r-- | stdlib/source/lux/tool/compiler/meta/io/context.lux | 107 |
1 files changed, 107 insertions, 0 deletions
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux new file mode 100644 index 000000000..be72e4ccc --- /dev/null +++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux @@ -0,0 +1,107 @@ +(.module: + [lux (#- Module Code) + [control + monad + ["ex" exception (#+ Exception exception:)]] + [data + ["." error] + [text + format + ["." encoding]]] + [world + ["." file (#+ File)] + [binary (#+ Binary)]]] + ["." // (#+ Context Code) + [// + [archive + [descriptor (#+ Module)]] + ["//." // (#+ Input) + ["." host]]]]) + +(do-template [<name>] + [(exception: #export (<name> {module Module}) + (ex.report ["Module" module]))] + + [cannot-find-module] + [cannot-read-module] + ) + +(type: #export Extension Text) + +(def: lux-extension + Extension + ".lux") + +(def: partial-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: full-host-extension + Extension + (format partial-host-extension lux-extension)) + +(def: #export (file System<m> context module) + (All [m] (-> (file.System m) Context Module File)) + (|> module + (//.sanitize System<m>) + (format context (:: System<m> separator)))) + +(def: (find-source-file System<m> contexts module extension) + (All [!] + (-> (file.System !) (List Context) Module Extension + (! (Maybe 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 file)) + (find-source-file System<m> contexts' module extension))))) + +(def: (try System<m> computations exception message) + (All [m a e] (-> (file.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 module) + (All [!] + (-> (file.System !) (List Context) Module + (! Input))) + (let [find-source-file' (find-source-file System<m> contexts module)] + (do (:: System<m> &monad) + [file (try System<m> + (list (find-source-file' ..full-host-extension) + (find-source-file' ..lux-extension)) + ..cannot-find-module [module]) + binary (:: System<m> read file)] + (case (encoding.from-utf8 binary) + (#error.Success code) + (wrap {#////.module module + #////.file file + #////.code code}) + + (#error.Failure _) + (:: System<m> throw ..cannot-read-module [module]))))) |