aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/program')
-rw-r--r--stdlib/source/program/aedifex.lux48
-rw-r--r--stdlib/source/program/aedifex/cli.lux16
-rw-r--r--stdlib/source/program/aedifex/local.lux86
-rw-r--r--stdlib/source/program/aedifex/parser.lux7
-rw-r--r--stdlib/source/program/aedifex/pom.lux3
-rw-r--r--stdlib/source/program/aedifex/project.lux14
-rw-r--r--stdlib/source/program/compositor/cli.lux11
-rw-r--r--stdlib/source/program/compositor/export.lux56
8 files changed, 196 insertions, 45 deletions
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
index fd269f71f..6909704dd 100644
--- a/stdlib/source/program/aedifex.lux
+++ b/stdlib/source/program/aedifex.lux
@@ -10,7 +10,9 @@
["." cli (#+ program:)]
["<c>" code]]
[security
- ["!" capability]]]
+ ["!" capability]]
+ [concurrency
+ ["." promise]]]
[data
[binary (#+ Binary)]
["." text
@@ -28,7 +30,9 @@
["." / #_
["#" project]
["#." parser]
- ["#." pom]])
+ ["#." pom]
+ ["#." cli]
+ ["#." local]])
(def: (read-file! path)
(-> Path (IO (Try Binary)))
@@ -67,22 +71,36 @@
[..read-code]
[(list) (<c>.run /parser.project)])))
-(program: [project-file]
+(program: [{command /cli.command}]
(do {@ io.monad}
- [data (..read-file! project-file)]
+ [data (..read-file! /.file)]
(case data
(#try.Success data)
(case (..project data)
- (#try.Success value)
- (do @
- [outcome (..write-pom! /pom.file value)]
- (case outcome
- (#try.Success value)
- (wrap (log! "Successfully wrote POM file!"))
-
- (#try.Failure error)
- (wrap (log! (format "Could not write POM file:" text.new-line
- error)))))
+ (#try.Success project)
+ (case command
+ #/cli.POM
+ (do @
+ [outcome (..write-pom! /pom.file project)]
+ (case outcome
+ (#try.Success value)
+ (wrap (log! "Successfully wrote POM file!"))
+
+ (#try.Failure error)
+ (wrap (log! (format "Could not write POM file:" text.new-line
+ error)))))
+
+ #/cli.Install
+ (exec (do promise.monad
+ [outcome (/local.install (file.async file.system) project)]
+ (wrap (case outcome
+ (#try.Success _)
+ (log! "Successfully installed locally!")
+
+ (#try.Failure error)
+ (log! (format "Could not install locally:" text.new-line
+ error)))))
+ (wrap [])))
(#try.Failure error)
(wrap (log! (format "Invalid format file:" text.new-line
@@ -90,4 +108,4 @@
(#try.Failure error)
(wrap (log! (format "Could not read file: "
- (%.text project-file)))))))
+ (%.text /.file)))))))
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
new file mode 100644
index 000000000..5f75cac9b
--- /dev/null
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -0,0 +1,16 @@
+(.module:
+ [lux #*
+ [control
+ ["<>" parser
+ ["." cli (#+ Parser)]]]])
+
+(type: #export Command
+ #POM
+ #Install)
+
+(def: #export command
+ (Parser Command)
+ ($_ <>.or
+ (cli.this "pom")
+ (cli.this "install")
+ ))
diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux
new file mode 100644
index 000000000..15d9a9323
--- /dev/null
+++ b/stdlib/source/program/aedifex/local.lux
@@ -0,0 +1,86 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." io (#+ IO)]
+ ["." try (#+ Try)]
+ [concurrency
+ ["." promise (#+ Promise)]]
+ [security
+ ["!" capability]]]
+ [data
+ [binary (#+ Binary)]
+ ["." text
+ ["%" format (#+ format)]
+ ["." encoding]]
+ [collection
+ ["." list ("#@." monoid)]]
+ [format
+ ["." binary]
+ ["." tar]
+ ["." xml]]]
+ [world
+ ["." file (#+ Path File Directory)]]]
+ [program
+ [compositor
+ ["." export]]]
+ ["." // #_
+ ["#." project (#+ Project)]
+ ["#." pom]
+ ["#." dependency]])
+
+(def: group-separator
+ ".")
+
+(def: (local system)
+ (All [a] (-> (file.System a) Path))
+ (format "~" (:: system separator) ".m2"))
+
+(def: (repository system)
+ (All [a] (-> (file.System a) Path))
+ (format (..local system) (:: system separator) "repository"))
+
+(def: (guarantee-repository! system project)
+ (-> (file.System Promise) Project (Promise (Try Path)))
+ (do {@ (try.with promise.monad)}
+ [_ (: (Promise (Try (Directory Promise)))
+ (file.get-directory promise.monad system (..local system)))
+ #let [root (..repository system)
+ identity (get@ #//project.identity project)]
+ _ (: (Promise (Try (Directory Promise)))
+ (file.get-directory promise.monad system root))]
+ (monad.fold @
+ (function (_ child parent)
+ (do @
+ [#let [path (format parent (:: system separator) child)]
+ _ (: (Promise (Try (Directory Promise)))
+ (file.get-directory promise.monad system path))]
+ (wrap path)))
+ root
+ (list@compose (|> identity
+ (get@ #//project.group)
+ (text.split-all-with ..group-separator))
+ (list (get@ #//project.name identity)
+ (get@ #//project.version identity))))))
+
+(def: (save! system content file)
+ (-> (file.System Promise) Binary Path (Promise (Try Any)))
+ (do (try.with promise.monad)
+ [file (: (Promise (Try (File Promise)))
+ (file.get-file promise.monad system file))]
+ (!.use (:: file over-write) [content])))
+
+(def: #export (install system project)
+ (-> (file.System Promise) Project (Promise (Try Any)))
+ (do (try.with promise.monad)
+ [repository (..guarantee-repository! system project)
+ #let [identity (get@ #//project.identity project)
+ artifact-name (format repository
+ (:: system separator) (get@ #//project.name identity)
+ "-" (get@ #//project.version identity))]
+ package (export.library system (get@ #//project.sources project))
+ _ (..save! system (binary.run tar.writer package)
+ (format artifact-name "." //dependency.lux-library))]
+ (..save! system (|> project //pom.project (:: xml.codec encode) encoding.to-utf8)
+ (format artifact-name //pom.extension))))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index f3bdbe34f..1a4b2f638 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -121,6 +121,10 @@
(<>.default //dependency.lux-library ..type)
)))
+(def: source
+ (Parser /.Source)
+ <c>.text)
+
(def: #export project
(Parser /.Project)
(<| <c>.form
@@ -137,4 +141,7 @@
(<| (<>.default (list))
(..bundle (' #dependencies))
..dependency)
+ (<| (<>.default (list "source"))
+ (..bundle (' #sources))
+ ..source)
))))
diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux
index d19ec5902..102728e1e 100644
--- a/stdlib/source/program/aedifex/pom.lux
+++ b/stdlib/source/program/aedifex/pom.lux
@@ -16,6 +16,9 @@
(def: #export file
"pom.xml")
+(def: #export extension
+ ".pom")
+
(def: version
XML
(#_.Node ["" "modelVersion"] _.attrs
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
index a0891951f..9f98ebc51 100644
--- a/stdlib/source/program/aedifex/project.lux
+++ b/stdlib/source/program/aedifex/project.lux
@@ -1,10 +1,14 @@
(.module:
- [lux (#- Name Info)
+ [lux (#- Name Info Source)
[world
- [net (#+ URL)]]]
+ [net (#+ URL)]
+ [file (#+ Path)]]]
[//
["." dependency]])
+(def: #export file
+ "project.lux")
+
(type: #export Group
Text)
@@ -61,8 +65,12 @@
(type: #export Dependency
[Artifact dependency.Type])
+(type: #export Source
+ Path)
+
(type: #export Project
{#identity Artifact
#info Info
#repositories (List Repository)
- #dependencies (List Dependency)})
+ #dependencies (List Dependency)
+ #sources (List Source)})
diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux
index 03235bbad..4c4384636 100644
--- a/stdlib/source/program/compositor/cli.lux
+++ b/stdlib/source/program/compositor/cli.lux
@@ -12,9 +12,14 @@
[world
[file (#+ Path)]]])
-(type: #export Source Path)
-(type: #export Library Path)
-(type: #export Target Path)
+(type: #export Source
+ Path)
+
+(type: #export Library
+ Path)
+
+(type: #export Target
+ Path)
(type: #export Compilation
[(List Source) (List Library) Target Module])
diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux
index f6a78ed78..468b1ef9d 100644
--- a/stdlib/source/program/compositor/export.lux
+++ b/stdlib/source/program/compositor/export.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- Source)
[abstract
["." monad (#+ do)]]
[control
@@ -27,7 +27,10 @@
[world
["." file]]]
[//
- [cli (#+ Export)]])
+ [cli (#+ Source Export)]])
+
+(def: file
+ "library.tar")
(def: no-ownership
tar.Ownership
@@ -37,26 +40,31 @@
{#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")]
+(def: #export (library system sources)
+ (-> (file.System Promise) (List Source) (Promise (Try tar.Tar)))
+ (do (try.with promise.monad)
+ [files (io.enumerate system sources)]
+ (|> (dictionary.entries files)
+ (monad.map try.monad
+ (function (_ [path source-code])
+ (do try.monad
+ [path (|> path
+ (text.replace-all (:: system separator) .module-separator)
+ tar.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)
+ (:: promise.monad wrap))))
+
+(def: #export (export system [sources target])
+ (-> (file.System Promise) Export (Promise (Try Any)))
+ (let [package (format target (:: system separator) ..file)]
(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 (|> path
- (text.replace-all (:: system separator) .module-separator)
- tar.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))))
+ [tar (..library system sources)
+ package (: (Promise (Try (file.File Promise)))
+ (file.get-file promise.monad system package))]
+ (!.use (:: package over-write) (binary.run tar.writer tar)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 19:07:37 +0000