From ce7614f00a134cb61b4a6f88cfea33461a7bf478 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 7 Oct 2020 17:00:57 -0400 Subject: Test imports for circular dependencies. --- stdlib/source/program/aedifex/artifact.lux | 9 ++ stdlib/source/program/aedifex/dependency.lux | 8 ++ stdlib/source/program/aedifex/format.lux | 153 +++++++++++++++++++++++++++ stdlib/source/program/aedifex/parser.lux | 23 ++-- stdlib/source/program/aedifex/profile.lux | 89 +++++++++++++++- stdlib/source/program/aedifex/project.lux | 10 +- 6 files changed, 277 insertions(+), 15 deletions(-) create mode 100644 stdlib/source/program/aedifex/format.lux (limited to 'stdlib/source/program') 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) (.record (<>.some (<>.and .local-tag .any))))] - (.tuple ($_ <>.and - (..singular input "name" ..name) - (..singular input "url" ..url) - (<>.default #/.Repo - (..singular input "type" - (<>.or (.this! (' #repo)) - (.this! (' #manual))))))))) + ($_ <>.and + (..singular input "name" ..name) + (..singular input "url" ..url) + (<>.default #/.Repo + (..singular input "type" + (<>.or (.this! (' #repo)) + (.this! (' #manual)))))))) (def: organization (Parser /.Organization) @@ -163,9 +163,10 @@ .text) (def: deploy-repository - (Parser [Text //dependency.Repository]) - (.tuple (<>.and .text - ..repository))) + (Parser (List [Text //dependency.Repository])) + (.record (<>.some + (<>.and .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 [] + [ ] + 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)])) -- cgit v1.2.3