WIP: New build-tool named Aedifex (can read project descriptions).

4 files changed, 315 insertions, 0 deletions

diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux
new file mode 100644
index 000000000..fd269f71f
--- /dev/null
+++ b/stdlib/source/program/aedifex.lux
@@ -0,0 +1,93 @@
+(.module:
+  [lux (#- Name)
+   [abstract
+    [monad (#+ do)]]
+   [control
+    [pipe (#+ do>)]
+    ["." try (#+ Try)]
+    ["." io (#+ IO)]
+    [parser
+     ["." cli (#+ program:)]
+     ["<c>" code]]
+    [security
+     ["!" capability]]]
+   [data
+    [binary (#+ Binary)]
+    ["." text
+     ["%" format (#+ format)]
+     ["." encoding]]
+    [format
+     ["." xml]]]
+   [tool
+    [compiler
+     [language
+      [lux
+       ["." syntax]]]]]
+   [world
+    ["." file (#+ Path)]]]
+  ["." / #_
+   ["#" project]
+   ["#." parser]
+   ["#." pom]])
+
+(def: (read-file! path)
+  (-> Path (IO (Try Binary)))
+  (do (try.with io.monad)
+    [project-file (!.use (:: file.system file) [path])]
+    (!.use (:: project-file content) [])))
+
+(def: (write-pom! path project)
+  (-> Path /.Project (IO (Try Any)))
+  (do (try.with io.monad)
+    [file (!.use (:: file.system file) [path])]
+    (|> project
+        /pom.project
+        (:: xml.codec encode)
+        encoding.to-utf8
+        (!.use (:: file over-write)))))
+
+(def: (read-code source-code)
+  (-> Text (Try Code))
+  (let [parse (syntax.parse ""
+                            syntax.no-aliases
+                            (text.size source-code))
+        start (: Source
+                 [["" 0 0] 0 source-code])]
+    (case (parse start)
+      (#.Left [end error])
+      (#try.Failure error)
+      
+      (#.Right [end lux-code])
+      (#try.Success lux-code))))
+
+(def: project
+  (-> Binary (Try /.Project))
+  (|>> (do> try.monad
+            [encoding.from-utf8]
+            [..read-code]
+            [(list) (<c>.run /parser.project)])))
+
+(program: [project-file]
+  (do {@ io.monad}
+    [data (..read-file! project-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.Failure error)
+        (wrap (log! (format "Invalid format file:" text.new-line
+                            error))))
+      
+      (#try.Failure error)
+      (wrap (log! (format "Could not read file: "
+                          (%.text project-file)))))))
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
new file mode 100644
index 000000000..2507ad589
--- /dev/null
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -0,0 +1,14 @@
+(.module:
+  [lux (#- Type)])
+
+(type: #export Type
+  Text)
+
+(template [<type> <name>]
+  [(def: #export <name>
+     Type
+     <type>)]
+
+  ["tar" lux-library]
+  ["jar" jvm-library]
+  )
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
new file mode 100644
index 000000000..f3bdbe34f
--- /dev/null
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -0,0 +1,140 @@
+(.module:
+  [lux (#- type)
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["<>" parser
+     ["<c>" code (#+ Parser)]]]
+   [data
+    ["." text]]
+   [world
+    [net (#+ URL)]]]
+  [//
+   ["/" project]
+   ["//." dependency]])
+
+(def: group
+  (Parser /.Group)
+  <c>.text)
+
+(def: name
+  (Parser /.Name)
+  <c>.text)
+
+(def: version
+  (Parser /.Version)
+  <c>.text)
+
+(def: artifact'
+  (Parser /.Artifact)
+  ($_ <>.and ..group ..name ..version))
+
+(def: artifact
+  (Parser /.Artifact)
+  (<c>.tuple ..artifact'))
+
+(def: url
+  (Parser URL)
+  <c>.text)
+
+(def: scm
+  (Parser /.SCM)
+  ..url)
+
+(def: license
+  (Parser /.License)
+  (<c>.tuple ($_ <>.and
+                 ..name
+                 ..url
+                 (<>.default #/.Repo
+                             (<>.or (<c>.this! (' #repo))
+                                    (<c>.this! (' #manual)))))))
+
+(def: organization
+  (Parser /.Organization)
+  (<| <c>.form
+      (<>.after (<c>.this! (' #organization)))
+      ($_ <>.and
+          ..name
+          ..url)))
+
+(def: developer'
+  (Parser /.Developer)
+  ($_ <>.and
+      ..name
+      ..url
+      (<>.maybe ..organization)
+      ))
+
+(def: developer
+  (Parser /.Developer)
+  (<| <c>.form
+      (<>.after (<c>.this! (' #developer)))
+      ..developer'))
+
+(def: contributor
+  (Parser /.Contributor)
+  (<| <c>.form
+      (<>.after (<c>.this! (' #contributor)))
+      ..developer'))
+
+(def: no-info
+  /.Info
+  {#/.url #.None
+   #/.scm #.None
+   #/.description #.None
+   #/.licenses (list)
+   #/.organization #.None
+   #/.developers (list)
+   #/.contributors (list)})
+
+(def: (bundle tag parser)
+  (All [a] (-> Code (Parser a) (Parser (List a))))
+  (<c>.form (<>.after (<c>.this! tag)
+                      (<>.some parser))))
+
+(def: info
+  (Parser /.Info)
+  ($_ <>.and
+      (<>.maybe ..url)
+      (<>.maybe ..scm)
+      (<>.maybe <c>.text)
+      (<>.default (list) (..bundle (' #licenses) ..license))
+      (<>.maybe ..organization)
+      (<>.default (list) (..bundle (' #developers) ..developer))
+      (<>.default (list) (..bundle (' #contributors) ..contributor))
+      ))
+
+(def: repository
+  (Parser /.Repository)
+  ..url)
+
+(def: type
+  (Parser //dependency.Type)
+  <c>.text)
+
+(def: dependency
+  (Parser /.Dependency)
+  (<c>.tuple
+   ($_ <>.and
+       ..artifact'
+       (<>.default //dependency.lux-library ..type)
+       )))
+
+(def: #export project
+  (Parser /.Project)
+  (<| <c>.form
+      (<>.after (<c>.this! (' project:)))
+      (`` ($_ <>.and
+              ..artifact
+              (<| (<>.default ..no-info)
+                  <c>.form
+                  (<>.after (<c>.this! (' #info)))
+                  ..info)
+              (<| (<>.default (list))
+                  (..bundle (' #repositories))
+                  ..repository)
+              (<| (<>.default (list))
+                  (..bundle (' #dependencies))
+                  ..dependency)
+              ))))
diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux
new file mode 100644
index 000000000..a0891951f
--- /dev/null
+++ b/stdlib/source/program/aedifex/project.lux
@@ -0,0 +1,68 @@
+(.module:
+  [lux (#- Name Info)
+   [world
+    [net (#+ URL)]]]
+  [//
+   ["." dependency]])
+
+(type: #export Group
+  Text)
+
+(type: #export Name
+  Text)
+
+(type: #export Version
+  Text)
+
+(type: #export Artifact
+  {#group Group
+   #name Name
+   #version Version})
+
+(type: #export Distribution
+  #Repo
+  #Manual)
+
+(type: #export License
+  [Name
+   URL
+   Distribution])
+
+(type: #export SCM
+  URL)
+
+(type: #export Organization
+  [Name
+   URL])
+
+(type: #export Email
+  Text)
+
+(type: #export Developer
+  [Name
+   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 Repository
+  URL)
+
+(type: #export Dependency
+  [Artifact dependency.Type])
+
+(type: #export Project
+  {#identity Artifact
+   #info Info
+   #repositories (List Repository)
+   #dependencies (List Dependency)})