Test imports for circular dependencies.

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)]))