aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/program/compositor.lux32
-rw-r--r--stdlib/source/program/compositor/cli.lux69
-rw-r--r--stdlib/source/program/compositor/export.lux60
3 files changed, 122 insertions, 39 deletions
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 8993f21e7..d431198fa 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -49,8 +49,9 @@
## ["." interpreter]
]]
["." / #_
- ["#." cli (#+ Configuration)]
- ["#." static (#+ Static)]])
+ ["#." cli (#+ Service)]
+ ["#." static (#+ Static)]
+ ["#." export]])
(def: (or-crash! failure-description action)
(All [a]
@@ -70,7 +71,7 @@
(with-expansions [<parameters> (as-is anchor expression artifact)]
(def: #export (compiler static
expander host-analysis platform generation-bundle host-directive-bundle program extender
- configuration
+ service
packager,package)
(All [<parameters>]
(-> Static
@@ -81,7 +82,7 @@
(directive.Bundle <parameters>)
(-> expression artifact)
Extender
- Configuration
+ Service
[(-> (Row [Module (generation.Buffer artifact)]) Binary) Path]
(Promise Any)))
(do {@ promise.monad}
@@ -89,27 +90,36 @@
console (|> console.system
promise.future
(:: @ map (|>> try.assume console.async)))]
- (case (get@ #/cli.service configuration)
- #/cli.Compilation
+ (case service
+ (#/cli.Compilation compilation)
(<| (or-crash! "Compilation failed:")
(do (try.with promise.monad)
- [[state archive] (:share [<parameters>]
+ [#let [[compilation-sources compilation-target compilation-module] compilation]
+ [state archive] (:share [<parameters>]
{(Platform <parameters>)
platform}
{(Promise (Try [(directive.State+ <parameters>)
Archive]))
- (:assume (platform.initialize static (get@ #/cli.module configuration) expander host-analysis platform generation-bundle host-directive-bundle program extender))})
+ (:assume (platform.initialize static compilation-module expander host-analysis platform generation-bundle host-directive-bundle program extender))})
[archive state] (:share [<parameters>]
{(Platform <parameters>)
platform}
{(Promise (Try [Archive (directive.State+ <parameters>)]))
- (:assume (platform.compile static expander platform configuration [archive state]))})
+ (:assume (platform.compile static expander platform compilation [archive state]))})
_ (ioW.freeze (get@ #platform.&file-system platform) (get@ #/static.host static) (get@ #/static.target static) archive)]
(wrap (log! "Compilation complete!"))))
+
+ (#/cli.Export export)
+ (<| (or-crash! "Export failed:")
+ (do (try.with promise.monad)
+ [_ (/export.export (get@ #platform.&file-system platform)
+ (get@ #/static.host-module-extension static)
+ export)]
+ (wrap (log! "Export complete!"))))
- #/cli.Interpretation
+ (#/cli.Interpretation interpretation)
## TODO: Fix the interpreter...
(undefined)
## (<| (or-crash! "Interpretation failed:")
- ## (interpreter.run (try.with promise.monad) console platform configuration generation-bundle))
+ ## (interpreter.run (try.with promise.monad) console platform interpretation generation-bundle))
))))
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))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 14:55:17 +0000