diff options
Diffstat (limited to 'stdlib/source/program')
| -rw-r--r-- | stdlib/source/program/aedifex.lux | 107 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/cli.lux | 25 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/auto.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/build.lux | 33 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/deploy.lux | 33 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/local.lux | 33 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/parser.lux | 106 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/pom.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/profile.lux | 135 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/project.lux | 113 |
11 files changed, 417 insertions, 217 deletions
diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index bfa2377f4..e29af6e7a 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -19,7 +19,9 @@ ["%" format (#+ format)] ["." encoding]] [format - ["." xml]]] + ["." xml]] + [collection + ["." set]]] [tool [compiler [language @@ -29,7 +31,8 @@ ["." file (#+ Path)]]] ["." / #_ [action (#+ Action)] - ["#" project] + ["#" profile] + ["#." project (#+ Project)] ["#." parser] ["#." pom] ["#." cli] @@ -61,20 +64,20 @@ (#.Right [end lux-code]) (#try.Success lux-code)))) -(def: (write-pom!' path project) - (-> Path /.Project (IO (Try Any))) +(def: (write-pom!' path profile) + (-> Path /.Profile (IO (Try Any))) (do (try.with io.monad) - [file (!.use (:: file.system file) [path])] - (|> project - /pom.project + [file (!.use (:: file.system file) [path]) + pom (:: io.monad wrap (/pom.project profile))] + (|> pom (:: xml.codec encode) encoding.to-utf8 (!.use (:: file over-write))))) -(def: (write-pom! project) - (-> /.Project (IO Any)) +(def: (write-pom! profile) + (-> /.Profile (IO Any)) (do io.monad - [outcome (write-pom!' /pom.file project)] + [outcome (write-pom!' /pom.file profile)] (case outcome (#try.Success value) (wrap (log! "Successfully wrote POM file!")) @@ -83,10 +86,10 @@ (wrap (log! (format "Could not write POM file:" text.new-line error)))))) -(def: (install! project) - (-> /.Project (Promise Any)) +(def: (install! profile) + (-> /.Profile (Promise Any)) (do promise.monad - [outcome (/local.install (file.async file.system) project)] + [outcome (/local.install (file.async file.system) profile)] (wrap (case outcome (#try.Success _) (log! "Successfully installed locally!") @@ -95,16 +98,16 @@ (log! (format "Could not install locally:" text.new-line error)))))) -(def: (fetch-dependencies! project) - (-> /.Project (Promise Any)) +(def: (fetch-dependencies! profile) + (-> /.Profile (Promise Any)) (do promise.monad [outcome (do (try.with promise.monad) [cache (/local.all-cached (file.async file.system) - (get@ #/.dependencies project) + (set.to-list (get@ #/.dependencies profile)) /dependency.empty) resolution (promise.future - (/dependency.resolve-all (get@ #/.repositories project) - (get@ #/.dependencies project) + (/dependency.resolve-all (set.to-list (get@ #/.repositories profile)) + (set.to-list (get@ #/.dependencies profile)) cache))] (/local.cache-all (file.async file.system) resolution))] @@ -117,52 +120,48 @@ error)))))) (def: project - (-> Binary (Try /.Project)) + (-> Binary (Try Project)) (|>> (do> try.monad [encoding.from-utf8] [..read-code] [(list) (<c>.run /parser.project)]))) -(program: [{command /cli.command}] +(program: [{[profile operation] /cli.command}] (do {@ io.monad} [data (..read-file! /.file)] - (case data - (#try.Success data) - (case (..project data) - (#try.Success project) - (case command - #/cli.POM - (..write-pom! project) - - #/cli.Dependencies - (exec (..fetch-dependencies! project) - (wrap [])) + (case (do try.monad + [data data + project (..project data)] + (/project.profile project profile)) + (#try.Success profile) + (case operation + #/cli.POM + (..write-pom! profile) + + #/cli.Dependencies + (exec (..fetch-dependencies! profile) + (wrap [])) - #/cli.Install - (exec (..install! project) - (wrap [])) + #/cli.Install + (exec (..install! profile) + (wrap [])) - (#/cli.Deploy repository user password) - (exec (/deploy.do! repository user password project) - (wrap [])) + (#/cli.Deploy repository user password) + (exec (/deploy.do! repository user password profile) + (wrap [])) - (#/cli.Compilation compilation) - (case compilation - #/cli.Build (exec (/build.do! project) - (wrap [])) - #/cli.Test (exec (/test.do! project) - (wrap []))) + (#/cli.Compilation compilation) + (case compilation + #/cli.Build (exec (/build.do! profile) + (wrap [])) + #/cli.Test (exec (/test.do! profile) + (wrap []))) - (#/cli.Auto auto) - (exec (case auto - #/cli.Build (/auto.do! /build.do! project) - #/cli.Test (/auto.do! /test.do! project)) - (wrap []))) - - (#try.Failure error) - (wrap (log! (format "Invalid format file:" text.new-line - error)))) + (#/cli.Auto auto) + (exec (case auto + #/cli.Build (/auto.do! /build.do! profile) + #/cli.Test (/auto.do! /test.do! profile)) + (wrap []))) (#try.Failure error) - (wrap (log! (format "Could not read file: " - (%.text /.file))))))) + (wrap (log! error))))) diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux index b0d210c17..dc64dee6e 100644 --- a/stdlib/source/program/aedifex/cli.lux +++ b/stdlib/source/program/aedifex/cli.lux @@ -1,10 +1,11 @@ (.module: - [lux #* + [lux (#- Name) [control ["<>" parser ["." cli (#+ Parser)]]]] [// - [upload (#+ User Password)]]) + [upload (#+ User Password)] + ["/" profile (#+ Name)]]) (type: #export Compilation #Build @@ -15,7 +16,7 @@ (<>.or (cli.this "build") (cli.this "test"))) -(type: #export Command +(type: #export Operation #POM #Dependencies #Install @@ -23,8 +24,11 @@ (#Compilation Compilation) (#Auto Compilation)) -(def: #export command - (Parser Command) +(type: #export Command + [Name Operation]) + +(def: operation + (Parser Operation) ($_ <>.or (cli.this "pom") (cli.this "deps") @@ -38,3 +42,14 @@ (<>.after (cli.this "auto") ..compilation) )) + +(def: #export command + (Parser Command) + ($_ <>.either + (<>.after (cli.this "with") + ($_ <>.and + cli.any + ..operation)) + (:: <>.monad map (|>> [/.default]) + ..operation) + )) diff --git a/stdlib/source/program/aedifex/command.lux b/stdlib/source/program/aedifex/command.lux index 8b4432a97..5248b0273 100644 --- a/stdlib/source/program/aedifex/command.lux +++ b/stdlib/source/program/aedifex/command.lux @@ -1,8 +1,8 @@ (.module: [lux #*] ["." // #_ - ["#" project] + ["#" profile] ["#." action (#+ Action)]]) (type: #export (Command a) - (-> //.Project (Action a))) + (-> //.Profile (Action a))) diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index 5bf759a06..cbb76edbb 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -11,12 +11,13 @@ [data [collection ["." array] - ["." list]]] + ["." list] + ["." set]]] [world [file (#+ Path)]]] ["." // #_ ["/#" // #_ - ["#" project] + ["#" profile] ["#." action (#+ Action)] ["#." command (#+ Command)]]]) @@ -115,17 +116,18 @@ #.None (wrap [])))) -(def: #export (do! command project) +(def: #export (do! command profile) (All [a] (-> (Command a) (Command Any))) (do {@ ///action.monad} [#let [fs (java/nio/file/FileSystems::getDefault)] watcher (promise.future (java/nio/file/FileSystem::newWatchService fs)) - targets (|> project + targets (|> profile (get@ #///.sources) + set.to-list (monad.map @ ..targets) (:: @ map list.concat)) _ (monad.map @ (..watch! watcher) targets) - _ (command project)] + _ (command profile)] (loop [_ []] (do @ [?key (..poll! watcher) @@ -133,7 +135,7 @@ (#.Some key) (do @ [_ (promise.future (..drain! watcher)) - _ (command project)] + _ (command profile)] (wrap [])) #.None diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 0e5d1e229..f505f1d0a 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -16,11 +16,12 @@ ["%" format (#+ format)]] [collection ["." list ("#@." functor)] - ["." dictionary]]] + ["." dictionary] + ["." set]]] [world ["." file (#+ Path)]]] ["." /// #_ - ["#" project] + ["#" profile] ["#." action] ["#." command (#+ Command)] ["#." local] @@ -55,6 +56,7 @@ (exception: #export no-available-compiler) (exception: #export no-specified-program) +(exception: #export no-specified-target) (type: #export Compiler (#JVM Artifact) @@ -107,18 +109,25 @@ (-> Text (List Text) Text) (|> values (list@map (|>> (format name " "))) (text.join-with " "))) -(def: #export (do! project) +(def: #export (do! profile) (Command [Compiler Path]) - (case (get@ #///.program project) - (#.Some program) + (case [(get@ #///.program profile) + (get@ #///.target profile)] + [#.None _] + (promise@wrap (exception.throw ..no-specified-program [])) + + [_ #.None] + (promise@wrap (exception.throw ..no-specified-target [])) + + [(#.Some program) (#.Some target)] (do ///action.monad [cache (///local.all-cached (file.async file.system) - (get@ #///.dependencies project) + (set.to-list (get@ #///.dependencies profile)) ///dependency.empty) resolution (promise.future - (///dependency.resolve-all (get@ #///.repositories project) - (get@ #///.dependencies project) + (///dependency.resolve-all (set.to-list (get@ #///.repositories profile)) + (set.to-list (get@ #///.dependencies profile)) cache)) _ (///local.cache-all (file.async file.system) resolution) @@ -130,10 +139,10 @@ "program.jar"] (#JS artifact) [(format "node --stack_size=8192 " (///local.path file.system artifact)) "program.js"]) - cache-directory (format working-directory (:: file.system separator) (get@ #///.target project)) + cache-directory (format working-directory (:: file.system separator) target) command (format prefix " build" " " (..plural-parameter "--library" libraries) - " " (..plural-parameter "--source" (get@ #///.sources project)) + " " (..plural-parameter "--source" (set.to-list (get@ #///.sources profile))) " " (..singular-parameter "--target" cache-directory) " " (..singular-parameter "--module" program))] #let [_ (log! "[BUILD STARTED]")] @@ -141,6 +150,4 @@ #let [_ (log! "[BUILD ENDED]")]] (wrap [compiler (format cache-directory (:: file.system separator) output)])) - - #.None - (promise@wrap (exception.throw ..no-specified-program [])))) + )) diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index ed6667264..1081322b4 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -12,7 +12,8 @@ ["%" format (#+ format)] ["." encoding]] [collection - ["." dictionary (#+ Dictionary)]] + ["." dictionary (#+ Dictionary)] + ["." set]] [format ["." binary] ["." tar] @@ -23,7 +24,7 @@ [compositor ["." export]]] ["." /// #_ - ["/" project (#+ Project)] + ["/" profile (#+ Profile)] ["//" upload (#+ User Password)] ["#." action (#+ Action)] ["#." command (#+ Command)] @@ -39,29 +40,33 @@ (format (%.text name) " := " (%.text repo))) (dictionary.entries options))])) -(def: #export (do! repository user password project) +(def: #export (do! repository user password profile) (-> Text User Password (Command Any)) - (case (dictionary.get repository (get@ #/.deploy-repositories project)) - (#.Some repository) - (let [artifact (get@ #/.identity project) - deploy! (: (-> ///dependency.Type Binary (Action Any)) + (case [(get@ #/.identity profile) + (dictionary.get repository (get@ #/.deploy-repositories profile))] + [#.None _] + (promise@wrap (exception.throw /.no-identity [])) + + [_ #.None] + (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories profile)])) + + [(#.Some identity) (#.Some repository)] + (let [deploy! (: (-> ///dependency.Type Binary (Action Any)) (function (_ type content) (promise.future (//.upload repository user password - {#///dependency.artifact artifact + {#///dependency.artifact identity #///dependency.type type} content))))] (do {@ ///action.monad} [library (:: @ map (binary.run tar.writer) (export.library (file.async file.system) - (get@ #/.sources project))) - _ (deploy! ///dependency.pom (|> project ///pom.project (:: xml.codec encode) encoding.to-utf8)) + (set.to-list (get@ #/.sources profile)))) + pom (promise@wrap (///pom.project profile)) + _ (deploy! ///dependency.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) _ (deploy! ///dependency.lux-library library) _ (deploy! "sha1" (///hash.sha1 library)) _ (deploy! "md5" (///hash.md5 library))] - (wrap []))) - - #.None - (promise@wrap (exception.throw ..cannot-find-repository [repository (get@ #/.deploy-repositories project)])))) + (wrap []))))) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index 0a429fdc2..1b8a02f1a 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -5,6 +5,7 @@ [control ["." io (#+ IO)] ["." try (#+ Try)] + ["." exception] [concurrency ["." promise (#+ Promise)]] [security @@ -16,7 +17,8 @@ ["." encoding]] [collection ["." list ("#@." monoid)] - ["." dictionary]] + ["." dictionary] + ["." set]] [format ["." binary] ["." tar] @@ -27,7 +29,7 @@ [compositor ["." export]]] ["." // #_ - ["/" project (#+ Project)] + ["/" profile (#+ Profile)] ["#." extension] ["#." pom] ["#." artifact (#+ Artifact)] @@ -67,17 +69,22 @@ (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 (get@ #/.identity project)) - #let [identity (get@ #/.identity project) - artifact-name (format repository (:: system separator) (//artifact.identity identity))] - package (export.library system (get@ #/.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 //extension.pom)))) +(def: #export (install system profile) + (-> (file.System Promise) Profile (Promise (Try Any))) + (case (get@ #/.identity profile) + (#.Some identity) + (do (try.with promise.monad) + [repository (..guarantee-repository! system identity) + #let [artifact-name (format repository (:: system separator) (//artifact.identity identity))] + package (export.library system (set.to-list (get@ #/.sources profile))) + _ (..save! system (binary.run tar.writer package) + (format artifact-name "." //dependency.lux-library)) + pom (:: promise.monad wrap (//pom.project profile))] + (..save! system (|> pom (:: xml.codec encode) encoding.to-utf8) + (format artifact-name //extension.pom))) + + _ + (:: promise.monad wrap (exception.throw /.no-identity [])))) (def: #export (cache system [artifact type] package) (-> (file.System Promise) Dependency Package (Promise (Try Any))) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 17191d5cb..87f41f2c6 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -8,7 +8,8 @@ [data ["." text] [collection - ["." dictionary (#+ Dictionary)]]] + ["." dictionary (#+ Dictionary)] + ["." set (#+ Set)]]] [tool [compiler [meta @@ -16,10 +17,11 @@ [descriptor (#+ Module)]]]]] [world [net (#+ URL)]]] - [// - ["/" project] - ["//." artifact (#+ Artifact)] - ["//." dependency]]) + ["." // #_ + ["/" profile] + ["#." project (#+ Project)] + ["#." artifact (#+ Artifact)] + ["#." dependency]]) (def: (as-input input) (-> (Maybe Code) (List Code)) @@ -115,16 +117,6 @@ (Parser /.Contributor) ..developer) -(def: no-info - /.Info - {#/.url #.None - #/.scm #.None - #/.description #.None - #/.licenses (list) - #/.organization #.None - #/.developers (list) - #/.contributors (list)}) - (def: info (Parser /.Info) (do {@ <>.monad} @@ -162,6 +154,10 @@ (Parser /.Source) <c>.text) +(def: target + (Parser /.Target) + <c>.text) + (def: module (Parser Module) <c>.text) @@ -171,28 +167,70 @@ (<c>.tuple (<>.and <c>.text ..repository))) -(def: #export project - (Parser /.Project) +(def: profile + (Parser /.Profile) (do {@ <>.monad} [input (:: @ map (dictionary.from-list text.hash) (<c>.record (<>.some (<>.and <c>.local-tag - <c>.any))))] + <c>.any)))) + #let [^parents (: (Parser (List /.Name)) + (<>.default (list) + (..plural input "parents" <c>.text))) + ^identity (: (Parser (Maybe Artifact)) + (<>.maybe + (..singular input "identity" ..artifact))) + ^info (: (Parser (Maybe /.Info)) + (<>.maybe + (..singular input "info" ..info))) + ^repositories (: (Parser (Set //dependency.Repository)) + (|> (..plural input "repositories" ..repository) + (:: @ map (set.from-list text.hash)) + (<>.default (set.new text.hash)))) + ^dependencies (: (Parser (Set //dependency.Dependency)) + (|> (..plural input "dependencies" ..dependency) + (:: @ map (set.from-list //dependency.hash)) + (<>.default (set.new //dependency.hash)))) + ^sources (: (Parser (Set /.Source)) + (|> (..plural input "sources" ..source) + (:: @ map (set.from-list text.hash)) + (<>.default (set.from-list text.hash (list /.default-source))))) + ^target (: (Parser (Maybe /.Target)) + (<>.maybe + (..singular input "target" ..target))) + ^program (: (Parser (Maybe Module)) + (<>.maybe + (..singular input "program" ..module))) + ^test (: (Parser (Maybe Module)) + (<>.maybe + (..singular input "test" ..module))) + ^deploy-repositories (: (Parser (Dictionary Text //dependency.Repository)) + (<| (:: @ map (dictionary.from-list text.hash)) + (<>.default (list)) + (..plural input "deploy-repositories" ..deploy-repository)))]] ($_ <>.and - (..singular input "identity" ..artifact) - (<>.default ..no-info - (..singular input "info" ..info)) - (<>.default (list) - (..plural input "repositories" ..repository)) - (<>.default (list) - (..plural input "dependencies" ..dependency)) - (<>.default (list "source") - (..plural input "sources" ..source)) - (<>.default "target" - (..singular input "target" <c>.text)) - (<>.maybe (..singular input "program" ..module)) - (<>.maybe (..singular input "test" ..module)) - (<| (:: @ map (dictionary.from-list text.hash)) - (<>.default (list)) - (..plural input "deploy-repositories" ..deploy-repository)) + ^parents + ^identity + ^info + ^repositories + ^dependencies + ^sources + ^target + ^program + ^test + ^deploy-repositories ))) + +(def: #export project + (Parser Project) + (let [default-profile (: (Parser Project) + (:: <>.monad map + (|>> [/.default] (list) (dictionary.from-list text.hash)) + ..profile)) + multi-profile (: (Parser Project) + (:: <>.monad map + (dictionary.from-list text.hash) + (<c>.record (<>.many (<>.and <c>.text + ..profile)))))] + (<>.either multi-profile + default-profile))) diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index 794ed7e12..9370620f5 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -1,15 +1,18 @@ (.module: [lux #* [control - [pipe (#+ case>)]] + [pipe (#+ case>)] + ["." try (#+ Try)] + ["." exception]] [data ["." maybe ("#@." functor)] [format ["_" xml (#+ XML)]] [collection - ["." list ("#@." monoid functor)]]]] + ["." list ("#@." monoid functor)] + ["." set]]]] ["." // #_ - ["/" project] + ["/" profile] ["#." artifact (#+ Artifact)] ["#." dependency (#+ Repository Dependency)]]) @@ -110,11 +113,17 @@ )) (def: #export (project value) - (-> /.Project XML) - (#_.Node ["" "project"] _.attrs - ($_ list@compose - (list ..version) - (..artifact (get@ #/.identity value)) - (|> value (get@ #/.repositories) (list@map ..repository) (..group "repositories") list) - (|> value (get@ #/.dependencies) (list@map ..dependency) (..group "dependencies") list) - ))) + (-> /.Profile (Try XML)) + (case (get@ #/.identity value) + (#.Some identity) + (#try.Success + (#_.Node ["" "project"] _.attrs + ($_ 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") list) + ))) + + _ + (exception.throw /.no-identity []))) diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux new file mode 100644 index 000000000..5e5cb6175 --- /dev/null +++ b/stdlib/source/program/aedifex/profile.lux @@ -0,0 +1,135 @@ +(.module: + [lux (#- Info Source Module Name) + [abstract + [monoid (#+ Monoid)]] + [control + ["." exception (#+ exception:)]] + [data + ["." maybe ("#@." monoid)] + ["." text] + [collection + ["." dictionary (#+ Dictionary)] + ["." list ("#@." monoid)] + ["." set (#+ Set)]]] + [world + [net (#+ URL)] + [file (#+ Path)]] + [tool + [compiler + [meta + [archive + [descriptor (#+ Module)]]]]]] + [// + [artifact (#+ Artifact)] + ["." dependency]]) + +(def: #export file + "project.lux") + +(type: #export Distribution + #Repo + #Manual) + +(type: #export License + [Text + URL + Distribution]) + +(type: #export SCM + URL) + +(type: #export Organization + [Text + URL]) + +(type: #export Email + Text) + +(type: #export Developer + [Text + Email + (Maybe Organization)]) + +(type: #export Contributor + Developer) + +(type: #export Info + {#url (Maybe URL) + #scm (Maybe SCM) + #description (Maybe Text) + #licenses (List License) + #organization (Maybe Organization) + #developers (List Developer) + #contributors (List Contributor)}) + +(def: #export default-info + Info + {#url #.None + #scm #.None + #description #.None + #licenses (list) + #organization #.None + #developers (list) + #contributors (list)}) + +(type: #export Source + Path) + +(def: #export default-source + Source + "source") + +(type: #export Target + Path) + +(def: #export default-target + Target + "target") + +(type: #export Name + Text) + +(def: #export default + Name + "") + +(type: #export Profile + {#parents (List Name) + #identity (Maybe Artifact) + #info (Maybe Info) + #repositories (Set dependency.Repository) + #dependencies (Set dependency.Dependency) + #sources (Set Source) + #target (Maybe Target) + #program (Maybe Module) + #test (Maybe Module) + #deploy-repositories (Dictionary Text dependency.Repository)}) + +(exception: #export no-identity) + +(structure: #export monoid + (Monoid Profile) + + (def: identity + {#parents (list) + #identity #.None + #info #.None + #repositories (set.new text.hash) + #dependencies (set.new dependency.hash) + #sources (set.new text.hash) + #target #.None + #program #.None + #test #.None + #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)) + #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)) + #deploy-repositories (dictionary.merge (get@ #deploy-repositories override) (get@ #deploy-repositories baseline))})) diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux index 20bbda840..81a8de1af 100644 --- a/stdlib/source/program/aedifex/project.lux +++ b/stdlib/source/program/aedifex/project.lux @@ -1,70 +1,53 @@ (.module: - [lux (#- Info Source Module) + [lux (#- Name) + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] [data - ["." text] + ["." text + ["%" format (#+ format)]] [collection - ["." dictionary (#+ Dictionary)]]] - [world - [net (#+ URL)] - [file (#+ Path)]] - [tool - [compiler - [meta - [archive - [descriptor (#+ Module)]]]]]] - [// - [artifact (#+ Artifact)] - ["." dependency]]) - -(def: #export file - "project.lux") - -(type: #export Distribution - #Repo - #Manual) - -(type: #export License - [Text - URL - Distribution]) - -(type: #export SCM - URL) - -(type: #export Organization - [Text - URL]) - -(type: #export Email - Text) - -(type: #export Developer - [Text - Email - (Maybe Organization)]) - -(type: #export Contributor - Developer) - -(type: #export Info - {#url (Maybe URL) - #scm (Maybe SCM) - #description (Maybe Text) - #licenses (List License) - #organization (Maybe Organization) - #developers (List Developer) - #contributors (List Contributor)}) - -(type: #export Source - Path) + ["." dictionary (#+ Dictionary)] + ["." set (#+ Set)] + ["." list ("#@." fold)]]]] + ["." // #_ + ["#" profile (#+ Name Profile)]]) (type: #export Project - {#identity Artifact - #info Info - #repositories (List dependency.Repository) - #dependencies (List dependency.Dependency) - #sources (List Source) - #target Path - #program (Maybe Module) - #test (Maybe Module) - #deploy-repositories (Dictionary Text dependency.Repository)}) + (Dictionary Name Profile)) + +(exception: #export (unknown-profile {name Name}) + (exception.report + ["Name" (%.text name)])) + +(exception: #export (circular-dependency {dependee Name} {dependent Name}) + (exception.report + ["Dependent" (%.text dependent)] + ["Dependee" (%.text dependee)])) + +(def: (profile' lineage project name) + (-> (Set Name) Project Name (Try Profile)) + (case (dictionary.get name project) + (#.Some profile) + (case (list.find (set.member? lineage) + (get@ #//.parents profile)) + (#.Some ouroboros) + (exception.throw ..circular-dependency [ouroboros name]) + + #.None + (do {@ try.monad} + [parents (monad.map @ (profile' (set.add name lineage) project) + (get@ #//.parents profile))] + (wrap (list@fold (function (_ parent child) + (:: //.monoid compose child parent)) + profile + parents)))) + + #.None + (exception.throw ..unknown-profile [name]))) + +(def: #export (profile project name) + (-> Project Name (Try Profile)) + (profile' (set.new text.hash) project name)) |