diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/library/lux/tool/compiler/meta/io/context.lux | 170 |
1 files changed, 170 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/context.lux b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux new file mode 100644 index 000000000..6e619d93d --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/io/context.lux @@ -0,0 +1,170 @@ +(.module: + [library + [lux (#- Module Code) + ["@" target] + [abstract + [predicate (#+ Predicate)] + ["." monad (#+ Monad do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + [concurrency + ["." promise (#+ Promise) ("#\." monad)]]] + [data + [binary (#+ Binary)] + ["." text ("#\." hash) + ["%" format (#+ format)] + [encoding + ["." utf8]]] + [collection + ["." dictionary (#+ Dictionary)]]] + [world + ["." file]]]] + [program + [compositor + [import (#+ Import)]]] + ["." // (#+ Context Code) + ["/#" // #_ + [archive + [descriptor (#+ Module)]] + ["/#" // (#+ Input)]]]) + +(exception: #export (cannot_find_module {importer Module} {module Module}) + (exception.report + ["Module" (%.text module)] + ["Importer" (%.text importer)])) + +(exception: #export (cannot_read_module {module Module}) + (exception.report + ["Module" (%.text module)])) + +(type: #export Extension + Text) + +(def: lux_extension + Extension + ".lux") + +(def: #export (path fs context module) + (All [m] (-> (file.System m) Context Module file.Path)) + (|> module + (//.sanitize fs) + (format context (\ fs separator)))) + +(def: (find_source_file fs importer contexts module extension) + (-> (file.System Promise) Module (List Context) Module Extension + (Promise (Try file.Path))) + (case contexts + #.Nil + (promise\wrap (exception.throw ..cannot_find_module [importer module])) + + (#.Cons context contexts') + (let [path (format (..path fs context module) extension)] + (do promise.monad + [? (\ fs file? path)] + (if ? + (wrap (#try.Success path)) + (find_source_file fs importer contexts' module extension)))))) + +(def: (full_host_extension partial_host_extension) + (-> Extension Extension) + (format partial_host_extension ..lux_extension)) + +(def: (find_local_source_file fs importer import contexts partial_host_extension module) + (-> (file.System Promise) Module Import (List Context) Extension Module + (Promise (Try [file.Path Binary]))) + ## Preference is explicitly being given to Lux files that have a host extension. + ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. + (do {! promise.monad} + [outcome (..find_source_file fs importer contexts module (..full_host_extension partial_host_extension))] + (case outcome + (#try.Success path) + (|> path + (\ fs read) + (\ (try.with !) map (|>> [path]))) + + (#try.Failure _) + (do {! (try.with !)} + [path (..find_source_file fs importer contexts module ..lux_extension)] + (|> path + (\ fs read) + (\ ! map (|>> [path]))))))) + +(def: (find_library_source_file importer import partial_host_extension module) + (-> Module Import Extension Module (Try [file.Path Binary])) + (let [path (format module (..full_host_extension partial_host_extension))] + (case (dictionary.get path import) + (#.Some data) + (#try.Success [path data]) + + #.None + (let [path (format module ..lux_extension)] + (case (dictionary.get path import) + (#.Some data) + (#try.Success [path data]) + + #.None + (exception.throw ..cannot_find_module [importer module])))))) + +(def: (find_any_source_file fs importer import contexts partial_host_extension module) + (-> (file.System Promise) Module Import (List Context) Extension Module + (Promise (Try [file.Path Binary]))) + ## Preference is explicitly being given to Lux files that have a host extension. + ## Normal Lux files (i.e. without a host extension) are then picked as fallback files. + (do {! promise.monad} + [outcome (find_local_source_file fs importer import contexts partial_host_extension module)] + (case outcome + (#try.Success [path data]) + (wrap outcome) + + (#try.Failure _) + (wrap (..find_library_source_file importer import partial_host_extension module))))) + +(def: #export (read fs importer import contexts partial_host_extension module) + (-> (file.System Promise) Module Import (List Context) Extension Module + (Promise (Try Input))) + (do (try.with promise.monad) + [[path binary] (..find_any_source_file fs importer import contexts partial_host_extension module)] + (case (\ utf8.codec decode binary) + (#try.Success code) + (wrap {#////.module module + #////.file path + #////.hash (text\hash code) + #////.code code}) + + (#try.Failure _) + (promise\wrap (exception.throw ..cannot_read_module [module]))))) + +(type: #export Enumeration + (Dictionary file.Path Binary)) + +(def: (enumerate_context fs directory enumeration) + (-> (file.System Promise) Context Enumeration (Promise (Try Enumeration))) + (do {! (try.with promise.monad)} + [enumeration (|> directory + (\ fs directory_files) + (\ ! map (monad.fold ! (function (_ file enumeration) + (if (text.ends_with? ..lux_extension file) + (do ! + [source_code (\ fs read file)] + (promise\wrap + (dictionary.try_put (file.name fs file) source_code enumeration))) + (wrap enumeration))) + enumeration)) + (\ ! join))] + (|> directory + (\ fs sub_directories) + (\ ! map (monad.fold ! (enumerate_context fs) enumeration)) + (\ ! join)))) + +(def: Action + (type (All [a] (Promise (Try a))))) + +(def: #export (enumerate fs contexts) + (-> (file.System Promise) (List Context) (Action Enumeration)) + (monad.fold (: (Monad Action) + (try.with promise.monad)) + (..enumerate_context fs) + (: Enumeration + (dictionary.new text.hash)) + contexts)) |