From fcb1dcee2a4d502b41852a4c8e26b53ae7b2041e Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 28 May 2020 22:13:39 -0400
Subject: Can now export Lux code as library TAR files.

---
 stdlib/source/program/compositor/cli.lux    | 69 +++++++++++++++++------------
 stdlib/source/program/compositor/export.lux | 60 +++++++++++++++++++++++++
 2 files changed, 101 insertions(+), 28 deletions(-)
 create mode 100644 stdlib/source/program/compositor/export.lux

(limited to 'stdlib/source/program/compositor')

diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux
index 0c20257ed..940665680 100644
--- a/stdlib/source/program/compositor/cli.lux
+++ b/stdlib/source/program/compositor/cli.lux
@@ -1,42 +1,55 @@
 (.module:
-  [lux #*
+  [lux (#- Module Source)
    [control
-    ["p" parser
+    ["<>" parser
      ["." cli (#+ Parser)]]]
+   [tool
+    [compiler
+     [meta
+      [archive
+       [descriptor (#+ Module)]]]]]
    [world
     [file (#+ Path)]]])
 
-(type: #export Service
-  #Compilation
-  #Interpretation)
+(type: #export Source Path)
+(type: #export Target Path)
+
+(type: #export Compilation
+  [(List Source) Target Module])
+
+(type: #export Export
+  [(List Source) Target])
 
-(type: #export Configuration
-  {#service Service
-   #sources (List Path)
-   #target Path
-   #module Text})
+(type: #export Service
+  (#Compilation Compilation)
+  (#Interpretation Compilation)
+  (#Export Export))
 
-(template [<name> <long>]
+(template [<name> <long> <type>]
   [(def: <name>
-     (Parser Text)
+     (Parser <type>)
      (cli.named <long> cli.any))]
 
-  [source "--source"]
-  [target "--target"]
-  [module "--module"]
+  [source "--source" Source]
+  [target "--target" Target]
+  [module "--module" Module]
   )
 
-
-(def: service
+(def: #export service
   (Parser Service)
-  ($_ p.or
-      (cli.this "build")
-      (cli.this "repl")))
-
-(def: #export configuration
-  (Parser Configuration)
-  ($_ p.and
-      ..service
-      (p.some ..source)
-      ..target
-      ..module))
+  ($_ <>.or
+      (<>.after (cli.this "build")
+                ($_ <>.and
+                    (<>.some ..source)
+                    ..target
+                    ..module))
+      (<>.after (cli.this "repl")
+                ($_ <>.and
+                    (<>.some ..source)
+                    ..target
+                    ..module))
+      (<>.after (cli.this "export")
+                ($_ <>.and
+                    (<>.some ..source)
+                    ..target))
+      ))
diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux
new file mode 100644
index 000000000..6e364800f
--- /dev/null
+++ b/stdlib/source/program/compositor/export.lux
@@ -0,0 +1,60 @@
+(.module:
+  [lux #*
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["." try (#+ Try)]
+    [concurrency
+     ["." promise (#+ Promise) ("#@." monad)]]
+    [security
+     ["!" capability]]]
+   [data
+    [text
+     ["%" format (#+ format)]]
+    [collection
+     ["." dictionary]
+     ["." row]]
+    [format
+     ["." binary]
+     ["." tar]]]
+   [time
+    ["." instant]]
+   [tool
+    [compiler
+     [meta
+      ["." io #_
+       ["#" context (#+ Extension)]]]]]
+   [world
+    ["." file]]]
+  [//
+   [cli (#+ Export)]])
+
+(def: no-ownership
+  tar.Ownership
+  (let [commons (: tar.Owner
+                   {#tar.name tar.anonymous
+                    #tar.id tar.no-id})]
+    {#tar.user commons
+     #tar.group commons}))
+
+(def: #export (export system extension [sources target])
+  (-> (file.System Promise) Extension Export (Promise (Try Any)))
+  (let [package (format target (:: system separator) "library.tar")]
+    (do (try.with promise.monad)
+      [package (: (Promise (Try (file.File Promise)))
+                  (file.get-file promise.monad system package))
+       files (io.enumerate system extension sources)
+       tar (|> (dictionary.entries files)
+               (monad.map try.monad
+                          (function (_ [path source-code])
+                            (do try.monad
+                              [path (tar.path path)
+                               source-code (tar.content source-code)]
+                              (wrap (#tar.Normal [path
+                                                  (instant.from-millis +0)
+                                                  tar.none
+                                                  ..no-ownership
+                                                  source-code])))))
+               (:: try.monad map (|>> row.from-list (binary.run tar.writer)))
+               promise@wrap)]
+      (!.use (:: package over-write) tar))))
-- 
cgit v1.2.3