diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/meta/packager/jvm.lux')
-rw-r--r-- | stdlib/source/lux/tool/compiler/meta/packager/jvm.lux | 159 |
1 files changed, 159 insertions, 0 deletions
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux new file mode 100644 index 000000000..7478a3bc2 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/meta/packager/jvm.lux @@ -0,0 +1,159 @@ +(.module: + [lux (#- Module Definition) + [type (#+ :share)] + ["." host (#+ import: do-to)] + [abstract + ["." monad (#+ Monad do)]] + [control + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]] + [security + ["!" capability]]] + [data + ["." binary (#+ Binary)] + ["." text + ["%" format (#+ format)]] + [number + ["n" nat]] + [collection + ["." row (#+ Row)] + ["." list ("#@." functor fold)]]] + [target + [jvm + [encoding + ["." name]]]] + [world + ["." file (#+ File Directory)]]] + [program + [compositor + ["." static (#+ Static)]]] + ["." // (#+ Packager) + [// + ["." archive + ["." descriptor (#+ Module)] + ["." artifact]] + ["." io #_ + ["#" archive]] + [// + [language + ["$" lux + [generation (#+ Context)] + [phase + [generation + [jvm + ["." runtime (#+ Definition)]]]]]]]]]) + +(import: #long java/lang/Object) + +(import: #long java/lang/String) + +(import: #long java/util/jar/Attributes + (put [java/lang/Object java/lang/Object] #? java/lang/Object)) + +(import: #long java/util/jar/Attributes$Name + (#static MAIN_CLASS java/util/jar/Attributes$Name) + (#static MANIFEST_VERSION java/util/jar/Attributes$Name)) + +(import: #long java/util/jar/Manifest + (new []) + (getMainAttributes [] java/util/jar/Attributes)) + +(import: #long java/io/Flushable + (flush [] void)) + +(import: #long java/io/Closeable + (close [] void)) + +(import: #long java/io/OutputStream) + +(import: #long java/io/ByteArrayOutputStream + (new [int]) + (toByteArray [] [byte])) + +(import: #long java/util/zip/ZipEntry) + +(import: #long java/util/zip/ZipOutputStream + (write [[byte] int int] void) + (closeEntry [] void)) + +(import: #long java/util/jar/JarEntry + (new [java/lang/String])) + +(import: #long java/util/jar/JarOutputStream + (new [java/io/OutputStream java/util/jar/Manifest]) + (putNextEntry [java/util/zip/ZipEntry] void)) + +(def: byte 1) +## https://en.wikipedia.org/wiki/Kibibyte +(def: kibi-byte (n.* 1,024 byte)) +## https://en.wikipedia.org/wiki/Mebibyte +(def: mebi-byte (n.* 1,024 kibi-byte)) + +(def: manifest-version "1.0") + +(def: (manifest program) + (-> Context java/util/jar/Manifest) + (let [manifest (java/util/jar/Manifest::new)] + (exec (do-to (java/util/jar/Manifest::getMainAttributes manifest) + (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MAIN_CLASS) (|> program runtime.class-name name.internal name.external)) + (java/util/jar/Attributes::put (java/util/jar/Attributes$Name::MANIFEST_VERSION) ..manifest-version)) + manifest))) + +## TODO: Delete ASAP +(type: (Action ! a) + (! (Try a))) + +(def: (write-class monad file-system static context sink) + (All [!] + (-> (Monad !) (file.System !) Static Context java/util/jar/JarOutputStream + (Action ! java/util/jar/JarOutputStream))) + (do (try.with monad) + [artifact (let [[module artifact] context] + (!.use (:: file-system file) [(io.artifact file-system static module (%.nat artifact))])) + content (!.use (:: artifact content) []) + #let [class-path (format (runtime.class-name context) (get@ #static.artifact-extension static))]] + (wrap (do-to sink + (java/util/jar/JarOutputStream::putNextEntry (java/util/jar/JarEntry::new class-path)) + (java/util/zip/ZipOutputStream::write content +0 (.int (binary.size content))) + (java/io/Flushable::flush) + (java/util/zip/ZipOutputStream::closeEntry))))) + +(def: (write-module monad file-system static [module artifacts] sink) + (All [!] + (-> (Monad !) (file.System !) Static [archive.ID (List artifact.ID)] java/util/jar/JarOutputStream + (Action ! java/util/jar/JarOutputStream))) + (monad.fold (:assume (try.with monad)) + (function (_ artifact sink) + (..write-class monad file-system static [module artifact] sink)) + sink + artifacts)) + +(def: #export (package monad file-system static archive program) + (All [!] (Packager !)) + (do {@ (try.with monad)} + [cache (:share [!] + {(Monad !) + monad} + {(! (Try (Directory !))) + (:assume (!.use (:: file-system directory) [(get@ #static.target static)]))}) + order (|> archive + archive.archived + (monad.map try.monad (function (_ module) + (do try.monad + [[descriptor document] (archive.find module archive) + module-id (archive.id module archive)] + (wrap (|> descriptor + (get@ #descriptor.registry) + artifact.artifacts + row.to-list + (list@map (|>> (get@ #artifact.id))) + [module-id]))))) + (:: monad wrap)) + #let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi-byte)) + sink (java/util/jar/JarOutputStream::new buffer (..manifest program))] + sink (monad.fold @ (..write-module monad file-system static) sink order) + #let [_ (do-to sink + (java/io/Flushable::flush) + (java/io/Closeable::close))]] + (wrap (java/io/ByteArrayOutputStream::toByteArray buffer)))) |