Extracted Licentia out of the standard library.

10 files changed, 216 insertions, 435 deletions

diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index 3833c0828..ae9bde67c 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -1,66 +1,49 @@
 (.module:
   [lux #*
+   [program (#+ program:)]
    ["_" test (#+ Test)]
    [control
-    [io (#+ io)]
-    [parser
-     [cli (#+ program:)]]]]
+    [io (#+ io)]]]
   ["." / #_
    ["#." artifact]
-   ["#." input]
-   ["#." command #_
-    ["#/." version]
-    ["#/." clean]
-    ["#/." pom]
-    ["#/." install]
-    ["#/." deploy]
-    ["#/." deps]
-    ["#/." build]
-    ["#/." test]
-    ["#/." auto]]
-   ["#." local]
-   ["#." dependency
-    ["#/." resolution]
-    ["#/." status]]
-   ["#." package]
-   ["#." profile]
-   ["#." project]
    ["#." cli]
-   ["#." hash]
-   ["#." parser]
-   ["#." pom]
-   ["#." repository]
-   ["#." runtime]
-   ["#." metadata]])
+   ["#." command]
+   ## ["#." input]
+   ## ["#." local]
+   ## ["#." dependency
+   ##  ## ["#/." resolution]
+   ##  ["#/." status]]
+   ## ["#." package]
+   ## ["#." profile]
+   ## ["#." project]
+   ## ["#." hash]
+   ## ["#." parser]
+   ## ["#." pom]
+   ## ["#." repository]
+   ## ["#." runtime]
+   ## ["#." metadata]
+   ])
 
 (def: test
   Test
   ($_ _.and
       /artifact.test
-      /input.test
-      /command/version.test
-      /command/clean.test
-      /command/pom.test
-      /command/install.test
-      /command/deploy.test
-      /command/deps.test
-      /command/build.test
-      /command/test.test
-      /command/auto.test
-      /local.test
-      /dependency.test
-      /dependency/resolution.test
-      /dependency/status.test
-      /package.test
-      /profile.test
-      /project.test
       /cli.test
-      /hash.test
-      /parser.test
-      /pom.test
-      /repository.test
-      /runtime.test
-      /metadata.test
+      /command.test
+      ## /input.test
+      ## /local.test
+      ## /dependency.test
+      ## ## /dependency/resolution.test
+      ## /dependency/status.test
+      ## /package.test
+      ## /profile.test
+      ## /project.test
+      ## /hash.test
+      ## /parser.test
+      ## /pom.test
+      ## /repository.test
+      ## /runtime.test
+      ## /metadata.test
       ))
 
 (program: args
diff --git a/stdlib/source/test/aedifex/command.lux b/stdlib/source/test/aedifex/command.lux
new file mode 100644
index 000000000..0ef18f044
--- /dev/null
+++ b/stdlib/source/test/aedifex/command.lux
@@ -0,0 +1,32 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]]
+  ["." / #_
+   ["#." clean]
+   ["#." install]
+   ["#." pom]
+   ["#." version]]
+  {#program
+   ["." /
+    ## ["#." deploy]
+    ## ["#." deps]
+    ## ["#." build]
+    ## ["#." test]
+    ## ["#." auto]
+    ]})
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.for [/.Command])
+      ($_ _.and
+          /clean.test
+          /install.test
+          /pom.test
+          /version.test
+          ## /deploy.test
+          ## /deps.test
+          ## /build.test
+          ## /test.test
+          ## /auto.test
+          )))
diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux
index ce3f21de8..33ee7192d 100644
--- a/stdlib/source/test/aedifex/command/install.lux
+++ b/stdlib/source/test/aedifex/command/install.lux
@@ -16,8 +16,7 @@
     ["." maybe]
     ["." binary]
     ["." text ("#\." equivalence)
-     ["%" format (#+ format)]
-     ["." encoding]]
+     ["%" format (#+ format)]]
     [format
      ["." xml]]
     [collection
@@ -67,13 +66,11 @@
 
 (def: (execute! program fs sample)
   (-> (Program Promise) (file.System Promise) ///.Profile (Promise (Try Text)))
-  (do promise.monad
-    [home (\ program home [])]
-    (do ///action.monad
-      [#let [console (@version.echo "")]
-       _ (..make_sources! fs (get@ #///.sources sample))
-       _ (/.do! console fs (///repository/local.repository program fs) sample)]
-      (!.use (\ console read_line) []))))
+  (do ///action.monad
+    [#let [console (@version.echo "")]
+     _ (..make_sources! fs (get@ #///.sources sample))
+     _ (/.do! console fs (///repository/local.repository program fs) sample)]
+    (!.use (\ console read_line) [])))
 
 (def: #export test
   Test
@@ -91,17 +88,18 @@
                      verdict (do ///action.monad
                                [logging (..execute! program fs sample)
                                 #let [/ uri.separator
-                                      artifact_path (format (///local.uri identity) / (///artifact.identity identity))
+                                      artifact_path (///local.uri (get@ #///artifact.version identity) identity)
                                       library_path (format artifact_path ///artifact/extension.lux_library)
                                       pom_path (format artifact_path ///artifact/extension.pom)]
 
+                                #let [succeeded! (text\= //clean.success logging)]
                                 library_exists! (\ promise.monad map
                                                    exception.return
                                                    (file.file_exists? promise.monad fs library_path))
                                 pom_exists! (\ promise.monad map
                                                exception.return
                                                (file.file_exists? promise.monad fs pom_path))]
-                               (wrap (and (text\= //clean.success logging)
+                               (wrap (and succeeded!
                                           library_exists!
                                           pom_exists!)))]
                     (_.cover' [/.do!]
diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux
index 33c102926..c368d5f84 100644
--- a/stdlib/source/test/aedifex/command/pom.lux
+++ b/stdlib/source/test/aedifex/command/pom.lux
@@ -12,7 +12,8 @@
    [data
     ["." binary]
     ["." text ("#\." equivalence)
-     ["." encoding]]
+     [encoding
+      ["." utf8]]]
     [format
      ["." xml]]]
    [math
@@ -46,7 +47,7 @@
                   (do !
                     [verdict (do ///action.monad
                                [expected (|> (///pom.write sample)
-                                             (try\map (|>> (\ xml.codec encode) (\ encoding.utf8 encode)))
+                                             (try\map (|>> (\ xml.codec encode) (\ utf8.codec encode)))
                                              (\ ! wrap))
                                 file (: (Promise (Try (File Promise)))
                                         (file.get_file promise.monad fs path))
diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux
index ee26b3b5d..c7a9aa4ef 100644
--- a/stdlib/source/test/aedifex/command/version.lux
+++ b/stdlib/source/test/aedifex/command/version.lux
@@ -60,7 +60,9 @@
 
 (def: #export echo
   (-> Text (Console Promise))
-  (|>> [true] (console.mock ..simulation)))
+  (|>> [true]
+       (console.mock ..simulation)
+       console.async))
 
 (def: #export test
   Test
diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux
deleted file mode 100644
index af03062cb..000000000
--- a/stdlib/source/test/licentia.lux
+++ /dev/null
@@ -1,369 +0,0 @@
-(.module:
-  [lux #*
-   ["_" test (#+ Test)]
-   [abstract
-    [monad (#+ do)]]
-   [control
-    [io (#+ io)]
-    [parser
-     [cli (#+ program:)]]]
-   [data
-    ["." bit ("#\." equivalence)]
-    ["." maybe ("#\." functor)]
-    ["." text]
-    [number
-     ["n" nat ("#\." interval)]]
-    [collection
-     ["." list ("#\." functor)]]]
-   [math
-    ["." random (#+ Random)]]]
-  {#program
-   [/
-    ["." license (#+ Identification
-                     Termination
-                     Liability
-                     Distribution
-                     Commercial
-                     Extension
-                     Entity Black-List
-                     URL Attribution
-                     Addendum
-                     License)
-     ["." time (#+ Period)]
-     ["." copyright]
-     ["." notice]
-     ["." definition]
-     ["." grant]
-     ["." limitation]
-     ["." submission]
-     ["." liability]
-     ["." distribution]
-     ["." commercial]
-     ["." extension]
-     ["." miscellaneous]
-     ["." black-list]
-     ["." addendum]]
-    ["." output]]})
-
-(def: period
-  (Random (Period Nat))
-  (do {! random.monad}
-    [start (random.filter (|>> (n.= n\top) not)
-                          random.nat)
-     #let [wiggle-room (n.- start n\top)]
-     end (\ ! map
-            (|>> (n.% wiggle-room) (n.max 1))
-            random.nat)]
-    (wrap {#time.start start
-           #time.end end})))
-
-(def: copyright-holder
-  (Random copyright.Holder)
-  ($_ random.and
-      (random.ascii 10)
-      ..period))
-
-(def: identification
-  (Random Identification)
-  ($_ random.and
-      (random.ascii 10)
-      (random.ascii 10)))
-
-(def: termination
-  (Random Termination)
-  ($_ random.and
-      random.bit
-      random.nat
-      random.nat))
-
-(def: liability
-  (Random Liability)
-  ($_ random.and
-      random.bit
-      random.bit))
-
-(def: distribution
-  (Random Distribution)
-  ($_ random.and
-      random.bit
-      random.bit))
-
-(def: commercial
-  (Random Commercial)
-  ($_ random.and
-      random.bit
-      random.bit
-      random.bit))
-
-(def: extension
-  (Random Extension)
-  ($_ random.and
-      random.bit
-      random.bit
-      (random.maybe ..period)
-      random.bit))
-
-(def: entity
-  (Random Entity)
-  (random.ascii 10))
-
-(def: (variable-list max-size gen-element)
-  (All [a] (-> Nat (Random a) (Random (List a))))
-  (do {! random.monad}
-    [amount (\ ! map (n.% (n.max 1 max-size))
-               random.nat)]
-    (random.list amount gen-element)))
-
-(def: black-list
-  (Random Black-List)
-  ($_ random.and
-      (random.maybe (random.ascii 10))
-      (variable-list 10 ..entity)))
-
-(def: url
-  (Random URL)
-  (random.ascii 10))
-
-(def: attribution
-  (Random Attribution)
-  ($_ random.and
-      (random.ascii 10)
-      (random.maybe (random.ascii 10))
-      ..url
-      (random.maybe ..url)))
-
-(def: addendum
-  (Random Addendum)
-  ($_ random.and
-      random.bit
-      ))
-
-(def: license
-  (Random License)
-  ($_ random.and
-      (random.list 2 ..copyright-holder)
-      (random.maybe ..identification)
-      ..termination
-      ..liability
-      ..distribution
-      ..commercial
-      ..extension
-      (variable-list 3 ..black-list)
-      (random.maybe attribution)
-      ..addendum
-      ))
-
-(type: (Concern a)
-  (-> (-> Text Bit) a Test))
-
-(def: (about-grant present? termination)
-  (Concern Termination)
-  ($_ _.and
-      (_.test "Copyright grant is present."
-              (present? grant.copyright))
-      (_.test "Patent grant is present."
-              (present? (grant.patent (get@ #license.patent-retaliation? termination))))
-      (_.test "Effective date for the grants is present."
-              (present? grant.date))
-      (_.test "Patent grant is present."
-              (present? (grant.termination (get@ #license.termination-period termination)
-                                           (get@ #license.grace-period termination))))
-      (_.test "The termination period is accurately conveyed."
-              (present? (grant.grant-restoration-clause (get@ #license.termination-period termination))))
-      (_.test "The grace period is accurately conveyed."
-              (present? (grant.grace-period-clause (get@ #license.grace-period termination))))
-      (_.test "The grants are not retro-actively terminated."
-              (present? grant.no-retroactive-termination))
-      ))
-
-(def: (about-liability present? liability)
-  (Concern Liability)
-  ($_ _.and
-      (_.test "Warranty liability disclaimer is present."
-              (present? liability.warranty))
-      (_.test "Limitation of liability is present."
-              (present? liability.limitation))
-      (_.test "Litigation conditions are present."
-              (present? liability.litigation))
-      (_.test "Liability acceptance conditions may be present."
-              (bit\= (get@ #license.can-accept? liability)
-                     (present? liability.can-accept)))
-      (_.test "Liability acceptance conditions may be present."
-              (bit\= (get@ #license.disclaim-high-risk? liability)
-                     (present? liability.disclaim-high-risk)))
-      ))
-
-(def: (about-distribution present? distribution)
-  (Concern Distribution)
-  ($_ _.and
-      (_.test "Conditions for source-code distribution are present."
-              (present? distribution.source-code-form))
-      (_.test "Conditions for object-code distribution are present."
-              (present? distribution.object-form))
-      (_.test "Conditions for extension distribution are present."
-              (present? (distribution.extension distribution)))
-      ))
-
-(def: (about-commercial present? commercial)
-  (Concern Commercial)
-  ($_ _.and
-      (_.test "Non-commercial clause is present."
-              (bit\= (not (get@ #license.can-sell? commercial))
-                     (present? commercial.cannot-sell)))
-      (_.test "Contributor credit condition is present."
-              (bit\= (get@ #license.require-contributor-credit? commercial)
-                     (present? commercial.require-contributor-attribution)))
-      (_.test "Anti-endorsement condition is present."
-              (bit\= (not (get@ #license.allow-contributor-endorsement? commercial))
-                     (present? commercial.disallow-contributor-endorsement)))
-      ))
-
-(def: (about-extension present? extension)
-  (Concern Extension)
-  ($_ _.and
-      (_.test "The license is viral."
-              (bit\= (get@ #license.same-license? extension)
-                     (and (list.every? present? extension.sharing-requirement)
-                          (list.every? present? extension.license-conflict-resolution))))
-      (_.test "Extensions must be distinguishable from the original work."
-              (bit\= (get@ #license.must-be-distinguishable? extension)
-                     (present? extension.distinctness-requirement)))
-      (_.test "The community must be notified of new extensions."
-              (case (get@ #license.notification-period extension)
-                (#.Some period)
-                (present? (extension.notification-requirement period))
-
-                #.None
-                true))
-      (_.test "Must describe modifications."
-              (bit\= (get@ #license.must-describe-modifications? extension)
-                     (present? extension.description-requirement)))
-      ))
-
-(def: (about-attribution present? attribution)
-  (Concern Attribution)
-  ($_ _.and
-      (_.test "The attribution copyright notice is present."
-              (present? (get@ #license.copyright-notice attribution)))
-      (_.test "The attribution phrase is present."
-              (|> attribution
-                  (get@ #license.phrase)
-                  (maybe\map present?)
-                  (maybe.default true)))
-      (_.test "The attribution URL is present."
-              (present? (get@ #license.url attribution)))
-      (_.test "The attribution image is present."
-              (|> attribution
-                  (get@ #license.image)
-                  (maybe\map present?)
-                  (maybe.default true)))
-      ))
-
-(def: (about-miscellaneous present?)
-  (-> (-> Text Bit) Test)
-  ($_ _.and
-      (_.test "License constitutes the entire agreement."
-              (present? miscellaneous.entire-agreement))
-      (_.test "Disclaims relationship of parties."
-              (present? miscellaneous.relationship-of-parties))
-      (_.test "Explicitly allows independent development."
-              (present? miscellaneous.independent-development))
-      (_.test "Clarifies consent to breach does not waiver."
-              (present? miscellaneous.not-waiver))
-      (_.test "Provides severability."
-              (present? miscellaneous.severability))
-      (_.test "Covers export restrictions."
-              (present? miscellaneous.export-restrictions))
-      ))
-
-(def: (about-addendum present? value)
-  (Concern Addendum)
-  ($_ _.and
-      (_.test "Commons clause"
-              (bit\= (get@ #license.commons-clause? value)
-                     (present? addendum.commons-clause)))
-      ))
-
-(def: test
-  Test
-  (do random.monad
-    [license ..license
-     #let [writ (output.license license)
-           present? (: (-> Text Bit)
-                       (function (_ snippet)
-                         (text.contains? snippet writ)))]]
-    ($_ _.and
-        (_.test "Copyright notices are present."
-                (list.every? (|>> notice.copyright-holder present?)
-                             (get@ #license.copyright-holders license)))
-        
-        (_.test "Identification is present (if the license is identified)."
-                (case (get@ #license.identification license)
-                  (#.Some identification)
-                  (and (present? (output.identification identification))
-                       (present? miscellaneous.new-versions))
-
-                  #.None
-                  (not (present? miscellaneous.new-versions))))
-
-        (_.test "Black-lists (if wanted by licensor) are explicitly enumerated and justified."
-                (list.every? (function (_ black-list)
-                               (let [black-list-is-justified? (case (get@ #license.justification black-list)
-                                                                (#.Some justification)
-                                                                (present? justification)
-
-                                                                #.None
-                                                                yes)
-                                     every-entity-is-mentioned? (|> black-list
-                                                                    (get@ #license.entities)
-                                                                    (list\map black-list.entity)
-                                                                    (list.every? present?))]
-                                 (and black-list-is-justified?
-                                      every-entity-is-mentioned?)))
-                             (get@ #license.black-lists license)))
-        
-        (_.test "All definitions are present."
-                (list.every? (|>> output.definition present?)
-                             definition.all))
-
-        (_.test "Acceptance of the license is demanded."
-                (present? limitation.acceptance))
-        
-        (..about-grant present? (get@ #license.termination license))
-        
-        (_.test "All limitations are present."
-                (present? output.limitation))
-        
-        (_.test "All assurances are present."
-                (present? output.assurance))
-        
-        (_.test "The terms of submission are present."
-                (present? submission.contribution))
-        
-        (..about-liability present? (get@ #license.liability license))
-
-        (..about-distribution present? (get@ #license.distribution license))
-
-        (..about-commercial present? (get@ #license.commercial license))
-
-        (..about-extension present? (get@ #license.extension license))
-
-        (case (get@ #license.attribution license)
-          (#.Some attribution)
-          (..about-attribution present? attribution)
-
-          #.None
-          (_.test "Attribution is missing."
-                  yes))
-
-        (..about-miscellaneous present?)
-
-        (..about-addendum present? (get@ #license.addendum license))
-
-        (_.test "License ending footer is present."
-                (present? notice.end-of-license))
-        )))
-
-(program: args
-  (io (_.run! (<| (_.times 100)
-                  ..test))))
diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux
index f816075f5..354433cc8 100644
--- a/stdlib/source/test/lux/control/function.lux
+++ b/stdlib/source/test/lux/control/function.lux
@@ -18,7 +18,8 @@
   ["." / #_
    ["#." contract]
    ["#." memo]
-   ["#." mixin]])
+   ["#." mixin]
+   ["#." mutual]])
 
 (def: #export test
   Test
@@ -62,4 +63,5 @@
             /contract.test
             /memo.test
             /mixin.test
+            /mutual.test
             ))))
diff --git a/stdlib/source/test/lux/control/function/mutual.lux b/stdlib/source/test/lux/control/function/mutual.lux
new file mode 100644
index 000000000..e645e282b
--- /dev/null
+++ b/stdlib/source/test/lux/control/function/mutual.lux
@@ -0,0 +1,65 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [data
+    ["." bit ("#\." equivalence)]
+    [text
+     ["%" format (#+ format)]]]
+   [math
+    ["." random (#+ Random)]
+    [number
+     ["n" nat]]]]
+  {1
+   ["." /]})
+
+(def: test_let
+  Test
+  (do {! random.monad}
+    [sample (\ ! map (n.% 10) random.nat)
+     #let [expected (n.even? sample)]]
+    (<| (_.cover [/.let])
+        (/.let [(even? number)
+                (-> Nat Bit)
+                (case number
+                  0 true
+                  _ (odd? (dec number)))
+
+                (odd? number)
+                (-> Nat Bit)
+                (case number
+                  0 false
+                  _ (even? (dec number)))]
+          (and (bit\= expected (even? sample))
+               (bit\= (not expected) (odd? sample)))))))
+
+(/.def:
+  [(even? number)
+   (-> Nat Bit)
+   (case number
+     0 true
+     _ (odd? (dec number)))]
+
+  [(odd? number)
+   (-> Nat Bit)
+   (case number
+     0 false
+     _ (even? (dec number)))])
+
+(def: test_def
+  Test
+  (do {! random.monad}
+    [sample (\ ! map (n.% 10) random.nat)
+     #let [expected (n.even? sample)]]
+    (<| (_.cover [/.def:])
+        (and (bit\= expected (..even? sample))
+             (bit\= (not expected) (..odd? sample))))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      ($_ _.and
+          ..test_let
+          ..test_def
+          )))
diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux
index 0405ef7ee..8b560ca40 100644
--- a/stdlib/source/test/lux/world.lux
+++ b/stdlib/source/test/lux/world.lux
@@ -5,7 +5,10 @@
    ["#." file]
    ["#." shell]
    ["#." console]
-   ["#." program]])
+   ["#." program]
+   ["#." output #_
+    ["#/." video #_
+     ["#/." resolution]]]])
 
 (def: #export test
   Test
@@ -14,4 +17,5 @@
       /shell.test
       /console.test
       /program.test
+      /output/video/resolution.test
       ))
diff --git a/stdlib/source/test/lux/world/output/video/resolution.lux b/stdlib/source/test/lux/world/output/video/resolution.lux
new file mode 100644
index 000000000..f5dcf5380
--- /dev/null
+++ b/stdlib/source/test/lux/world/output/video/resolution.lux
@@ -0,0 +1,63 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]
+      ["$." hash]]}]
+   [data
+    ["." maybe]
+    [collection
+     ["." list]
+     ["." set (#+ Set)]]]
+   [math
+    ["." random (#+ Random)]
+    [number
+     ["n" nat]]]]
+  {1
+   ["." /]})
+
+(with_expansions [<resolutions> (as_is /.svga
+                                       /.wsvga
+                                       /.xga
+                                       /.xga+
+                                       /.wxga/16:9
+                                       /.wxga/5:3
+                                       /.wxga/16:10
+                                       /.sxga
+                                       /.wxga+
+                                       /.hd+
+                                       /.wsxga+
+                                       /.fhd
+                                       /.wuxga
+                                       /.wqhd
+                                       /.uhd-4k)]
+  (def: catalogue
+    (Set /.Resolution)
+    (set.from_list /.hash (list <resolutions>)))
+
+  (def: #export random
+    (Random /.Resolution)
+    (let [listing (set.to_list catalogue)
+          count (list.size listing)]
+      (do {! random.monad}
+        [choice (\ ! map (n.% count) random.nat)]
+        (wrap (maybe.assume (list.nth choice listing))))))
+
+  (def: #export test
+    Test
+    (<| (_.covering /._)
+        (_.for [/.Resolution])
+        ($_ _.and
+            (_.for [/.equivalence]
+                   ($equivalence.spec /.equivalence ..random))
+            (_.for [/.hash]
+                   ($hash.spec /.hash ..random))
+
+            (_.cover [<resolutions>]
+                     (let [listing (set.to_list catalogue)]
+                       (n.= (list.size listing)
+                            (set.size catalogue))))
+            ))))