Re-named "to-text" functions to "format".

6 files changed, 175 insertions, 68 deletions

diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux
index 48ecc9189..c496eb88b 100644
--- a/stdlib/source/test/aedifex.lux
+++ b/stdlib/source/test/aedifex.lux
@@ -10,6 +10,7 @@
    ["#." profile]
    ["#." project]
    ["#." cli]
+   ["#." hash]
    ["#." parser]])
 
 (def: test
@@ -19,6 +20,7 @@
       /profile.test
       /project.test
       /cli.test
+      /hash.test
       /parser.test
       ))
 
diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux
new file mode 100644
index 000000000..21e318be6
--- /dev/null
+++ b/stdlib/source/test/aedifex/hash.lux
@@ -0,0 +1,95 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #spec]
+     [/
+      ["$." equivalence]
+      ["$." codec]]}]
+   [control
+    ["." try]
+    ["." exception]]
+   [data
+    ["." binary (#+ Binary)]
+    [number
+     ["n" nat]]
+    [text
+     ["%" format (#+ format)]]]
+   [math
+    ["." random (#+ Random)]]]
+  {#program
+   ["." /]}
+  [test
+   [lux
+    [data
+     ["_." binary]]]])
+
+(def: (random hash)
+  (All [h]
+    (-> (-> Binary (/.Hash h))
+        (Random (/.Hash h))))
+  (do {@ random.monad}
+    [size (:: @ map (n.% 100) random.nat)]
+    (:: @ map hash (_binary.random size))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.Hash /.SHA-1 /.MD5])
+      (`` ($_ _.and
+              (_.with-cover [/.equivalence]
+                ($_ _.and
+                    ($equivalence.spec /.equivalence (..random /.sha1))
+                    ($equivalence.spec /.equivalence (..random /.md5))
+                    ))
+              (_.with-cover [/.data]
+                ($_ _.and
+                    (~~ (template [<hash> <constructor> <exception>]
+                          [(do random.monad
+                             [expected (..random <hash>)]
+                             (_.cover [<hash> <constructor> <exception>]
+                                      (and (case (<constructor> (/.data expected))
+                                             (#try.Success actual)
+                                             (:: /.equivalence = expected actual)
+
+                                             (#try.Failure error)
+                                             false)
+                                           (case (<constructor> (:: binary.monoid compose
+                                                                    (/.data expected)
+                                                                    (/.data expected)))
+                                             (#try.Success actual)
+                                             false
+
+                                             (#try.Failure error)
+                                             (exception.match? <exception> error)))))]
+
+                          [/.sha1 /.as-sha1 /.not-a-sha1]
+                          [/.md5 /.as-md5 /.not-a-md5]
+                          ))))
+              (~~ (template [<codec> <hash>]
+                    [(_.with-cover [<codec>]
+                       ($codec.spec /.equivalence <codec> (..random <hash>)))]
+                    
+                    [/.sha1-codec /.sha1]
+                    [/.md5-codec /.md5]
+                    ))
+              (_.with-cover [/.not-a-hash]
+                ($_ _.and
+                    (~~ (template [<codec> <hash>]
+                          [(do random.monad
+                             [expected (..random <hash>)]
+                             (_.cover [<codec>]
+                                      (case (:: <codec> decode
+                                                (format (:: <codec> encode expected)
+                                                        "AABBCC"))
+                                        (#try.Success actual)
+                                        false
+
+                                        (#try.Failure error)
+                                        (exception.match? /.not-a-hash error))))]
+
+                          [/.sha1-codec /.sha1]
+                          [/.md5-codec /.md5]
+                          ))))
+              ))))
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux
index 17f773206..c011df720 100644
--- a/stdlib/source/test/lux/data/binary.lux
+++ b/stdlib/source/test/lux/data/binary.lux
@@ -31,7 +31,7 @@
     (#try.Success output)
     output))
 
-(def: #export (binary size)
+(def: #export (random size)
   (-> Nat (Random Binary))
   (let [output (/.create size)]
     (loop [idx 0]
@@ -80,7 +80,7 @@
       (do {@ random.monad}
         [#let [gen-size (|> random.nat (:: @ map (|>> (n.% 100) (n.max 8))))]
          size gen-size
-         sample (..binary size)
+         sample (..random size)
          value random.nat
          #let [gen-idx (|> random.nat (:: @ map (n.% size)))]
          [from to] (random.and gen-idx gen-idx)
@@ -88,9 +88,9 @@
         (_.with-cover [/.Binary]
           ($_ _.and
               (_.with-cover [/.equivalence]
-                ($equivalence.spec /.equivalence (..binary size)))
+                ($equivalence.spec /.equivalence (..random size)))
               (_.with-cover [/.monoid]
-                ($monoid.spec /.equivalence /.monoid (..binary size)))
+                ($monoid.spec /.equivalence /.monoid (..random size)))
               (_.cover [/.fold]
                        (n.= (:: list.fold fold n.+ 0 (..as-list sample))
                             (/.fold n.+ 0 sample)))
diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux
index 59d7e3443..166ced163 100644
--- a/stdlib/source/test/lux/data/collection/bits.lux
+++ b/stdlib/source/test/lux/data/collection/bits.lux
@@ -1,6 +1,5 @@
 (.module:
   [lux #*
-   ["%" data/text/format (#+ format)]
    ["_" test (#+ Test)]
    [abstract
     [monad (#+ do)]
@@ -12,74 +11,85 @@
     [number
      ["n" nat]]]
    [math
-    ["r" random (#+ Random)]]]
+    ["." random (#+ Random)]]]
   {1
    ["." / (#+ Bits)]})
 
 (def: (size min max)
   (-> Nat Nat (Random Nat))
-  (|> r.nat
-      (:: r.monad map (|>> (n.% max) (n.max min)))))
+  (|> random.nat
+      (:: random.monad map (|>> (n.% (inc max)) (n.max min)))))
 
-(def: #export bits
+(def: #export random
   (Random Bits)
-  (do {@ r.monad}
-    [size (size 1 1,000)
-     idx (|> r.nat (:: @ map (n.% size)))]
-    (wrap (|> /.empty (/.set idx)))))
+  (do {@ random.monad}
+    [size (:: @ map (n.% 1,000) random.nat)]
+    (case size
+      0 (wrap /.empty)
+      _ (do {@ random.monad}
+          [idx (|> random.nat (:: @ map (n.% size)))]
+          (wrap (/.set idx /.empty))))))
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /._)))
+  (<| (_.covering /._)
+      (_.with-cover [/.Bits])
       ($_ _.and
-          ($equivalence.spec /.equivalence ..bits)
-          (do {@ r.monad}
-            [size (size 1 1,000)
-             idx (|> r.nat (:: @ map (n.% size)))
-             sample bits]
+          (_.with-cover [/.equivalence]
+            ($equivalence.spec /.equivalence ..random))
+
+          (do random.monad
+            [sample ..random]
+            (_.cover [/.empty? /.size]
+                     (if (/.empty? sample)
+                       (n.= 0 (/.size sample))
+                       (n.> 0 (/.size sample)))))
+          (_.cover [/.empty]
+                   (/.empty? /.empty))
+          
+          (do {@ random.monad}
+            [size (:: @ map (|>> (n.% 1,000) inc) random.nat)
+             idx (:: @ map (n.% size) random.nat)
+             sample ..random]
             ($_ _.and
-                (_.test "Can set individual bits."
-                        (and (|> /.empty (/.get idx) not)
-                             (|> /.empty (/.set idx) (/.get idx))))
-                (_.test "Can clear individual bits."
-                        (|> /.empty (/.set idx) (/.clear idx) (/.get idx) not))
-                (_.test "Can flip individual bits."
-                        (and (|> /.empty (/.flip idx) (/.get idx))
-                             (|> /.empty (/.flip idx) (/.flip idx) (/.get idx) not)))
-                (_.test "Bits (only) grow when (and as much as) necessary."
-                        (and (n.= 0 (/.capacity /.empty))
-                             (|> /.empty (/.set idx) /.capacity
-                                 (n.- idx)
-                                 (predicate.unite (n.>= 0)
-                                                  (n.< /.chunk-size)))))
-                (_.test "Bits (must) shrink when (and as much as) possible."
-                        (let [grown (/.flip idx /.empty)]
-                          (and (n.> 0 (/.capacity grown))
-                               (is? /.empty (/.flip idx grown)))))
-                (_.test "Intersection can be detected when there are set bits in common."
-                        (and (not (/.intersects? /.empty
-                                                 /.empty))
-                             (/.intersects? (/.set idx /.empty)
-                                            (/.set idx /.empty))
-                             (not (/.intersects? (/.set (inc idx) /.empty)
-                                                 (/.set idx /.empty)))))
-                (_.test "Cannot intersect with one's opposite."
-                        (not (/.intersects? sample (/.not sample))))
-                (_.test "'and' with oneself changes nothing"
-                        (:: /.equivalence = sample (/.and sample sample)))
-                (_.test "'and' with one's opposite yields the empty bit-set."
-                        (is? /.empty (/.and sample (/.not sample))))
-                
-                (_.test "'or' with one's opposite fully saturates a bit-set."
-                        (n.= (/.size (/.or sample (/.not sample)))
-                             (/.capacity sample)))
-                (_.test "'xor' with oneself yields the empty bit-set."
-                        (is? /.empty (/.xor sample sample)))
-                (_.test "'xor' with one's opposite fully saturates a bit-set."
-                        (n.= (/.size (/.xor sample (/.not sample)))
-                             (/.capacity sample)))
-                (_.test "Double negation results in original bit-set."
-                        (:: /.equivalence = sample (/.not (/.not sample))))
-                (_.test "Negation does not affect the empty bit-set."
-                        (is? /.empty (/.not /.empty)))
+                (_.cover [/.get /.set]
+                         (and (|> /.empty (/.get idx) not)
+                              (|> /.empty (/.set idx) (/.get idx))))
+                (_.cover [/.clear]
+                         (|> /.empty (/.set idx) (/.clear idx) (/.get idx) not))
+                (_.cover [/.flip]
+                         (and (|> /.empty (/.flip idx) (/.get idx))
+                              (|> /.empty (/.flip idx) (/.flip idx) (/.get idx) not)))
+                (_.cover [/.Chunk /.capacity /.chunk-size]
+                         (and (n.= 0 (/.capacity /.empty))
+                              (|> /.empty (/.set idx) /.capacity
+                                  (n.- idx)
+                                  (predicate.unite (n.>= 0)
+                                                   (n.< /.chunk-size)))
+                              (let [grown (/.flip idx /.empty)]
+                                (and (n.> 0 (/.capacity grown))
+                                     (is? /.empty (/.flip idx grown))))))
+                (_.cover [/.intersects?]
+                         (and (not (/.intersects? /.empty
+                                                  /.empty))
+                              (/.intersects? (/.set idx /.empty)
+                                             (/.set idx /.empty))
+                              (not (/.intersects? (/.set (inc idx) /.empty)
+                                                  (/.set idx /.empty)))
+                              (not (/.intersects? sample (/.not sample)))))
+                (_.cover [/.not]
+                         (and (not (:: /.equivalence = sample (/.not sample)))
+                              (:: /.equivalence = sample (/.not (/.not sample)))
+                              (is? /.empty (/.not /.empty))))
+                (_.cover [/.xor]
+                         (and (is? /.empty (/.xor sample sample))
+                              (n.= (/.size (/.xor sample (/.not sample)))
+                                   (/.capacity sample))))
+                (_.cover [/.or]
+                         (and (:: /.equivalence = sample (/.or sample sample))
+                              (n.= (/.size (/.or sample (/.not sample)))
+                                   (/.capacity sample))))
+                (_.cover [/.and]
+                         (and (:: /.equivalence = sample (/.and sample sample))
+                              (is? /.empty (/.and sample (/.not sample)))))
                 )))))
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index 717d4be94..9b85a557c 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -119,13 +119,13 @@
       ($_ _.and
           (_.with-cover [/.equivalence]
             ($equivalence.spec /.equivalence ..random))
-          (_.with-cover [/.to-text]
+          (_.with-cover [/.format]
             (`` ($_ _.and
                     (~~ (template [<coverage> <random> <tag>]
                           [(do {@ random.monad}
                              [expected <random>]
                              (_.cover [<coverage>]
-                                      (and (case (..read (/.to-text (<coverage> expected)))
+                                      (and (case (..read (/.format (<coverage> expected)))
                                              (#try.Success actual)
                                              (:: /.equivalence =
                                                  actual
@@ -152,7 +152,7 @@
                           [(do {@ random.monad}
                              [expected <random>]
                              (_.cover [<coverage>]
-                                      (and (case (..read (/.to-text (<coverage> expected)))
+                                      (and (case (..read (/.format (<coverage> expected)))
                                              (#try.Success actual)
                                              (:: /.equivalence =
                                                  actual
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 7df1cdd07..4eefd9e03 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -982,7 +982,7 @@
                                   @.jvm
                                   (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))}))))
         (_.context "float"
-                   (array (/.newarray /instruction.t-float) $Float::random $Float::literal [/.fastore /.faload $Float::wrap]
+                   (array (/.newarray /instruction.t-float) ..valid-float $Float::literal [/.fastore /.faload $Float::wrap]
                           (function (_ expected)
                             (for {@.old
                                   (|>> (:coerce java/lang/Float) ("jvm feq" expected))
@@ -990,7 +990,7 @@
                                   @.jvm
                                   (|>> (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (:coerce java/lang/Float expected))))}))))
         (_.context "double"
-                   (array (/.newarray /instruction.t-double) $Double::random $Double::literal [/.dastore /.daload $Double::wrap]
+                   (array (/.newarray /instruction.t-double) ..valid-double $Double::literal [/.dastore /.daload $Double::wrap]
                           (function (_ expected)
                             (for {@.old
                                   (|>> (:coerce java/lang/Double) ("jvm deq" expected))