From a5a15c191c43a660bb0c8e78e93d097e27966177 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 28 Aug 2020 00:06:26 -0400 Subject: Build programs. --- stdlib/source/program/aedifex/action.lux | 15 ++++ stdlib/source/program/aedifex/build.lux | 144 ++++++++++++++++++++++++++++++ stdlib/source/program/aedifex/cli.lux | 4 +- stdlib/source/program/aedifex/local.lux | 6 ++ stdlib/source/program/aedifex/parser.lux | 26 +++--- stdlib/source/program/aedifex/project.lux | 14 ++- stdlib/source/program/aedifex/shell.lux | 104 +++++++++++++++++++++ 7 files changed, 299 insertions(+), 14 deletions(-) create mode 100644 stdlib/source/program/aedifex/action.lux create mode 100644 stdlib/source/program/aedifex/build.lux create mode 100644 stdlib/source/program/aedifex/shell.lux (limited to 'stdlib/source/program/aedifex') diff --git a/stdlib/source/program/aedifex/action.lux b/stdlib/source/program/aedifex/action.lux new file mode 100644 index 000000000..e8a88facd --- /dev/null +++ b/stdlib/source/program/aedifex/action.lux @@ -0,0 +1,15 @@ +(.module: + [lux #* + [abstract + [monad (#+ Monad)]] + [control + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]]]]) + +(type: #export (Action a) + (Promise (Try a))) + +(def: #export monad + (Monad Action) + (:assume (try.with promise.monad))) diff --git a/stdlib/source/program/aedifex/build.lux b/stdlib/source/program/aedifex/build.lux new file mode 100644 index 000000000..74f64cb59 --- /dev/null +++ b/stdlib/source/program/aedifex/build.lux @@ -0,0 +1,144 @@ +(.module: + [lux (#- Name) + ["." host (#+ import:)] + [abstract + [monad (#+ Monad do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO)] + [concurrency + ["." promise (#+ Promise) ("#@." monad)]]] + [data + ["." product] + ["." maybe] + ["." text ("#@." equivalence) + ["%" format (#+ format)]] + [collection + ["." list ("#@." functor)] + ["." dictionary]]] + [world + ["." file (#+ Path)]]] + ["." // #_ + ["#" project] + ["#." action (#+ Action)] + ["#." local] + ["#." artifact (#+ Group Name Artifact)] + ["#." dependency (#+ Dependency Resolution)] + ["#." shell]]) + +(type: #export (Command a) + (-> //.Project (Action a))) + +(type: Finder + (-> Resolution (Maybe Dependency))) + +(def: (dependency-finder group name) + (-> Group Name Finder) + (|>> dictionary.entries + (list.search (function (_ [dependency package]) + (if (and (text@= group (get@ [#//dependency.artifact #//artifact.group] dependency)) + (text@= name (get@ [#//dependency.artifact #//artifact.name] dependency))) + (#.Some dependency) + #.None))))) + +(def: lux-group + Group + "com.github.luxlang") + +(template [ ] + [(def: + Finder + (..dependency-finder ..lux-group ))] + + ["lux-jvm" jvm-compiler] + ["lux-js" js-compiler] + ) + +(exception: #export no-available-compiler) +(exception: #export no-specified-program) + +(type: Compiler + (#JVM Artifact) + (#JS Artifact)) + +(def: (remove-dependency dependency) + (-> Dependency (-> Resolution Resolution)) + (|>> dictionary.entries + (list.filter (|>> product.left (is? dependency) not)) + (dictionary.from-list //dependency.hash))) + +(def: (compiler resolution) + (-> Resolution (Try [Resolution Compiler])) + (case [(..jvm-compiler resolution) + (..js-compiler resolution)] + [(#.Some dependency) _] + (#try.Success [(..remove-dependency dependency resolution) + (#JVM (get@ #//dependency.artifact dependency))]) + + [_ (#.Some dependency)] + (#try.Success [(..remove-dependency dependency resolution) + (#JS (get@ #//dependency.artifact dependency))]) + + _ + (exception.throw ..no-available-compiler []))) + +(def: libraries + (-> Resolution (List Path)) + (|>> dictionary.keys + (list.filter (|>> (get@ #//dependency.type) (text@= //dependency.lux-library))) + (list@map (|>> (get@ #//dependency.artifact) (//local.path file.system))))) + +(import: #long java/lang/String) + +## https://docs.oracle.com/javase/tutorial/essential/environment/sysprop.html +(import: #long java/lang/System + (#static getProperty [java/lang/String] #io #? java/lang/String)) + +(def: working-directory + (IO (Try Text)) + (do io.monad + [?value (java/lang/System::getProperty "user.dir")] + (wrap (#try.Success (maybe.default "~" ?value))))) + +(def: (singular-parameter name value) + (-> Text Text Text) + (format name " " value)) + +(def: (plural-parameter name values) + (-> Text (List Text) Text) + (|> values (list@map (|>> (format name " "))) (text.join-with " "))) + +(def: #export (do! project) + (Command Any) + (case (get@ #//.program project) + (#.Some program) + (do //action.monad + [cache (//local.all-cached (file.async file.system) + (get@ #//.dependencies project) + //dependency.empty) + resolution (promise.future + (//dependency.resolve-all (get@ #//.repositories project) + (get@ #//.dependencies project) + cache)) + _ (//local.cache-all (file.async file.system) + resolution) + [resolution compiler] (promise@wrap (..compiler resolution)) + working-directory (promise.future ..working-directory) + #let [libraries (..libraries resolution) + prefix (case compiler + (#JVM artifact) (format "java -jar " (//local.path file.system artifact)) + (#JS artifact) (format "node --stack_size=8192 " (//local.path file.system artifact))) + cache-directory (format working-directory (:: file.system separator) (get@ #//.target project)) + command (format prefix " build" + " " (..plural-parameter "--library" libraries) + " " (..plural-parameter "--source" (get@ #//.sources project)) + " " (..singular-parameter "--target" cache-directory) + " " (..singular-parameter "--module" program))] + #let [_ (log! "[BUILD STARTED]")] + outcome (//shell.execute command working-directory) + #let [_ (log! "[BUILD END]")]] + (wrap [])) + + #.None + (promise@wrap (exception.throw ..no-specified-program [])))) diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux index 4ff56ac53..3b5a33fb1 100644 --- a/stdlib/source/program/aedifex/cli.lux +++ b/stdlib/source/program/aedifex/cli.lux @@ -7,7 +7,8 @@ (type: #export Command #POM #Install - #Dependencies) + #Dependencies + #Buikd) (def: #export command (Parser Command) @@ -15,4 +16,5 @@ (cli.this "pom") (cli.this "install") (cli.this "deps") + (cli.this "buikd") )) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index 8761b573a..0a429fdc2 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -160,3 +160,9 @@ (#try.Failure error) ))))) + +(def: #export (path system artifact) + (All [a] (-> (file.System a) Artifact Path)) + (format (..repository system) + (:: system separator) + (//artifact.identity artifact))) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 78f6dbb60..508550a2a 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -89,7 +89,11 @@ #/.developers (list) #/.contributors (list)}) -(def: (bundle tag parser) +(def: (singular tag parser) + (All [a] (-> Code (Parser a) (Parser a))) + (.form (<>.after (.this! tag) parser))) + +(def: (plural tag parser) (All [a] (-> Code (Parser a) (Parser (List a)))) (.form (<>.after (.this! tag) (<>.some parser)))) @@ -100,10 +104,10 @@ (<>.maybe ..url) (<>.maybe ..scm) (<>.maybe .text) - (<>.default (list) (..bundle (' #licenses) ..license)) + (<>.default (list) (..plural (' #licenses) ..license)) (<>.maybe ..organization) - (<>.default (list) (..bundle (' #developers) ..developer)) - (<>.default (list) (..bundle (' #contributors) ..contributor)) + (<>.default (list) (..plural (' #developers) ..developer)) + (<>.default (list) (..plural (' #contributors) ..contributor)) )) (def: repository @@ -133,16 +137,18 @@ (`` ($_ <>.and ..artifact (<| (<>.default ..no-info) - .form - (<>.after (.this! (' #info))) - ..info) + (..singular (' #info) ..info)) (<| (<>.default (list)) - (..bundle (' #repositories)) + (..plural (' #repositories)) ..repository) (<| (<>.default (list)) - (..bundle (' #dependencies)) + (..plural (' #dependencies)) ..dependency) (<| (<>.default (list "source")) - (..bundle (' #sources)) + (..plural (' #sources)) ..source) + (<| (<>.default "target") + (..singular (' #target) .text)) + (<>.maybe (..singular (' #program) .text)) + (<>.maybe (..singular (' #test) .text)) )))) diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux index 385ef8919..ebd689760 100644 --- a/stdlib/source/program/aedifex/project.lux +++ b/stdlib/source/program/aedifex/project.lux @@ -1,10 +1,15 @@ (.module: - [lux (#- Info Source) + [lux (#- Info Source Module) [data ["." text]] [world [net (#+ URL)] - [file (#+ Path)]]] + [file (#+ Path)]] + [tool + [compiler + [meta + [archive + [descriptor (#+ Module)]]]]]] [// [artifact (#+ Artifact)] ["." dependency]]) @@ -56,4 +61,7 @@ #info Info #repositories (List dependency.Repository) #dependencies (List dependency.Dependency) - #sources (List Source)}) + #sources (List Source) + #target Path + #program (Maybe Module) + #test (Maybe Module)}) diff --git a/stdlib/source/program/aedifex/shell.lux b/stdlib/source/program/aedifex/shell.lux new file mode 100644 index 000000000..373f9b739 --- /dev/null +++ b/stdlib/source/program/aedifex/shell.lux @@ -0,0 +1,104 @@ +(.module: + [lux #* + ["." host (#+ import:)] + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)] + ["." try (#+ Try)] + ["." exception (#+ exception:)] + [concurrency + ["." promise]]] + [data + [text + ["%" format (#+ format)]] + [number + ["." int]]] + [world + [file (#+ Path)]]] + ["." // #_ + ["#." action (#+ Action)]]) + +(import: #long java/lang/String) + +(import: #long java/io/InputStream) + +(import: #long java/io/Reader) + +(import: #long java/io/InputStreamReader + (new [java/io/InputStream])) + +(import: #long java/io/BufferedReader + (new [java/io/Reader]) + (readLine [] #io #try java/lang/String)) + +(import: #long java/lang/Process + (getInputStream [] java/io/InputStream) + (getErrorStream [] java/io/InputStream) + (waitFor [] #io #try int)) + +(import: #long java/io/File + (new [java/lang/String])) + +(import: #long java/lang/Runtime + (#static getRuntime [] #io java/lang/Runtime) + (exec [java/lang/String #? [java/lang/String] java/io/File] #io #try java/lang/Process)) + +(exception: #export (failure-to-execute-command {working-directory Text} {command Text} {error Text}) + (exception.report + ["Working Directory" (%.text working-directory)] + ["Command" (%.text command)] + ["Error" (%.text error)])) + +(exception: #export (failure-during-command-execution {working-directory Text} {command Text} {error Text}) + (exception.report + ["Working Directory" (%.text working-directory)] + ["Command" (%.text command)] + ["Error" (%.text error)])) + +(exception: #export (abnormal-exit {working-directory Text} {command Text} {code Int}) + (exception.report + ["Working Directory" (%.text working-directory)] + ["Command" (%.text command)] + ["Code" (%.int code)])) + +(def: (consume-stream working-directory command stream) + (-> Text Path java/io/InputStream (IO (Try Any))) + (let [reader (|> stream java/io/InputStreamReader::new java/io/BufferedReader::new)] + (loop [_ []] + (do io.monad + [?line (java/io/BufferedReader::readLine reader)] + (case ?line + (#try.Success line) + (exec (log! line) + (recur [])) + + (#try.Failure error) + (wrap (exception.throw ..failure-during-command-execution [working-directory command error]))))))) + +(def: normal-exit + +0) + +(def: #export (execute command working-directory) + (-> Text Path (Action Any)) + (promise.future + (do {@ io.monad} + [runtime (java/lang/Runtime::getRuntime) + ?process (java/lang/Runtime::exec command #.None (java/io/File::new working-directory) runtime)] + (case ?process + (#try.Success process) + (do @ + [_ (..consume-stream working-directory command (java/lang/Process::getInputStream process)) + _ (..consume-stream working-directory command (java/lang/Process::getErrorStream process)) + ?exit-code (java/lang/Process::waitFor process)] + (case ?exit-code + (#try.Success exit-code) + (if (int.= ..normal-exit exit-code) + (wrap (#try.Success [])) + (wrap (exception.throw ..abnormal-exit [working-directory command exit-code]))) + + (#try.Failure error) + (wrap (exception.throw ..failure-to-execute-command [working-directory command error])))) + + (#try.Failure error) + (wrap (exception.throw ..failure-to-execute-command [working-directory command error])))))) -- cgit v1.2.3