diff options
Diffstat (limited to 'stdlib/source/program')
| -rw-r--r-- | stdlib/source/program/aedifex/artifact.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/dependency.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/format.lux | 153 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/parser.lux | 23 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/profile.lux | 89 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/project.lux | 10 |
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)])) |