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))