aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/program')
-rw-r--r--stdlib/source/program/aedifex/artifact.lux9
-rw-r--r--stdlib/source/program/aedifex/dependency.lux8
-rw-r--r--stdlib/source/program/aedifex/format.lux153
-rw-r--r--stdlib/source/program/aedifex/parser.lux23
-rw-r--r--stdlib/source/program/aedifex/profile.lux89
-rw-r--r--stdlib/source/program/aedifex/project.lux10
6 files changed, 277 insertions, 15 deletions
diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux
index a6865f688..47a9027d0 100644
--- a/stdlib/source/program/aedifex/artifact.lux
+++ b/stdlib/source/program/aedifex/artifact.lux
@@ -1,6 +1,7 @@
(.module:
[lux (#- Name)
[abstract
+ ["." equivalence (#+ Equivalence)]
["." hash (#+ Hash)]]
[data
["." text
@@ -25,6 +26,14 @@
#name Name
#version Version})
+(def: #export equivalence
+ (Equivalence Artifact)
+ ($_ equivalence.product
+ text.equivalence
+ text.equivalence
+ text.equivalence
+ ))
+
(def: #export hash
(Hash Artifact)
($_ hash.product
diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux
index 92ac3e8ac..18b6719ed 100644
--- a/stdlib/source/program/aedifex/dependency.lux
+++ b/stdlib/source/program/aedifex/dependency.lux
@@ -3,6 +3,7 @@
["." host (#+ import:)]
[abstract
[monad (#+ do)]
+ ["." equivalence (#+ Equivalence)]
["." hash (#+ Hash)]]
[control
["." io (#+ IO)]
@@ -43,6 +44,13 @@
{#artifact Artifact
#type ..Type})
+(def: #export equivalence
+ (Equivalence Dependency)
+ ($_ equivalence.product
+ //artifact.equivalence
+ text.equivalence
+ ))
+
(def: #export hash
(Hash Dependency)
($_ hash.product
diff --git a/stdlib/source/program/aedifex/format.lux b/stdlib/source/program/aedifex/format.lux
new file mode 100644
index 000000000..1107f4d13
--- /dev/null
+++ b/stdlib/source/program/aedifex/format.lux
@@ -0,0 +1,153 @@
+(.module:
+ [lux #*
+ [data
+ ["." text ("#@." equivalence)]
+ [collection
+ ["." dictionary (#+ Dictionary)]
+ ["." list ("#@." functor)]
+ ["." set (#+ Set)]]]
+ [macro
+ ["." code]]]
+ ["." // #_
+ ["/" profile]
+ ["#." project (#+ Project)]
+ ["#." artifact (#+ Artifact)]
+ ["#." dependency (#+ Dependency)]])
+
+(type: #export (Format a)
+ (-> a Code))
+
+(def: (license [name url type])
+ (Format /.License)
+ (`' {#name (~ (code.text name))
+ #url (~ (code.text url))
+ #type (~ (case type
+ #/.Repo
+ (' #repo)
+
+ #/.Manual
+ (' #manual)))}))
+
+(def: (organization [name url])
+ (Format /.Organization)
+ (`' {#name (~ (code.text name))
+ #url (~ (code.text url))}))
+
+(def: (developer [name url organization])
+ (Format /.Developer)
+ (case organization
+ #.None
+ (`' {#name (~ (code.text name))
+ #url (~ (code.text url))})
+
+ (#.Some value)
+ (`' {#name (~ (code.text name))
+ #url (~ (code.text url))
+ #organization (~ (..organization value))})))
+
+(def: contributor
+ (Format /.Contributor)
+ ..developer)
+
+(type: Aggregate
+ (Dictionary Text Code))
+
+(def: aggregate
+ (Format Aggregate)
+ (|>> dictionary.entries
+ (list@map (function (_ [key value])
+ [(code.local-tag key) value]))
+ code.record))
+
+(def: empty
+ Aggregate
+ (dictionary.new text.hash))
+
+(def: (on-maybe field value format aggregate)
+ (All [a]
+ (-> Text (Maybe a) (Format a) Aggregate Aggregate))
+ (case value
+ #.None
+ aggregate
+
+ (#.Some value)
+ (dictionary.put field (format value) aggregate)))
+
+(def: (on-list field value format aggregate)
+ (All [a]
+ (-> Text (List a) (Format a) Aggregate Aggregate))
+ (case value
+ #.Nil
+ aggregate
+
+ value
+ (dictionary.put field (` [(~+ (list@map format value))]) aggregate)))
+
+(def: (on-set field value format aggregate)
+ (All [a]
+ (-> Text (Set a) (Format a) Aggregate Aggregate))
+ (..on-list field (set.to-list value) format aggregate))
+
+(def: (on-dictionary field value key-format value-format aggregate)
+ (All [k v]
+ (-> Text (Dictionary k v) (Format k) (Format v) Aggregate Aggregate))
+ (if (dictionary.empty? value)
+ aggregate
+ (dictionary.put field
+ (|> value
+ dictionary.entries
+ (list@map (function (_ [key value])
+ [(key-format key) (value-format value)]))
+ code.record)
+ aggregate)))
+
+(def: (info value)
+ (Format /.Info)
+ (|> ..empty
+ (..on-maybe "url" (get@ #/.url value) code.text)
+ (..on-maybe "scm" (get@ #/.scm value) code.text)
+ (..on-maybe "description" (get@ #/.description value) code.text)
+ (..on-list "licenses" (get@ #/.licenses value) ..license)
+ (..on-maybe "organization" (get@ #/.organization value) ..organization)
+ (..on-list "developers" (get@ #/.developers value) ..developer)
+ (..on-list "contributors" (get@ #/.contributors value) ..contributor)
+ ..aggregate))
+
+(def: (artifact' [group name version])
+ (-> Artifact (List Code))
+ (list (code.text group)
+ (code.text name)
+ (code.text version)))
+
+(def: (artifact value)
+ (Format Artifact)
+ (` [(~+ (..artifact' value))]))
+
+(def: (dependency [artifact type])
+ (Format Dependency)
+ (if (text@= //dependency.lux-library type)
+ (` [(~+ (..artifact' artifact))])
+ (` [(~+ (..artifact' artifact))
+ (~ (code.text type))])))
+
+(def: #export (profile value)
+ (Format /.Profile)
+ (|> ..empty
+ (..on-list "parents" (get@ #/.parents value) code.text)
+ (..on-maybe "identity" (get@ #/.identity value) ..artifact)
+ (..on-maybe "info" (get@ #/.info value) ..info)
+ (..on-set "repositories" (get@ #/.repositories value) code.text)
+ (..on-set "dependencies" (get@ #/.dependencies value) ..dependency)
+ (..on-set "sources" (get@ #/.sources value) code.text)
+ (..on-maybe "target" (get@ #/.target value) code.text)
+ (..on-maybe "program" (get@ #/.program value) code.text)
+ (..on-maybe "test" (get@ #/.test value) code.text)
+ (..on-dictionary "deploy-repositories" (get@ #/.deploy-repositories value) code.text code.text)
+ ..aggregate))
+
+(def: #export project
+ (Format Project)
+ (|>> dictionary.entries
+ (list@map (function (_ [key value])
+ [(code.text key) (..profile value)]))
+ code.record))
diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux
index 87f41f2c6..1799db09e 100644
--- a/stdlib/source/program/aedifex/parser.lux
+++ b/stdlib/source/program/aedifex/parser.lux
@@ -81,13 +81,13 @@
(dictionary.from-list text.hash)
(<c>.record (<>.some (<>.and <c>.local-tag
<c>.any))))]
- (<c>.tuple ($_ <>.and
- (..singular input "name" ..name)
- (..singular input "url" ..url)
- (<>.default #/.Repo
- (..singular input "type"
- (<>.or (<c>.this! (' #repo))
- (<c>.this! (' #manual)))))))))
+ ($_ <>.and
+ (..singular input "name" ..name)
+ (..singular input "url" ..url)
+ (<>.default #/.Repo
+ (..singular input "type"
+ (<>.or (<c>.this! (' #repo))
+ (<c>.this! (' #manual))))))))
(def: organization
(Parser /.Organization)
@@ -163,9 +163,10 @@
<c>.text)
(def: deploy-repository
- (Parser [Text //dependency.Repository])
- (<c>.tuple (<>.and <c>.text
- ..repository)))
+ (Parser (List [Text //dependency.Repository]))
+ (<c>.record (<>.some
+ (<>.and <c>.text
+ ..repository))))
(def: profile
(Parser /.Profile)
@@ -207,7 +208,7 @@
^deploy-repositories (: (Parser (Dictionary Text //dependency.Repository))
(<| (:: @ map (dictionary.from-list text.hash))
(<>.default (list))
- (..plural input "deploy-repositories" ..deploy-repository)))]]
+ (..singular input "deploy-repositories" ..deploy-repository)))]]
($_ <>.and
^parents
^identity
diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux
index 5e5cb6175..02ae69ac8 100644
--- a/stdlib/source/program/aedifex/profile.lux
+++ b/stdlib/source/program/aedifex/profile.lux
@@ -1,7 +1,8 @@
(.module:
[lux (#- Info Source Module Name)
[abstract
- [monoid (#+ Monoid)]]
+ [monoid (#+ Monoid)]
+ ["." equivalence (#+ Equivalence)]]
[control
["." exception (#+ exception:)]]
[data
@@ -20,7 +21,7 @@
[archive
[descriptor (#+ Module)]]]]]]
[//
- [artifact (#+ Artifact)]
+ ["." artifact (#+ Artifact)]
["." dependency]])
(def: #export file
@@ -30,11 +31,32 @@
#Repo
#Manual)
+(structure: distribution-equivalence
+ (Equivalence Distribution)
+
+ (def: (= reference subject)
+ (case [reference subject]
+ (^template [<tag>]
+ [<tag> <tag>]
+ true)
+ ([#Repo]
+ [#Manual])
+
+ _
+ false)))
+
(type: #export License
[Text
URL
Distribution])
+(def: license-equivalence
+ (Equivalence License)
+ ($_ equivalence.product
+ text.equivalence
+ text.equivalence
+ ..distribution-equivalence))
+
(type: #export SCM
URL)
@@ -42,6 +64,12 @@
[Text
URL])
+(def: organization-equivalence
+ (Equivalence Organization)
+ ($_ equivalence.product
+ text.equivalence
+ text.equivalence))
+
(type: #export Email
Text)
@@ -50,6 +78,13 @@
Email
(Maybe Organization)])
+(def: developer-equivalence
+ (Equivalence Developer)
+ ($_ equivalence.product
+ text.equivalence
+ text.equivalence
+ (maybe.equivalence ..organization-equivalence)))
+
(type: #export Contributor
Developer)
@@ -62,6 +97,17 @@
#developers (List Developer)
#contributors (List Contributor)})
+(def: info-equivalence
+ (Equivalence Info)
+ ($_ equivalence.product
+ (maybe.equivalence text.equivalence)
+ (maybe.equivalence text.equivalence)
+ (maybe.equivalence text.equivalence)
+ (list.equivalence ..license-equivalence)
+ (maybe.equivalence ..organization-equivalence)
+ (list.equivalence ..developer-equivalence)
+ (list.equivalence ..developer-equivalence)))
+
(def: #export default-info
Info
{#url #.None
@@ -105,7 +151,42 @@
#test (Maybe Module)
#deploy-repositories (Dictionary Text dependency.Repository)})
-(exception: #export no-identity)
+(def: #export empty
+ Profile
+ {#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: #export equivalence
+ (Equivalence Profile)
+ ($_ equivalence.product
+ ## #parents
+ (list.equivalence text.equivalence)
+ ## #identity
+ (maybe.equivalence artifact.equivalence)
+ ## #info
+ (maybe.equivalence ..info-equivalence)
+ ## #repositories
+ set.equivalence
+ ## #dependencies
+ set.equivalence
+ ## #sources
+ set.equivalence
+ ## #target
+ (maybe.equivalence text.equivalence)
+ ## #program
+ (maybe.equivalence text.equivalence)
+ ## #test
+ (maybe.equivalence text.equivalence)
+ ## #deploy-repositories
+ (dictionary.equivalence text.equivalence)))
(structure: #export monoid
(Monoid Profile)
@@ -133,3 +214,5 @@
#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 81a8de1af..2e205f722 100644
--- a/stdlib/source/program/aedifex/project.lux
+++ b/stdlib/source/program/aedifex/project.lux
@@ -1,7 +1,8 @@
(.module:
[lux (#- Name)
[abstract
- ["." monad (#+ do)]]
+ ["." monad (#+ do)]
+ ["." equivalence (#+ Equivalence)]]
[control
["." try (#+ Try)]
["." exception (#+ exception:)]]
@@ -18,6 +19,13 @@
(type: #export Project
(Dictionary Name Profile))
+(def: #export empty
+ (dictionary.from-list text.hash (list [//.default //.empty])))
+
+(def: #export equivalence
+ (Equivalence Project)
+ (dictionary.equivalence //.equivalence))
+
(exception: #export (unknown-profile {name Name})
(exception.report
["Name" (%.text name)]))