From a02b7bf8ff358ccfa35b03272d28537aeac723ae Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 28 Nov 2020 19:45:56 -0400 Subject: Added "private" macro to lux/debug. --- stdlib/source/program/aedifex/artifact.lux | 4 +- stdlib/source/program/aedifex/command/auto.lux | 61 ++++++------ stdlib/source/program/aedifex/command/build.lux | 114 ++++++++++++----------- stdlib/source/program/aedifex/command/deploy.lux | 4 +- stdlib/source/program/aedifex/command/pom.lux | 4 +- stdlib/source/program/aedifex/command/test.lux | 36 ++++--- stdlib/source/program/aedifex/format.lux | 14 +-- stdlib/source/program/aedifex/package.lux | 4 +- stdlib/source/program/aedifex/pom.lux | 32 +++---- stdlib/source/program/aedifex/profile.lux | 16 ++-- stdlib/source/program/aedifex/project.lux | 4 +- stdlib/source/program/aedifex/repository.lux | 4 +- 12 files changed, 162 insertions(+), 135 deletions(-) (limited to 'stdlib/source/program/aedifex') diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux index 84e7839f8..3160ef356 100644 --- a/stdlib/source/program/aedifex/artifact.lux +++ b/stdlib/source/program/aedifex/artifact.lux @@ -7,7 +7,7 @@ ["." text ["%" format (#+ Format)]] [collection - ["." list ("#@." monoid)]]] + ["." list ("#\." monoid)]]] [world ["." file (#+ Path)] [net @@ -85,7 +85,7 @@ (def: #export (local artifact) (-> Artifact (List Text)) - (list@compose (|> artifact + (list\compose (|> artifact (get@ #group) (text.split-all-with ..group-separator)) (list (get@ #name artifact) diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index 80ff8ac8c..aa230daba 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -14,7 +14,9 @@ ["." list] ["." set]]] [world - ["." file (#+ Path)]]] + [environment (#+ Environment)] + ["." file (#+ Path)] + ["." shell (#+ Shell)]]] ["." // #_ ["/#" // #_ ["#" profile] @@ -126,31 +128,34 @@ #.None (wrap [])))) -(def: #export (do! command fs resolution profile) +(def: #export (do! command) (All [a] - (-> (-> (file.System Promise) Resolution (Command a)) - (-> (file.System Promise) Resolution (Command Any)))) - (do {! ///action.monad} - [watcher (promise.future - (java/nio/file/FileSystem::newWatchService - (java/nio/file/FileSystems::getDefault))) - targets (|> profile - (get@ #///.sources) - set.to-list - (monad.map ! ..targets) - (:: ! map list.concat)) - _ (monad.map ! (..watch! watcher) targets) - _ (command fs resolution profile)] - (loop [_ []] - (do ! - [?key (..poll! watcher) - _ (case ?key - (#.Some key) - (do ! - [_ (promise.future (..drain! watcher)) - _ (command fs resolution profile)] - (wrap [])) - - #.None - (wrap []))] - (recur []))))) + (-> (-> Environment (file.System Promise) (Shell Promise) Resolution (Command a)) + (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any)))) + (function (_ environment fs shell resolution) + (function (_ profile) + (with-expansions [ ((command environment fs shell resolution) profile)] + (do {! ///action.monad} + [watcher (promise.future + (java/nio/file/FileSystem::newWatchService + (java/nio/file/FileSystems::getDefault))) + targets (|> profile + (get@ #///.sources) + set.to-list + (monad.map ! ..targets) + (:: ! map list.concat)) + _ (monad.map ! (..watch! watcher) targets) + _ ] + (loop [_ []] + (do ! + [?key (..poll! watcher) + _ (case ?key + (#.Some key) + (do ! + [_ (promise.future (..drain! watcher)) + _ ] + (wrap [])) + + #.None + (wrap []))] + (recur [])))))))) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 72f96b25e..94d6760b6 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -1,6 +1,5 @@ (.module: [lux (#- Name) - ["." host (#+ import:)] [abstract [monad (#+ do)]] [control @@ -8,18 +7,24 @@ ["." exception (#+ exception:)] ["." io (#+ IO)] [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise (#+ Promise) ("#\." monad)]] + [security + ["!" capability]]] [data ["." product] ["." maybe] - ["." text ("#@." equivalence) + ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." dictionary] - ["." set]]] + ["." set]] + [number + ["i" int]]] [world - ["." file (#+ Path)]]] + [environment (#+ Environment)] + ["." file (#+ Path)] + ["." shell (#+ Shell)]]] ["." /// #_ ["#" profile] ["#." action] @@ -41,22 +46,30 @@ (-> Group Name Finder) (|>> dictionary.entries (list.one (function (_ [dependency package]) - (if (and (text@= group (get@ [#///dependency.artifact #///artifact.group] dependency)) - (text@= name (get@ [#///dependency.artifact #///artifact.name] dependency))) + (if (and (text\= group (get@ [#///dependency.artifact #///artifact.group] dependency)) + (text\= name (get@ [#///dependency.artifact #///artifact.name] dependency))) (#.Some dependency) #.None))))) -(def: lux-group +(def: #export lux-group Group "com.github.luxlang") -(template [ ] +(def: #export jvm-compiler-name + Name + "lux-jvm") + +(def: #export js-compiler-name + Name + "lux-js") + +(template [ ] [(def: Finder (..dependency-finder ..lux-group ))] - ["lux-jvm" jvm-compiler] - ["lux-js" js-compiler] + [jvm-compiler ..jvm-compiler-name] + [js-compiler ..js-compiler-name] ) (exception: #export no-available-compiler) @@ -91,58 +104,55 @@ (def: (libraries fs) (All [!] (-> (file.System !) Resolution (List Path))) (|>> dictionary.keys - (list.filter (|>> (get@ #///dependency.type) (text@= ///artifact/type.lux-library))) - (list@map (|>> (get@ #///dependency.artifact) (///local.path fs))))) - -(import: java/lang/String) - -## https://docs.oracle.com/javase/tutorial/essential/environment/sysprop.html -(import: java/lang/System - ["#::." - (#static getProperty [java/lang/String] #io #? java/lang/String)]) + (list.filter (|>> (get@ #///dependency.type) (text\= ///artifact/type.lux-library))) + (list\map (|>> (get@ #///dependency.artifact) (///local.path fs))))) (def: #export working-directory - (IO (Try Text)) - (do io.monad - [?value (java/lang/System::getProperty "user.dir")] - (wrap (#try.Success (maybe.default "~" ?value))))) + (-> Environment (Try Text)) + (|>> (dictionary.get "user.dir") try.from-maybe)) -(def: (singular-parameter name value) - (-> Text Text Text) - (format name " " value)) +(def: (singular name) + (-> Text Text (List Text)) + (|>> (list name))) -(def: (plural-parameter name values) - (-> Text (List Text) Text) - (|> values (list@map (|>> (format name " "))) (text.join-with " "))) +(def: (plural name) + (-> Text (List Text) (List Text)) + (|>> (list\map (|>> (list name))) list.concat)) -(def: #export (do! fs resolution profile) - (-> (file.System Promise) Resolution (Command [Compiler Path])) +(def: #export (do! environment fs shell resolution profile) + (-> Environment (file.System Promise) (Shell Promise) Resolution (Command [Compiler Path])) (case [(get@ #///.program profile) (get@ #///.target profile)] [#.None _] - (promise@wrap (exception.throw ..no-specified-program [])) + (promise\wrap (exception.throw ..no-specified-program [])) [_ #.None] - (promise@wrap (exception.throw ..no-specified-target [])) + (promise\wrap (exception.throw ..no-specified-target [])) [(#.Some program) (#.Some target)] (do ///action.monad - [[resolution compiler] (promise@wrap (..compiler resolution)) - working-directory (promise.future ..working-directory) - #let [[prefix output] (case compiler - (#JVM artifact) [(///runtime.java (///local.path fs artifact)) - "program.jar"] - (#JS artifact) [(///runtime.node (///local.path fs artifact)) - "program.js"]) - cache-directory (format working-directory (:: fs separator) target) - command (format prefix " build" - " " (..plural-parameter "--library" (..libraries fs resolution)) - " " (..plural-parameter "--source" (set.to-list (get@ #///.sources profile))) - " " (..singular-parameter "--target" cache-directory) - " " (..singular-parameter "--module" program))] + [[resolution compiler] (promise\wrap (..compiler resolution)) + working-directory (promise\wrap (..working-directory environment)) + #let [[command output] (let [[compiler output] (case compiler + (#JVM artifact) [(///runtime.java (///local.path fs artifact)) + "program.jar"] + (#JS artifact) [(///runtime.node (///local.path fs artifact)) + "program.js"])] + [(format compiler " build") output]) + / (:: fs separator) + cache-directory (format working-directory / target)] #let [_ (log! "[BUILD STARTED]")] - outcome (///shell.execute command working-directory) - #let [_ (log! "[BUILD ENDED]")]] + process (!.use (:: shell execute) + [environment + working-directory + command + (list.concat (list (..plural "--library" (..libraries fs resolution)) + (..plural "--source" (set.to-list (get@ #///.sources profile))) + (..singular "--target" cache-directory) + (..singular "--module" program)))]) + exit (!.use (:: process await) []) + #let [_ (log! (if (i.= shell.normal exit) + "[BUILD ENDED]" + "[BUILD FAILED]"))]] (wrap [compiler - (format cache-directory (:: fs separator) output)])) - )) + (format cache-directory / output)])))) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index 37a5a0f40..839bc7906 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -4,7 +4,7 @@ [monad (#+ do)]] [control [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data [binary (#+ Binary)] [text @@ -40,7 +40,7 @@ set.to-list (export.library fs) (:: ! map (binary.run tar.writer))) - pom (promise@wrap (///pom.write profile)) + pom (promise\wrap (///pom.write profile)) _ (deploy! ///artifact/extension.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) _ (deploy! ///artifact/extension.lux-library library) _ (deploy! ///artifact/extension.sha-1 (///hash.data (///hash.sha-1 library))) diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index f493092a5..695a7839f 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -7,7 +7,7 @@ [security ["!" capability]] [concurrency - ["." promise (#+ Promise) ("#@." monad)]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data ["." text ["%" format (#+ format)] @@ -24,7 +24,7 @@ (def: #export (do! fs profile) (-> (file.System Promise) (Command Path)) (do ///action.monad - [pom (promise@wrap (///pom.write profile)) + [pom (promise\wrap (///pom.write profile)) file (: (Promise (Try (File Promise))) (file.get-file promise.monad fs ///pom.file)) outcome (|> pom diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index d4519b2d0..2996a6741 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -4,12 +4,18 @@ [monad (#+ do)]] [control [concurrency - ["." promise (#+ Promise)]]] + ["." promise (#+ Promise) ("#\." monad)]] + [security + ["!" capability]]] [data [text - ["%" format (#+ format)]]] + ["%" format (#+ format)]] + [number + ["i" int]]] [world - ["." file]]] + [environment (#+ Environment)] + ["." file] + ["." shell (#+ Shell)]]] ["." // #_ ["#." build] ["/#" // #_ @@ -20,15 +26,21 @@ [dependency [resolution (#+ Resolution)]]]]) -(def: #export (do! fs resolution profile) - (-> (file.System Promise) Resolution (Command Any)) +(def: #export (do! environment fs shell resolution profile) + (-> Environment (file.System Promise) (Shell Promise) Resolution (Command Any)) (do ///action.monad - [[compiler program] (//build.do! fs resolution profile) - working-directory (promise.future //build.working-directory) - #let [command (case compiler - (#//build.JVM artifact) (///runtime.java program) - (#//build.JS artifact) (///runtime.node program))] + [[compiler program] (//build.do! environment fs shell resolution profile) + working-directory (promise\wrap (//build.working-directory environment)) #let [_ (log! "[TEST STARTED]")] - outcome (///shell.execute command working-directory) - #let [_ (log! "[TEST ENDED]")]] + process (!.use (:: shell execute) + [environment + working-directory + (case compiler + (#//build.JVM artifact) (///runtime.java program) + (#//build.JS artifact) (///runtime.node program)) + (list)]) + exit (!.use (:: process await) []) + #let [_ (log! (if (i.= shell.normal exit) + "[TEST ENDED]" + "[TEST FAILED]"))]] (wrap []))) diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux index 4ec8b8ae6..b5d6571be 100644 --- a/stdlib/source/program/aedifex/format.lux +++ b/stdlib/source/program/aedifex/format.lux @@ -1,10 +1,10 @@ (.module: [lux #* [data - ["." text ("#@." equivalence)] + ["." text ("#\." equivalence)] [collection ["." dictionary (#+ Dictionary)] - ["." list ("#@." functor)] + ["." list ("#\." functor)] ["." set (#+ Set)]]] [macro ["." code]]] @@ -56,7 +56,7 @@ (def: aggregate (Format Aggregate) (|>> dictionary.entries - (list@map (function (_ [key value]) + (list\map (function (_ [key value]) [(code.local-tag key) value])) code.record)) @@ -82,7 +82,7 @@ aggregate value - (dictionary.put field (` [(~+ (list@map format value))]) aggregate))) + (dictionary.put field (` [(~+ (list\map format value))]) aggregate))) (def: (on-set field value format aggregate) (All [a] @@ -97,7 +97,7 @@ (dictionary.put field (|> value dictionary.entries - (list@map (function (_ [key value]) + (list\map (function (_ [key value]) [(key-format key) (value-format value)])) code.record) aggregate))) @@ -126,7 +126,7 @@ (def: (dependency [artifact type]) (Format Dependency) - (if (text@= //artifact/type.lux-library type) + (if (text\= //artifact/type.lux-library type) (` [(~+ (..artifact' artifact))]) (` [(~+ (..artifact' artifact)) (~ (code.text type))]))) @@ -149,6 +149,6 @@ (def: #export project (Format Project) (|>> dictionary.entries - (list@map (function (_ [key value]) + (list\map (function (_ [key value]) [(code.text key) (..profile value)])) code.record)) diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux index 11d073b51..ae9e98a54 100644 --- a/stdlib/source/program/aedifex/package.lux +++ b/stdlib/source/program/aedifex/package.lux @@ -3,7 +3,7 @@ [abstract ["." equivalence (#+ Equivalence)]] [control - ["." try (#+ Try) ("#@." functor)] + ["." try (#+ Try) ("#\." functor)] [parser ["<.>" xml]]] [data @@ -62,7 +62,7 @@ (-> Package (Try (Set Dependency))) (|>> (get@ #pom) (.run //pom.parser) - (try@map (get@ #/.dependencies)))) + (try\map (get@ #/.dependencies)))) (def: #export equivalence (Equivalence Package) diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index a310b2c48..8a6712930 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -10,11 +10,11 @@ ["" xml (#+ Parser)]]] [data ["." name] - ["." maybe ("#@." functor)] + ["." maybe ("#\." functor)] [format ["_" xml (#+ Tag XML)]] [collection - ["." list ("#@." monoid functor fold)] + ["." list ("#\." monoid functor fold)] ["." set] ["." dictionary]]]] ["." // #_ @@ -75,7 +75,7 @@ (-> Dependency XML) (#_.Node ["" "dependency"] _.attrs - (list@compose (..artifact (get@ #//dependency.artifact value)) + (list\compose (..artifact (get@ #//dependency.artifact value)) (list (..property "type" (get@ #//dependency.type value)))))) (def: (group tag) @@ -104,7 +104,7 @@ (-> /.Developer (List XML)) (list& (..property "name" name) (..property "email" email) - (|> organization (maybe@map ..developer-organization) (maybe.default (list))))) + (|> organization (maybe\map ..developer-organization) (maybe.default (list))))) (template [ ] [(def: @@ -117,14 +117,14 @@ (def: (info value) (-> /.Info (List XML)) - ($_ list@compose - (|> value (get@ #/.url) (maybe@map (..property "url")) maybe.to-list) - (|> value (get@ #/.description) (maybe@map (..property "description")) maybe.to-list) - (|> value (get@ #/.licenses) (list@map ..license) (..group "licenses") list) - (|> value (get@ #/.scm) (maybe@map ..scm) maybe.to-list) - (|> value (get@ #/.organization) (maybe@map ..organization) maybe.to-list) - (|> value (get@ #/.developers) (list@map ..developer) (..group "developers") list) - (|> value (get@ #/.contributors) (list@map ..contributor) (..group "contributors") list) + ($_ list\compose + (|> value (get@ #/.url) (maybe\map (..property "url")) maybe.to-list) + (|> value (get@ #/.description) (maybe\map (..property "description")) maybe.to-list) + (|> value (get@ #/.licenses) (list\map ..license) (..group "licenses") list) + (|> value (get@ #/.scm) (maybe\map ..scm) maybe.to-list) + (|> value (get@ #/.organization) (maybe\map ..organization) maybe.to-list) + (|> value (get@ #/.developers) (list\map ..developer) (..group "developers") list) + (|> value (get@ #/.contributors) (list\map ..contributor) (..group "contributors") list) )) ) @@ -134,11 +134,11 @@ (#.Some identity) (#try.Success (#_.Node ["" ..project-tag] _.attrs - ($_ list@compose + ($_ list\compose (list ..version) (..artifact identity) - (|> value (get@ #/.repositories) set.to-list (list@map ..repository) (..group "repositories") list) - (|> value (get@ #/.dependencies) set.to-list (list@map ..dependency) (..group ..dependencies-tag) list) + (|> value (get@ #/.repositories) set.to-list (list\map ..repository) (..group "repositories") list) + (|> value (get@ #/.dependencies) set.to-list (list\map ..dependency) (..group ..dependencies-tag) list) ))) _ @@ -183,4 +183,4 @@ _ (<>.some .ignore)] (wrap (|> (:: /.monoid identity) (update@ #/.dependencies (function (_ empty) - (list@fold set.add empty dependencies))))))))) + (list\fold set.add empty dependencies))))))))) diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index e165c9e3b..d4e33267d 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -6,11 +6,11 @@ [control ["." exception (#+ exception:)]] [data - ["." maybe ("#@." monoid)] + ["." maybe ("#\." monoid)] ["." text] [collection ["." dictionary (#+ Dictionary)] - ["." list ("#@." monoid)] + ["." list ("#\." monoid)] ["." set (#+ Set)]]] [world [net (#+ URL)] @@ -189,15 +189,15 @@ #deploy-repositories (dictionary.new text.hash)}) (def: (compose override baseline) - {#parents (list@compose (get@ #parents baseline) (get@ #parents override)) - #identity (maybe@compose (get@ #identity override) (get@ #identity baseline)) - #info (maybe@compose (get@ #info override) (get@ #info baseline)) + {#parents (list\compose (get@ #parents baseline) (get@ #parents override)) + #identity (maybe\compose (get@ #identity override) (get@ #identity baseline)) + #info (maybe\compose (get@ #info override) (get@ #info baseline)) #repositories (set.union (get@ #repositories baseline) (get@ #repositories override)) #dependencies (set.union (get@ #dependencies baseline) (get@ #dependencies override)) #sources (set.union (get@ #sources baseline) (get@ #sources override)) - #target (maybe@compose (get@ #target override) (get@ #target baseline)) - #program (maybe@compose (get@ #program override) (get@ #program baseline)) - #test (maybe@compose (get@ #test override) (get@ #test baseline)) + #target (maybe\compose (get@ #target override) (get@ #target baseline)) + #program (maybe\compose (get@ #program override) (get@ #program baseline)) + #test (maybe\compose (get@ #test override) (get@ #test baseline)) #deploy-repositories (dictionary.merge (get@ #deploy-repositories override) (get@ #deploy-repositories baseline))})) (exception: #export no-identity) diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux index b084e0a3d..c2946b482 100644 --- a/stdlib/source/program/aedifex/project.lux +++ b/stdlib/source/program/aedifex/project.lux @@ -13,7 +13,7 @@ [collection ["." dictionary (#+ Dictionary)] ["." set (#+ Set)] - ["." list ("#@." fold)]]]] + ["." list ("#\." fold)]]]] ["." // #_ ["#" profile (#+ Name Profile)]]) @@ -62,7 +62,7 @@ (do {! try.monad} [parents (monad.map ! (profile' (set.add name lineage) project) (get@ #//.parents profile))] - (wrap (list@fold (function (_ parent child) + (wrap (list\fold (function (_ parent child) (:: //.monoid compose child parent)) (set@ #//.parents (list) profile) parents)))) diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index d2ba2c226..e5dc55d2c 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -135,7 +135,7 @@ (new [java/io/InputStream]) (read [[byte] int int] #io #try int)]) -(exception: #export (failure {code Int}) +(exception: #export (deployment-failure {code Int}) (exception.report ["Code" (%.int code)])) @@ -190,5 +190,5 @@ code (java/net/HttpURLConnection::getResponseCode connection)] (case code +200 (wrap []) - _ (:: io.monad wrap (exception.throw ..failure [code]))))) + _ (:: io.monad wrap (exception.throw ..deployment-failure [code]))))) ) -- cgit v1.2.3