Ported tests for format-related modules.

4 files changed, 140 insertions, 191 deletions

diff --git a/stdlib/source/test/lux/control/codec.lux b/stdlib/source/test/lux/control/codec.lux
index e061f9e36..f8159838b 100644
--- a/stdlib/source/test/lux/control/codec.lux
+++ b/stdlib/source/test/lux/control/codec.lux
@@ -18,7 +18,7 @@
   (do r.monad
     [expected generator]
     (<| (_.context (%name (name-of /.Codec)))
-        (_.test "Reflexivity."
+        (_.test "Isomorphism."
                 (case (|> expected /@encode /@decode)
                   (#error.Success actual)
                   (/@= expected actual)
diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux
index 907082d99..9175d970e 100644
--- a/stdlib/source/test/lux/data.lux
+++ b/stdlib/source/test/lux/data.lux
@@ -22,9 +22,11 @@
    ["#." text
     ["#/." lexer]
     ["#/." regex]]
-   ])
+   [format
+    ["#." json]
+    ["#." xml]]])
 
-(def: #export number
+(def: number
   Test
   ($_ _.and
       /i64.test
@@ -36,13 +38,19 @@
       /complex.test
       ))
 
-(def: #export text
+(def: text
   ($_ _.and
       /text.test
       /text/lexer.test
       /text/regex.test
       ))
 
+(def: format
+  ($_ _.and
+      /json.test
+      /xml.test
+      ))
+
 (def: #export test
   Test
   ($_ _.and
@@ -57,4 +65,5 @@
       /sum.test
       ..number
       ..text
+      ..format
       ))
diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux
index cdaeb5d31..11bed07da 100644
--- a/stdlib/source/test/lux/data/format/json.lux
+++ b/stdlib/source/test/lux/data/format/json.lux
@@ -1,20 +1,24 @@
 (.module:
   [lux #*
+   data/text/format
+   ["_" test (#+ Test)]
    [control
-    [monad (#+ do Monad)]
+    pipe
     codec
+    [monad (#+ do Monad)]
     [equivalence (#+ Equivalence)]
-    pipe
-    ["p" parser]]
+    ["p" parser]
+    {[0 #test]
+     [/
+      ["$." equivalence]
+      ["$." codec]]}]
    [data
     ["." error]
     ["." bit]
     ["." maybe]
-    ["." number]
-    ["." text
-     format]
-    [format
-     ["@" json]]
+    ["." text]
+    [number
+     ["." frac]]
     [collection
      [row (#+ row)]
      ["d" dictionary]
@@ -26,58 +30,40 @@
    [type
     ["." unit]]
    [math
-    ["r" random]]
+    ["r" random (#+ Random)]]
    [time
     ["ti" instant]
     ["tda" date]
     ## ["tdu" duration]
-    ]
-   test]
+    ]]
   [test
    [lux
     [time
      ["_." instant]
      ## ["_." duration]
      ["_." date]]]]
+  {1
+   ["." / (#+ JSON)]}
   )
 
-(def: gen-json
-  (r.Random @.JSON)
-  (r.rec (function (_ gen-json)
+(def: #export json
+  (Random JSON)
+  (r.rec (function (_ json)
            (do r.monad
              [size (:: @ map (n/% 2) r.nat)]
              ($_ r.or
                  (:: @ wrap [])
                  r.bit
-                 (|> r.frac (:: @ map (f/* +1,000,000.0)))
+                 r.frac
                  (r.unicode size)
-                 (r.row size gen-json)
-                 (r.dictionary text.hash size (r.unicode size) gen-json)
+                 (r.row size json)
+                 (r.dictionary text.hash size (r.unicode size) json)
                  )))))
 
-(context: "JSON"
-  (<| (times 100)
-      (do @
-        [sample gen-json
-         #let [(^open "@/.") @.equivalence
-               (^open "@/.") @.codec]]
-        ($_ seq
-            (test "Every JSON is equal to itself."
-                  (@/= sample sample))
-
-            (test "Can encode/decode JSON."
-                  (|> sample @/encode @/decode
-                      (case> (#.Right result)
-                             (@/= sample result)
-
-                             (#.Left _)
-                             #0)))
-            ))))
-
 (type: Variant
-  (#Case0 Bit)
-  (#Case1 Text)
-  (#Case2 Frac))
+  (#Bit Bit)
+  (#Text Text)
+  (#Frac Frac))
 
 (type: #rec Recursive
   (#Number Frac)
@@ -89,9 +75,9 @@
    #text Text
    #maybe (Maybe Frac)
    #list (List Frac)
-   #dict (d.Dictionary Text Frac)
-   ## #variant Variant
-   ## #tuple [Bit Frac Text]
+   #dictionary (d.Dictionary Text Frac)
+   #variant Variant
+   #tuple [Bit Frac Text]
    #recursive Recursive
    ## #instant ti.Instant
    ## #duration tdu.Duration
@@ -100,19 +86,19 @@
    })
 
 (def: gen-recursive
-  (r.Random Recursive)
+  (Random Recursive)
   (r.rec (function (_ gen-recursive)
            (r.or r.frac
                  (r.and r.frac gen-recursive)))))
 
-(derived: (poly/equivalence.Equivalence<?> Recursive))
+(derived: recursive-equivalence (poly/equivalence.equivalence Recursive))
 
 (def: qty
-  (All [unit] (r.Random (unit.Qty unit)))
+  (All [unit] (Random (unit.Qty unit)))
   (|> r.int (:: r.monad map unit.in)))
 
 (def: gen-record
-  (r.Random Record)
+  (Random Record)
   (do r.monad
     [size (:: @ map (n/% 2) r.nat)]
     ($_ r.and
@@ -122,8 +108,8 @@
         (r.maybe r.frac)
         (r.list size r.frac)
         (r.dictionary text.hash size (r.unicode size) r.frac)
-        ## ($_ r.or r.bit (r.unicode size) r.frac)
-        ## ($_ r.and r.bit r.frac (r.unicode size))
+        ($_ r.or r.bit (r.unicode size) r.frac)
+        ($_ r.and r.bit r.frac (r.unicode size))
         gen-recursive
         ## _instant.instant
         ## _duration.duration
@@ -131,53 +117,16 @@
         qty
         )))
 
-(derived: (poly/json.codec Record))
-
-(structure: _ (Equivalence Record)
-  (def: (= recL recR)
-    (let [variant/= (function (_ left right)
-                      (case [left right]
-                        [(#Case0 left') (#Case0 right')]
-                        (:: bit.equivalence = left' right')
-
-                        [(#Case1 left') (#Case1 right')]
-                        (:: text.equivalence = left' right')
-
-                        [(#Case2 left') (#Case2 right')]
-                        (f/= left' right')
-
-                        _
-                        #0))]
-      (and (:: bit.equivalence = (get@ #bit recL) (get@ #bit recR))
-           (f/= (get@ #frac recL) (get@ #frac recR))
-           (:: text.equivalence = (get@ #text recL) (get@ #text recR))
-           (:: (maybe.equivalence number.equivalence) = (get@ #maybe recL) (get@ #maybe recR))
-           (:: (list.equivalence number.equivalence) = (get@ #list recL) (get@ #list recR))
-           (:: (d.equivalence number.equivalence) = (get@ #dict recL) (get@ #dict recR))
-           ## (variant/= (get@ #variant recL) (get@ #variant recR))
-           ## (let [[tL0 tL1 tL2] (get@ #tuple recL)
-           ##       [tR0 tR1 tR2] (get@ #tuple recR)]
-           ##   (and (:: bit.equivalence = tL0 tR0)
-           ##        (f/= tL1 tR1)
-           ##        (:: text.equivalence = tL2 tR2)))
-           (:: equivalence = (get@ #recursive recL) (get@ #recursive recR))
-           ## (:: ti.equivalence = (get@ #instant recL) (get@ #instant recR))
-           ## (:: tdu.equivalence = (get@ #duration recL) (get@ #duration recR))
-           (:: tda.equivalence = (get@ #date recL) (get@ #date recR))
-           (:: unit.equivalence = (get@ #grams recL) (get@ #grams recR))
-           ))))
-
-(context: "Polytypism"
-  (<| (seed 14562075782602945288)
-      ## (times 100)
-      (do @
-        [sample gen-record
-         #let [(^open "@/.") ..equivalence
-               (^open "@/.") ..codec]]
-        (test "Can encode/decode arbitrary types."
-              (|> sample @/encode @/decode
-                  (case> (#error.Success result)
-                         (@/= sample result)
-
-                         (#error.Failure error)
-                         #0))))))
+(derived: equivalence (poly/equivalence.equivalence Record))
+(derived: codec (poly/json.codec Record))
+
+(def: #export test
+  Test
+  (<| (_.context (%name (name-of /.JSON)))
+      ($_ _.and
+          ($equivalence.spec /.equivalence ..json)
+          ($codec.spec /.equivalence /.codec ..json)
+          (<| (_.context "Polytypism.")
+              (<| (_.seed 14562075782602945288)
+                  ($codec.spec ..equivalence ..codec gen-record)))
+          )))
diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux
index 35e7dc4a1..221edba97 100644
--- a/stdlib/source/test/lux/data/format/xml.lux
+++ b/stdlib/source/test/lux/data/format/xml.lux
@@ -1,23 +1,27 @@
 (.module:
-  [lux #*
+  [lux (#- char)
+   data/text/format
+   ["_" test (#+ Test)]
    [control
+    pipe
     [monad (#+ Monad do)]
     ["p" parser]
-    pipe]
+    {[0 #test]
+     [/
+      ["$." equivalence]
+      ["$." codec]]}]
    [data
     ["." name]
     ["E" error]
     ["." maybe]
-    ["." text ("#;." equivalence)
-     format]
-    [format
-     ["&" xml]]
+    ["." text ("#@." equivalence)]
     [collection
-     ["dict" dictionary]
-     ["." list ("#;." functor)]]]
+     ["." dictionary]
+     ["." list ("#@." functor)]]]
    [math
-    ["r" random ("#;." monad)]]]
-  lux/test)
+    ["r" random (#+ Random) ("#@." monad)]]]
+  {1
+   ["." / (#+ XML)]})
 
 (def: char-range
   Text
@@ -25,97 +29,84 @@
           "abcdefghijklmnopqrstuvwxyz"
           "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
 
-(def: xml-char^
-  (r.Random Nat)
+(def: char
+  (Random Nat)
   (do r.monad
     [idx (|> r.nat (:: @ map (n/% (text.size char-range))))]
     (wrap (maybe.assume (text.nth idx char-range)))))
 
-(def: (size^ bottom top)
-  (-> Nat Nat (r.Random Nat))
+(def: (size bottom top)
+  (-> Nat Nat (Random Nat))
   (let [constraint (|>> (n/% top) (n/max bottom))]
-    (r;map constraint r.nat)))
+    (r@map constraint r.nat)))
 
-(def: (xml-text^ bottom top)
-  (-> Nat Nat (r.Random Text))
+(def: (text bottom top)
+  (-> Nat Nat (Random Text))
   (do r.monad
-    [size (size^ bottom top)]
-    (r.text xml-char^ size)))
+    [size (..size bottom top)]
+    (r.text ..char size)))
 
 (def: xml-identifier^
-  (r.Random Name)
-  (r.and (xml-text^ 0 10)
-         (xml-text^ 1 10)))
+  (Random Name)
+  (r.and (..text 0 10)
+         (..text 1 10)))
 
-(def: gen-xml
-  (r.Random &.XML)
-  (r.rec (function (_ gen-xml)
-           (r.or (xml-text^ 1 10)
+(def: #export xml
+  (Random XML)
+  (r.rec (function (_ xml)
+           (r.or (..text 1 10)
                  (do r.monad
-                   [size (size^ 0 2)]
+                   [size (..size 0 2)]
                    ($_ r.and
                        xml-identifier^
-                       (r.dictionary name.hash size xml-identifier^ (xml-text^ 0 10))
-                       (r.list size gen-xml)))))))
+                       (r.dictionary name.hash size xml-identifier^ (..text 0 10))
+                       (r.list size xml)))))))
 
-(context: "XML."
-  (<| (times 100)
-      (do @
-        [sample gen-xml
-         #let [(^open "&;.") &.equivalence
-               (^open "&;.") &.codec]]
-        ($_ seq
-            (test "Every XML is equal to itself."
-                  (&;= sample sample))
+(def: #export test
+  Test
+  (<| (_.context (%name (name-of /.XML)))
+      ($_ _.and
+          ($equivalence.spec /.equivalence ..xml)
+          ($codec.spec /.equivalence /.codec ..xml)
 
-            (test "Can encode/decode XML."
-                  (|> sample &;encode &;decode
-                      (case> (#.Right result)
-                             (&;= sample result)
-
-                             (#.Left error)
-                             #0)))
-            ))))
-
-(context: "Parsing."
-  (<| (times 100)
-      (do @
-        [text (xml-text^ 1 10)
-         num-children (|> r.nat (:: @ map (n/% 5)))
-         children (r.list num-children (xml-text^ 1 10))
-         tag xml-identifier^
-         attr xml-identifier^
-         value (xml-text^ 1 10)
-         #let [node (#&.Node tag
-                             (dict.put attr value &.attrs)
-                             (list;map (|>> #&.Text) children))]]
-        ($_ seq
-            (test "Can parse text."
-                  (E.default #0
-                             (do E.monad
-                               [output (&.run (#&.Text text)
-                                              &.text)]
-                               (wrap (text;= text output)))))
-            (test "Can parse attributes."
-                  (E.default #0
-                             (do E.monad
-                               [output (|> (&.attr attr)
-                                           (p.before &.ignore)
-                                           (&.run node))]
-                               (wrap (text;= value output)))))
-            (test "Can parse nodes."
-                  (E.default #0
-                             (do E.monad
-                               [_ (|> (&.node tag)
-                                      (p.before &.ignore)
-                                      (&.run node))]
-                               (wrap #1))))
-            (test "Can parse children."
-                  (E.default #0
-                             (do E.monad
-                               [outputs (|> (&.children (p.some &.text))
-                                            (&.run node))]
-                               (wrap (:: (list.equivalence text.equivalence) =
-                                         children
-                                         outputs)))))
-            ))))
+          (do r.monad
+            [text (..text 1 10)
+             num-children (|> r.nat (:: @ map (n/% 5)))
+             children (r.list num-children (..text 1 10))
+             tag xml-identifier^
+             attr xml-identifier^
+             value (..text 1 10)
+             #let [node (#/.Node tag
+                                 (dictionary.put attr value /.attrs)
+                                 (list@map (|>> #/.Text) children))]]
+            ($_ _.and
+                (_.test "Can parse text."
+                        (E.default #0
+                                   (do E.monad
+                                     [output (/.run (#/.Text text)
+                                                    /.text)]
+                                     (wrap (text@= text output)))))
+                (_.test "Can parse attributes."
+                        (E.default #0
+                                   (do E.monad
+                                     [output (|> (/.attr attr)
+                                                 (p.before /.ignore)
+                                                 (/.run node))]
+                                     (wrap (text@= value output)))))
+                (_.test "Can parse nodes."
+                        (E.default #0
+                                   (do E.monad
+                                     [_ (|> (/.node tag)
+                                            (p.before /.ignore)
+                                            (/.run node))]
+                                     (wrap #1))))
+                (_.test "Can parse children."
+                        (E.default #0
+                                   (do E.monad
+                                     [outputs (|> (/.children (p.some /.text))
+                                                  (/.run node))]
+                                     (wrap (:: (list.equivalence text.equivalence) =
+                                               children
+                                               outputs)))))
+                ))
+          )))