New packaging for Ruby programs.

2 files changed, 142 insertions, 1 deletions

diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux
index d57f52400..5d6fe712e 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux
@@ -26,7 +26,8 @@
   (-> (Dictionary file.Path Binary)
       Archive
       Context
-      (Try Binary)))
+      (Try (Either Binary
+                   (List [Text Binary])))))
 
 (type: .public Order
   (List [archive.ID (List artifact.ID)]))
diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
new file mode 100644
index 000000000..a375a908a
--- /dev/null
+++ b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux
@@ -0,0 +1,140 @@
+(.using
+ [library
+  [lux {"-" Module}
+   [type {"+" :sharing}]
+   [abstract
+    ["[0]" monad {"+" do}]]
+   [control
+    ["[0]" try {"+" Try}]]
+   [data
+    [binary {"+" Binary}]
+    ["[0]" product]
+    ["[0]" text
+     ["%" format {"+" format}]
+     [encoding
+      ["[0]" utf8]]]
+    [collection
+     ["[0]" sequence]
+     ["[0]" list ("[1]#[0]" functor mix)]
+     ["[0]" dictionary {"+" Dictionary}]
+     ["[0]" set {"+" Set}]]]
+   [math
+    [number
+     ["[0]" nat]]]
+   [target
+    ["_" ruby]]
+   [world
+    ["[0]" file]]]]
+ [program
+  [compositor
+   ["[0]" static {"+" Static}]]]
+ ["[0]" // {"+" Packager}
+  [//
+   ["[0]" archive {"+" Output}
+    ["[0]" descriptor {"+" Module Descriptor}]
+    ["[0]" artifact]
+    ["[0]" document {"+" Document}]
+    ["tree_shaking" dependency]]
+   [cache
+    ["[0]" dependency {"+" Order}]]
+   ["[0]" io "_"
+    ["[1]" archive]]
+   [//
+    [language
+     ["$" lux
+      [generation {"+" Context}]]]]]])
+
+(def: (bundle_module module module_id necessary_dependencies output)
+  (-> Module archive.ID (Set Context) Output (Try (Maybe _.Statement)))
+  (do [! try.monad]
+    []
+    (case (|> output
+              sequence.list
+              (list.only (function (_ [artifact_id custom content])
+                           (set.member? necessary_dependencies [module_id artifact_id]))))
+      {.#End}
+      (in {.#None})
+      
+      artifacts
+      (do !
+        [bundle (monad.mix !
+                           (function (_ [artifact custom_name content] so_far)
+                             (|> content
+                                 (# utf8.codec decoded)
+                                 (# ! each
+                                    (|>> :expected
+                                         (:sharing [directive]
+                                                   directive
+                                                   so_far
+                                                   
+                                                   directive)
+                                         (_.then so_far)))))
+                           (_.comment "Lux module"
+                             (_.statement (_.string "")))
+                           artifacts)]
+        (in {.#Some bundle})))))
+
+(def: module_file
+  (-> archive.ID file.Path)
+  (|>> %.nat (text.suffix ".rb")))
+
+(def: (write_module mapping necessary_dependencies [module [module_id [descriptor document output]]] sink)
+  (-> (Dictionary Module archive.ID) (Set Context)
+      [Module [archive.ID [Descriptor (Document .Module) Output]]]
+      (List [archive.ID [Text Binary]])
+      (Try (List [archive.ID [Text Binary]])))
+  (do [! try.monad]
+    [bundle (: (Try (Maybe _.Statement))
+               (..bundle_module module module_id necessary_dependencies output))]
+    (case bundle
+      {.#None}
+      (in sink)
+
+      {.#Some bundle}
+      (let [entry_content (|> (list)
+                              (list#mix _.then bundle)
+                              (: _.Statement)
+                              _.code
+                              (# utf8.codec encoded))]
+        (in (list& [module_id [(..module_file module_id) entry_content]]
+                   sink))))))
+
+(def: .public main_file
+  "main.rb")
+
+(def: module_id_mapping
+  (-> Order (Dictionary Module archive.ID))
+  (|>> (list#each (function (_ [module [module_id [descriptor document output]]])
+                    [module module_id]))
+       (dictionary.of_list text.hash)))
+
+(def: included_modules
+  (All (_ a) (-> (List [archive.ID a]) (Set archive.ID)))
+  (|>> (list#each product.left)
+       (list#mix set.has (set.empty nat.hash))))
+
+(def: .public (package host_dependencies archive program)
+  Packager
+  (do [! try.monad]
+    [.let [necessary_dependencies (tree_shaking.necessary_dependencies archive)]
+     order (dependency.load_order $.key archive)
+     entries (monad.mix ! (..write_module (module_id_mapping order) necessary_dependencies) {.#End} order)
+     .let [included_modules (..included_modules entries)
+           imports (|> order
+                       (list.only (|>> product.right product.left (set.member? included_modules)))
+                       list.reversed
+                       (list#each (function (_ [module [module_id [descriptor document output]]])
+                                    (let [relative_path (_.do "gsub" (list (_.string main_file)
+                                                                           (_.string (..module_file module_id)))
+                                                          {.#None}
+                                                          (_.local "__FILE__"))]
+                                      (_.statement (_.require/1 relative_path)))))
+                       (list#mix _.then (_.comment "Lux program"
+                                          (_.statement (_.string ""))))
+                       (: _.Statement)
+                       _.code
+                       (# utf8.codec encoded))]]
+    (in (|> entries
+            (list#each product.right)
+            {.#Item [..main_file imports]}
+            {.#Right}))))