aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/compositor
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/program/compositor.lux145
1 files changed, 75 insertions, 70 deletions
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 31f018081..53598f8b5 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -9,7 +9,9 @@
[parser
[cli (#+ program:)]]
[security
- ["!" capability]]]
+ ["!" capability]]
+ [concurrency
+ ["." promise (#+ Promise)]]]
[data
[binary (#+ Binary)]
["." product]
@@ -44,84 +46,87 @@
(def: (or-crash! failure-description action)
(All [a]
- (-> Text (IO (Try a)) (IO a)))
- (do io.monad
+ (-> Text (Promise (Try a)) (Promise a)))
+ (do promise.monad
[?output action]
(case ?output
(#try.Failure error)
(exec (log! (format text.new-line
failure-description text.new-line
error text.new-line))
- (io.exit +1))
+ (io.run (io.exit +1)))
(#try.Success output)
(wrap output))))
-(def: (save-artifacts! system state [packager package])
- (All [anchor expression directive]
- (-> (file.System IO)
- (directive.State+ anchor expression directive)
- [(-> (generation.Output directive) Binary) Path]
- (IO (Try Any))))
- (let [?outcome (phase.run' state
- (:share [anchor expression directive]
- {(directive.State+ anchor expression directive)
- state}
- {(directive.Operation anchor expression directive
- (generation.Output directive))
- (directive.lift-generation generation.output)}))]
- (case ?outcome
- (#try.Success [state output])
- (do (try.with io.monad)
- [file (: (IO (Try (File IO)))
- (file.get-file io.monad system package))]
- (!.use (:: file over-write) (packager output)))
+(with-expansions [<parameters> (as-is anchor expression artifact)]
+ (def: (save-artifacts! system state [packager package])
+ (All [<parameters>]
+ (-> (file.System Promise)
+ (directive.State+ <parameters>)
+ [(-> (generation.Output artifact) Binary) Path]
+ (Promise (Try Any))))
+ (let [?outcome (phase.run' state
+ (:share [<parameters>]
+ {(directive.State+ <parameters>)
+ state}
+ {(directive.Operation <parameters>
+ (generation.Output artifact))
+ (directive.lift-generation generation.output)}))]
+ (case ?outcome
+ (#try.Success [state output])
+ (do (try.with promise.monad)
+ [file (: (Promise (Try (File Promise)))
+ (file.get-file promise.monad system package))]
+ (!.use (:: file over-write) (packager output)))
- (#try.Failure error)
- (:: io.monad wrap (#try.Failure error)))))
+ (#try.Failure error)
+ (:: promise.monad wrap (#try.Failure error)))))
-(def: #export (compiler target partial-host-extension
- expander host-analysis platform generation-bundle host-directive-bundle program extender
- service
- packager,package)
- (All [anchor expression directive]
- (-> Text
- Text
- Expander
- analysis.Bundle
- (IO (Platform IO anchor expression directive))
- (generation.Bundle anchor expression directive)
- (directive.Bundle anchor expression directive)
- (-> expression directive)
- Extender
- Service
- [(-> (generation.Output directive) Binary) Path]
- (IO Any)))
- (do io.monad
- [platform platform
- console (:: @ map try.assume console.system)]
- (case service
- (#cli.Compilation configuration)
- (<| (or-crash! "Compilation failed:")
- (do (try.with io.monad)
- [state (:share [anchor expression directive]
- {(Platform IO anchor expression directive)
- platform}
- {(IO (Try (directive.State+ anchor expression directive)))
- (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)})
- [archive state] (:share [anchor expression directive]
- {(Platform IO anchor expression directive)
- platform}
- {(IO (Try [Archive (directive.State+ anchor expression directive)]))
- (platform.compile partial-host-extension expander platform configuration archive.empty state)})
- _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package)
- ## _ (cache/io.clean target ...)
- ]
- (wrap (log! "Compilation complete!"))))
-
- (#cli.Interpretation configuration)
- ## TODO: Fix the interpreter...
- (undefined)
- ## (<| (or-crash! "Interpretation failed:")
- ## (interpreter.run (try.with io.monad) console platform configuration generation-bundle))
- )))
+ (def: #export (compiler target partial-host-extension
+ expander host-analysis platform generation-bundle host-directive-bundle program extender
+ service
+ packager,package)
+ (All [<parameters>]
+ (-> Text
+ Text
+ Expander
+ analysis.Bundle
+ (IO (Platform <parameters>))
+ (generation.Bundle <parameters>)
+ (directive.Bundle <parameters>)
+ (-> expression artifact)
+ Extender
+ Service
+ [(-> (generation.Output artifact) Binary) Path]
+ (Promise Any)))
+ (do promise.monad
+ [platform (promise.future platform)
+ console (|> console.system
+ promise.future
+ (:: @ map (|>> try.assume console.async)))]
+ (case service
+ (#cli.Compilation configuration)
+ (<| (or-crash! "Compilation failed:")
+ (do (try.with promise.monad)
+ [state (:share [<parameters>]
+ {(Platform <parameters>)
+ platform}
+ {(Promise (Try (directive.State+ <parameters>)))
+ (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)})
+ [archive state] (:share [<parameters>]
+ {(Platform <parameters>)
+ platform}
+ {(Promise (Try [Archive (directive.State+ <parameters>)]))
+ (platform.compile partial-host-extension expander platform configuration archive.empty state)})
+ _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package)
+ ## _ (cache/io.clean target ...)
+ ]
+ (wrap (log! "Compilation complete!"))))
+
+ (#cli.Interpretation configuration)
+ ## TODO: Fix the interpreter...
+ (undefined)
+ ## (<| (or-crash! "Interpretation failed:")
+ ## (interpreter.run (try.with promise.monad) console platform configuration generation-bundle))
+ ))))