aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
authorEduardo Julian2020-10-03 20:13:27 -0400
committerEduardo Julian2020-10-03 20:13:27 -0400
commit2d16bdfa2854d851034eff9f042863dcceb8664a (patch)
treea1c593916c6ec9d6e9c132e641fc8b34b85a07f8 /stdlib/source/program
parent618b1ce9743bb79f1ae3375b05a394a4183b21e8 (diff)
Gave Aedifex support for multiple profiles.
Diffstat (limited to '')
-rw-r--r--stdlib/source/program/aedifex.lux107
-rw-r--r--stdlib/source/program/aedifex/cli.lux25
-rw-r--r--stdlib/source/program/aedifex/command.lux4
-rw-r--r--stdlib/source/program/aedifex/command/auto.lux14
-rw-r--r--stdlib/source/program/aedifex/command/build.lux33
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux33
-rw-r--r--stdlib/source/program/aedifex/local.lux33
-rw-r--r--stdlib/source/program/aedifex/parser.lux106
-rw-r--r--stdlib/source/program/aedifex/pom.lux31
-rw-r--r--stdlib/source/program/aedifex/profile.lux135
-rw-r--r--stdlib/source/program/aedifex/project.lux113
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))