From f28169f3ab674651fceff0c4c9989f5cc62b616b Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 22 Mar 2019 22:48:17 -0400
Subject: Ported tests for text-related modules.

---
 stdlib/source/lux/data/text/regex.lux       |  40 ++-
 stdlib/source/test/lux.lux                  |   9 +-
 stdlib/source/test/lux/data.lux             |  15 +
 stdlib/source/test/lux/data/product.lux     |  31 +-
 stdlib/source/test/lux/data/sum.lux         |  56 ++--
 stdlib/source/test/lux/data/text.lux        | 233 +++++++-------
 stdlib/source/test/lux/data/text/format.lux |  21 --
 stdlib/source/test/lux/data/text/lexer.lux  | 340 +++++++++-----------
 stdlib/source/test/lux/data/text/regex.lux  | 466 ++++++++++++++--------------
 9 files changed, 583 insertions(+), 628 deletions(-)
 delete mode 100644 stdlib/source/test/lux/data/text/format.lux

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux
index 2897a09fa..b94dbb73a 100644
--- a/stdlib/source/lux/data/text/regex.lux
+++ b/stdlib/source/lux/data/text/regex.lux
@@ -2,15 +2,15 @@
   [lux #*
    [control
     monad
-    ["p" parser ("#;." monad)]]
+    ["p" parser ("#@." monad)]]
    [data
     ["." product]
     ["." error]
     ["." maybe]
-    ["." number (#+ hex)
-     ["." int ("#;." codec)]]
+    [number (#+ hex)
+     ["." nat ("#@." decimal)]]
     [collection
-     ["." list ("#;." fold monad)]]]
+     ["." list ("#@." fold monad)]]]
    ["." macro (#+ with-gensyms)
     ["." code]
     ["s" syntax (#+ syntax:)]]]
@@ -18,7 +18,6 @@
    ["l" lexer]
    format])
 
-## [Utils]
 (def: regex-char^
   (l.Lexer Text)
   (l.none-of "\.|&()[]{}"))
@@ -45,7 +44,7 @@
 
 (def: (copy reference)
   (-> Text (l.Lexer Text))
-  (p.after (l.this reference) (p;wrap reference)))
+  (p.after (l.this reference) (p@wrap reference)))
 
 (def: (join-text^ part^)
   (-> (l.Lexer (List Text)) (l.Lexer Text))
@@ -68,10 +67,10 @@
 (def: (name^ current-module)
   (-> Text (l.Lexer Name))
   ($_ p.either
-      (p.and (p;wrap current-module) (p.after (l.this "..") name-part^))
+      (p.and (p@wrap current-module) (p.after (l.this "..") name-part^))
       (p.and name-part^ (p.after (l.this ".") name-part^))
-      (p.and (p;wrap "lux") (p.after (l.this ".") name-part^))
-      (p.and (p;wrap "") name-part^)))
+      (p.and (p@wrap "lux") (p.after (l.this ".") name-part^))
+      (p.and (p@wrap "") name-part^)))
 
 (def: (re-var^ current-module)
   (-> Text (l.Lexer Code))
@@ -116,7 +115,7 @@
     [_ (wrap [])
      init re-user-class^'
      rest (p.some (p.after (l.this "&&") (l.enclosed ["[" "]"] re-user-class^')))]
-    (wrap (list;fold (function (_ refinement base)
+    (wrap (list@fold (function (_ refinement base)
                        (` ((~! refine^) (~ refinement) (~ base))))
                      init
                      rest))))
@@ -185,14 +184,14 @@
 (def: number^
   (l.Lexer Nat)
   (|> (l.many l.decimal)
-      (p.codec number.codec)))
+      (p.codec nat.decimal)))
 
 (def: re-back-reference^
   (l.Lexer Code)
   (p.either (do p.monad
               [_ (l.this "\")
                id number^]
-              (wrap (` ((~! ..copy) (~ (code.identifier ["" (int;encode (.int id))]))))))
+              (wrap (` ((~! ..copy) (~ (code.identifier ["" (nat@encode id)]))))))
             (do p.monad
               [_ (l.this "\k<")
                captured-name name-part^
@@ -271,9 +270,9 @@
                          (re-scoped^ current-module)))
      #let [g!total (code.identifier ["" "0total"])
            g!temp (code.identifier ["" "0temp"])
-           [_ names steps] (list;fold (: (-> (Either Code [Re-Group Code])
-                                             [Int (List Code) (List (List Code))]
-                                             [Int (List Code) (List (List Code))])
+           [_ names steps] (list@fold (: (-> (Either Code [Re-Group Code])
+                                             [Nat (List Code) (List (List Code))]
+                                             [Nat (List Code) (List (List Code))])
                                          (function (_ part [idx names steps])
                                            (case part
                                              (^or (#.Left complex) (#.Right [#Non-Capturing complex]))
@@ -289,7 +288,7 @@
                                                                   [idx (code.identifier ["" _name])]
 
                                                                   #.None
-                                                                  [(inc idx) (code.identifier ["" (int;encode idx)])])
+                                                                  [(inc idx) (code.identifier ["" (nat@encode idx)])])
                                                    access (if (n/> 0 num-captures)
                                                             (` ((~! product.left) (~ name!)))
                                                             name!)]
@@ -299,7 +298,7 @@
                                                              (' #let) (` [(~ g!total) (:: (~! //.monoid) (~' compose) (~ g!total) (~ access))]))
                                                        steps)])
                                              )))
-                                      [+0
+                                      [0
                                        (: (List Code) (list))
                                        (: (List (List Code)) (list))]
                                       parts)]]
@@ -308,7 +307,7 @@
              0)
            (` (do p.monad
                 [(~ (' #let)) [(~ g!total) ""]
-                 (~+ (|> steps list.reverse list;join))]
+                 (~+ (|> steps list.reverse list@join))]
                 ((~ (' wrap)) [(~ g!total) (~+ (list.reverse names))])))])
     ))
 
@@ -364,13 +363,13 @@
      #let [g!op (code.identifier ["" " alt "])]]
     (if (list.empty? tail)
       (wrap head)
-      (wrap [(list;fold n/max (product.left head) (list;map product.left tail))
+      (wrap [(list@fold n/max (product.left head) (list@map product.left tail))
              (` (let [(~ g!op) (~ (if capturing?
                                     (` (~! |||^))
                                     (` (~! |||_^))))]
                   ($_ (~ g!op)
                       (~ (prep-alternative head))
-                      (~+ (list;map prep-alternative tail)))))]))))
+                      (~+ (list@map prep-alternative tail)))))]))))
 
 (def: (re-scoped^ current-module)
   (-> Text (l.Lexer [Re-Group Code]))
@@ -400,7 +399,6 @@
   (-> Text (l.Lexer Code))
   (:: p.monad map product.right (re-alternative^ #1 re-scoped^ current-module)))
 
-## [Syntax]
 (syntax: #export (regex {pattern s.text})
   {#.doc (doc "Create lexers using regular-expression syntax."
               "For example:"
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 6543576a2..c61891996 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -28,6 +28,9 @@
      [locale (#+)
       [language (#+)]
       [territory (#+)]]
+     [data
+      [text
+       [format (#+)]]]
      ## TODO: Test these modules
      [data
       [format
@@ -117,12 +120,6 @@
     ##   ## [semaphore (#+)]
     ##   ]]
     ## [data
-    ##  [product (#+)]
-    ##  [sum (#+)]
-    ##  [text (#+)
-    ##   ## [format (#+)]
-    ##   [lexer (#+)]
-    ##   [regex (#+)]]
     ##  [format
     ##   ## [json (#+)]
     ##   [xml (#+)]]
diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux
index 2f733d1d2..907082d99 100644
--- a/stdlib/source/test/lux/data.lux
+++ b/stdlib/source/test/lux/data.lux
@@ -9,6 +9,8 @@
    ["#." lazy]
    ["#." maybe]
    ["#." name]
+   ["#." product]
+   ["#." sum]
    [number
     ["#." i64]
     ["#." nat]
@@ -17,6 +19,9 @@
     ["#." frac]
     ["#." ratio]
     ["#." complex]]
+   ["#." text
+    ["#/." lexer]
+    ["#/." regex]]
    ])
 
 (def: #export number
@@ -31,6 +36,13 @@
       /complex.test
       ))
 
+(def: #export text
+  ($_ _.and
+      /text.test
+      /text/lexer.test
+      /text/regex.test
+      ))
+
 (def: #export test
   Test
   ($_ _.and
@@ -41,5 +53,8 @@
       /lazy.test
       /maybe.test
       /name.test
+      /product.test
+      /sum.test
       ..number
+      ..text
       ))
diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux
index 86db80d0e..5e28aaf5e 100644
--- a/stdlib/source/test/lux/data/product.lux
+++ b/stdlib/source/test/lux/data/product.lux
@@ -1,17 +1,20 @@
 (.module:
   [lux #*
-   [data
-    ["@" product]]]
-  lux/test)
+   ["_" test (#+ Test)]
+   data/text/format]
+  {1
+   ["." /]})
 
-(context: "Products"
-  ($_ seq
-      (test "Can access the sides of a pair."
-            (and (i/= +1 (@.left [+1 +2]))
-                 (i/= +2 (@.right [+1 +2]))))
-      
-      (test "Can swap the sides of a pair."
-            (let [[_left _right] (@.swap [+1 +2])]
-              (and (i/= +2 _left)
-                   (i/= +1 _right))))
-      ))
+(def: #export test
+  Test
+  (<| (_.context (%name (name-of .&)))
+      ($_ _.and
+          (_.test "Can access the sides of a pair."
+                  (and (i/= +1 (/.left [+1 +2]))
+                       (i/= +2 (/.right [+1 +2]))))
+          
+          (_.test "Can swap the sides of a pair."
+                  (let [[_left _right] (/.swap [+1 +2])]
+                    (and (i/= +2 _left)
+                         (i/= +1 _right))))
+          )))
diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux
index d47922304..2a7fa889e 100644
--- a/stdlib/source/test/lux/data/sum.lux
+++ b/stdlib/source/test/lux/data/sum.lux
@@ -1,37 +1,39 @@
 (.module:
   [lux #*
+   ["_" test (#+ Test)]
+   data/text/format
    [control
     pipe]
    [data
-    sum
     ["." text]
     [collection
      ["." list]]]]
-  lux/test)
+  {1
+   ["." /]})
 
-(context: "Sum operations"
-  (let [(^open "List/.") (list.equivalence text.equivalence)]
-    ($_ seq
-        (test "Can inject values into Either."
-              (and (|> (left "Hello") (case> (0 "Hello") #1 _ #0))
-                   (|> (right "World") (case> (1 "World") #1 _ #0))))
+(def: #export test
+  Test
+  (<| (_.context (%name (name-of .|)))
+      (let [(^open "list/.") (list.equivalence text.equivalence)]
+        ($_ _.and
+            (_.test "Can inject values into Either."
+                    (and (|> (/.left "Hello") (case> (0 "Hello") #1 _ #0))
+                         (|> (/.right "World") (case> (1 "World") #1 _ #0))))
+            (_.test "Can discriminate eithers based on their cases."
+                    (let [[_lefts _rights] (/.partition (: (List (| Text Text))
+                                                           (list (0 "0") (1 "1") (0 "2"))))]
+                      (and (list/= _lefts
+                                   (/.lefts (: (List (| Text Text))
+                                               (list (0 "0") (1 "1") (0 "2")))))
 
-        (test "Can discriminate eithers based on their cases."
-              (let [[_lefts _rights] (partition (: (List (| Text Text))
-                                                   (list (0 "+0") (1 "+1") (0 "+2"))))]
-                (and (List/= _lefts
-                             (lefts (: (List (| Text Text))
-                                       (list (0 "+0") (1 "+1") (0 "+2")))))
-
-                     (List/= _rights
-                             (rights (: (List (| Text Text))
-                                        (list (0 "+0") (1 "+1") (0 "+2"))))))))
-
-        (test "Can apply a function to an Either value depending on the case."
-              (and (i/= +10 (either (function (_ _) +10)
-                                    (function (_ _) +20)
-                                    (: (| Text Text) (0 ""))))
-                   (i/= +20 (either (function (_ _) +10)
-                                    (function (_ _) +20)
-                                    (: (| Text Text) (1 ""))))))
-        )))
+                           (list/= _rights
+                                   (/.rights (: (List (| Text Text))
+                                                (list (0 "0") (1 "1") (0 "2"))))))))
+            (_.test "Can apply a function to an Either value depending on the case."
+                    (and (n/= 10 (/.either (function (_ _) 10)
+                                           (function (_ _) 20)
+                                           (: (| Text Text) (0 ""))))
+                         (n/= 20 (/.either (function (_ _) 10)
+                                           (function (_ _) 20)
+                                           (: (| Text Text) (1 ""))))))
+            ))))
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index ea9a36fe2..e3166dcd9 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -1,143 +1,134 @@
 (.module:
   [lux #*
+   data/text/format
+   ["_" test (#+ Test)]
    [control
+    pipe
     [monad (#+ do Monad)]
-    pipe]
+    {[0 #test]
+     [/
+      ["$." equivalence]
+      ["$." order]]}]
    [data
-    ["&" text
-     format]
     [collection
      ["." list]]]
    [math
     ["r" random]]]
-  lux/test)
-
-(context: "Size"
-  (<| (times 100)
-      (do @
-        [size (:: @ map (n/% 100) r.nat)
-         sample (r.unicode size)]
-        (test "" (or (and (n/= 0 size)
-                          (&.empty? sample))
-                     (n/= size (&.size sample)))))))
+  {1
+   ["." /]})
 
 (def: bounded-size
   (r.Random Nat)
   (|> r.nat
       (:: r.monad map (|>> (n/% 20) (n/+ 1)))))
 
-(context: "Locations"
-  (<| (times 100)
-      (do @
-        [size bounded-size
-         idx (:: @ map (n/% size) r.nat)
-         sample (r.unicode size)]
-        (test "" (|> sample
-                     (&.nth idx)
-                     (case> (^multi (#.Some char)
-                                    [(&.from-code char) char]
-                                    [[(&.index-of char sample)
-                                      (&.last-index-of char sample)
-                                      (&.index-of' char idx sample)
-                                      (&.last-index-of' char idx sample)]
-                                     [(#.Some io) (#.Some lio)
-                                      (#.Some io') (#.Some lio')]])
-                            (and (n/<= idx io)
-                                 (n/>= idx lio)
-
-                                 (n/= idx io')
-                                 (n/>= idx lio')
-
-                                 (&.contains? char sample))
+(def: #export test
+  Test
+  (<| (_.context (%name (name-of .Text)))
+      ($_ _.and
+          ($equivalence.spec /.equivalence (r.ascii 2))
+          ($order.spec /.order (r.ascii 2))
 
-                            _
-                            #0
-                            ))
-              ))))
+          (do r.monad
+            [size (:: @ map (n/% 10) r.nat)
+             sample (r.unicode size)]
+            ($_ _.and
+                (_.test "Can get the size of text."
+                        (n/= size (/.size sample)))
+                (_.test "Text with size 0 is considered 'empty'."
+                        (or (not (n/= 0 size))
+                            (/.empty? sample)))))
+          (do r.monad
+            [size bounded-size
+             idx (:: @ map (n/% size) r.nat)
+             sample (r.unicode size)]
+            (_.test "Character locations."
+                    (|> sample
+                        (/.nth idx)
+                        (case> (^multi (#.Some char)
+                                       [(/.from-code char) char]
+                                       [[(/.index-of char sample)
+                                         (/.last-index-of char sample)
+                                         (/.index-of' char idx sample)
+                                         (/.last-index-of' char idx sample)]
+                                        [(#.Some io) (#.Some lio)
+                                         (#.Some io') (#.Some lio')]])
+                               (and (n/<= idx io)
+                                    (n/>= idx lio)
 
-(context: "Text functions"
-  (<| (times 100)
-      (do @
-        [sizeL bounded-size
-         sizeR bounded-size
-         sampleL (r.unicode sizeL)
-         sampleR (r.unicode sizeR)
-         #let [sample (&.concat (list sampleL sampleR))
-               fake-sample (&.join-with " " (list sampleL sampleR))
-               dup-sample (&.join-with "" (list sampleL sampleR))
-               enclosed-sample (&.enclose [sampleR sampleR] sampleL)
-               (^open ".") &.equivalence]]
-        (test "" (and (not (= sample fake-sample))
-                      (= sample dup-sample)
-                      (&.starts-with? sampleL sample)
-                      (&.ends-with? sampleR sample)
-                      (= enclosed-sample
-                         (&.enclose' sampleR sampleL))
-                      
-                      (|> (&.split sizeL sample)
-                          (case> (#.Right [_l _r])
-                                 (and (= sampleL _l)
-                                      (= sampleR _r)
-                                      (= sample (&.concat (list _l _r))))
+                                    (n/= idx io')
+                                    (n/>= idx lio')
 
-                                 _
-                                 #0))
-                      
-                      (|> [(&.clip 0 sizeL sample)
-                           (&.clip sizeL (&.size sample) sample)
-                           (&.clip' sizeL sample)
-                           (&.clip' 0 sample)]
-                          (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)]
-                                 (and (= sampleL _l)
-                                      (= sampleR _r)
-                                      (= _r _r')
-                                      (= sample _f))
+                                    (/.contains? char sample))
 
-                                 _
-                                 #0))
-                      )
-              ))))
+                               _
+                               #0
+                               ))
+                    ))
+          (do r.monad
+            [sizeL bounded-size
+             sizeR bounded-size
+             sampleL (r.unicode sizeL)
+             sampleR (r.unicode sizeR)
+             #let [sample (/.concat (list sampleL sampleR))
+                   (^open "/@.") /.equivalence]]
+            ($_ _.and
+                (_.test "Can join text snippets."
+                        (and (not (/@= sample
+                                       (/.join-with " " (list sampleL sampleR))))
+                             (/@= sample
+                                  (/.join-with "" (list sampleL sampleR)))))
+                (_.test "Can check sub-texts at the borders."
+                        (and (/.starts-with? sampleL sample)
+                             (/.ends-with? sampleR sample)))
+                (_.test "Can enclose text in another texts."
+                        (/@= (/.enclose [sampleR sampleR] sampleL)
+                             (/.enclose' sampleR sampleL)))
+                (_.test "Can split text."
+                        (|> (/.split sizeL sample)
+                            (case> (#.Right [_l _r])
+                                   (and (/@= sampleL _l)
+                                        (/@= sampleR _r)
+                                        (/@= sample (/.concat (list _l _r))))
 
-(context: "More text functions"
-  (<| (times 100)
-      (do @
-        [sizeP bounded-size
-         sizeL bounded-size
-         #let [## The wider unicode charset includes control characters that
-               ## can make text replacement work improperly.
-               ## Because of that, I restrict the charset.
-               normal-char-gen (|> r.nat (:: @ map (|>> (n/% 128) (n/max 1))))]
-         sep1 (r.text normal-char-gen 1)
-         sep2 (r.text normal-char-gen 1)
-         #let [part-gen (|> (r.text normal-char-gen sizeP)
-                            (r.filter (|>> (&.contains? sep1) not)))]
-         parts (r.list sizeL part-gen)
-         #let [sample1 (&.concat (list.interpose sep1 parts))
-               sample2 (&.concat (list.interpose sep2 parts))
-               (^open "&;.") &.equivalence]]
-        ($_ seq
-            (test "Can split text through a separator."
-                  (n/= (list.size parts)
-                       (list.size (&.split-all-with sep1 sample1))))
+                                   _
+                                   #0)))
+                (_.test "Can clip text."
+                        (|> [(/.clip 0 sizeL sample)
+                             (/.clip sizeL (/.size sample) sample)
+                             (/.clip' sizeL sample)
+                             (/.clip' 0 sample)]
+                            (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)]
+                                   (and (/@= sampleL _l)
+                                        (/@= sampleR _r)
+                                        (/@= _r _r')
+                                        (/@= sample _f))
 
-            (test "Can replace occurrences of a piece of text inside a larger text."
-                  (&;= sample2
-                       (&.replace-all sep1 sep2 sample1)))
-            ))))
+                                   _
+                                   #0)))
+                ))
+          (do r.monad
+            [sizeP bounded-size
+             sizeL bounded-size
+             #let [## The wider unicode charset includes control characters that
+                   ## can make text replacement work improperly.
+                   ## Because of that, I restrict the charset.
+                   normal-char-gen (|> r.nat (:: @ map (|>> (n/% 128) (n/max 1))))]
+             sep1 (r.text normal-char-gen 1)
+             sep2 (r.text normal-char-gen 1)
+             #let [part-gen (|> (r.text normal-char-gen sizeP)
+                                (r.filter (|>> (/.contains? sep1) not)))]
+             parts (r.list sizeL part-gen)
+             #let [sample1 (/.concat (list.interpose sep1 parts))
+                   sample2 (/.concat (list.interpose sep2 parts))
+                   (^open "/@.") /.equivalence]]
+            ($_ _.and
+                (_.test "Can split text multiple times through a separator."
+                        (n/= (list.size parts)
+                             (list.size (/.split-all-with sep1 sample1))))
 
-(context: "Structures"
-  (let [(^open "&;.") &.order]
-    ($_ seq
-        (test "" (&;< "bcd" "abc"))
-        (test "" (not (&;< "abc" "abc")))
-        (test "" (not (&;< "abc" "bcd")))
-        (test "" (&;<= "bcd" "abc"))
-        (test "" (&;<= "abc" "abc"))
-        (test "" (not (&;<= "abc" "bcd")))
-        (test "" (&;> "abc" "bcd"))
-        (test "" (not (&;> "abc" "abc")))
-        (test "" (not (&;> "bcd" "abc")))
-        (test "" (&;>= "abc" "bcd"))
-        (test "" (&;>= "abc" "abc"))
-        (test "" (not (&;>= "bcd" "abc")))
-        )))
+                (_.test "Can replace occurrences of a piece of text inside a larger text."
+                        (/@= sample2
+                             (/.replace-all sep1 sep2 sample1)))
+                ))
+          )))
diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux
deleted file mode 100644
index 1a7ab01cf..000000000
--- a/stdlib/source/test/lux/data/text/format.lux
+++ /dev/null
@@ -1,21 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ Monad do)]]
-   [data
-    ["." text
-     format]]]
-  lux/test)
-
-(context: "Formatters"
-  (let [(^open "&;.") text.equivalence]
-    ($_ seq
-        (test "Can format common values simply."
-              (and (&;= "#1" (%b #1))
-                   (&;= "123" (%n 123))
-                   (&;= "+123" (%i +123))
-                   (&;= "+123.456" (%f +123.456))
-                   (&;= ".5" (%r .5))
-                   (&;= (format text.double-quote "YOLO" text.double-quote) (%t "YOLO"))
-                   (&;= "User-id: +123 -- Active: #1" (format "User-id: " (%i +123) " -- Active: " (%b #1)))))
-        )))
diff --git a/stdlib/source/test/lux/data/text/lexer.lux b/stdlib/source/test/lux/data/text/lexer.lux
index 77419362a..b15a86846 100644
--- a/stdlib/source/test/lux/data/text/lexer.lux
+++ b/stdlib/source/test/lux/data/text/lexer.lux
@@ -1,205 +1,171 @@
 (.module:
   [lux #*
+   data/text/format
+   ["_" test (#+ Test)]
    [control
-    [monad (#+ do Monad)]
     pipe
+    [monad (#+ do Monad)]
     ["p" parser]]
    [data
     ["." error (#+ Error)]
-    ["." text ("#;." equivalence)
-     format
-     ["&" lexer]]
+    ["." text ("#@." equivalence)]
     [collection
      ["." list]]]
    [math
     ["r" random]]]
-  lux/test)
+  {1
+   ["." /]})
 
-## [Utils]
 (def: (should-fail input)
   (All [a] (-> (Error a) Bit))
   (case input
-    (#.Left _) #1
-    _          #0))
-
-(def: (should-passT test input)
-  (-> Text (Error Text) Bit)
-  (case input
-    (#.Right output)
-    (text;= test output)
+    (#error.Failure _)
+    true
     
     _
-    #0))
-
-(def: (should-passL test input)
-  (-> (List Text) (Error (List Text)) Bit)
-  (let [(^open "list;.") (list.equivalence text.equivalence)]
-    (case input
-      (#.Right output)
-      (list;= test output)
-      
-      _
-      #0)))
-
-(def: (should-passE test input)
-  (-> (Either Text Text) (Error (Either Text Text)) Bit)
-  (case input
-    (#.Right output)
-    (case [test output]
-      [(#.Left test) (#.Left output)]
-      (text;= test output)
-
-      [(#.Right test) (#.Right output)]
-      (text;= test output)
-
-      _
-      #0)
-    
-    _
-    #0))
-
-## [Tests]
-(context: "End"
-  ($_ seq
-      (test "Can detect the end of the input."
-            (|> (&.run ""
-                       &.end)
-                (case> (#.Right _) #1 _ #0)))
-      
-      (test "Won't mistake non-empty text for no more input."
-            (|> (&.run "YOLO"
-                       &.end)
-                (case> (#.Left _) #1 _ #0)))
-      ))
+    false))
 
-(context: "Literals"
-  (<| (times 100)
-      (do @
-        [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
-         sample (r.unicode size)
-         non-sample (|> (r.unicode size)
-                        (r.filter (|>> (text;= sample) not)))]
-        ($_ seq
-            (test "Can find literal text fragments."
-                  (and (|> (&.run sample
-                                  (&.this sample))
-                           (case> (#.Right []) #1 _ #0))
-                       (|> (&.run non-sample
-                                  (&.this sample))
-                           (case> (#.Left _) #1 _ #0))))
-            ))))
-
-(context: "Custom lexers"
-  ($_ seq
-      (test "Can lex anything"
-            (and (should-passT "A" (&.run "A"
-                                          &.any))
-                 (should-fail (&.run ""
-                                     &.any))))
-
-      (test "Can lex characters ranges."
-            (and (should-passT "Y" (&.run "Y"
-                                          (&.range (char "X") (char "Z"))))
-                 (should-fail (&.run "M"
-                                     (&.range (char "X") (char "Z"))))))
-      
-      (test "Can lex upper-case and lower-case letters."
-            (and (should-passT "Y" (&.run "Y"
-                                          &.upper))
-                 (should-fail (&.run "m"
-                                     &.upper))
-                 
-                 (should-passT "y" (&.run "y"
-                                          &.lower))
-                 (should-fail (&.run "M"
-                                     &.lower))))
-
-      (test "Can lex numbers."
-            (and (should-passT "1" (&.run "1"
-                                          &.decimal))
-                 (should-fail (&.run " "
-                                     &.decimal))
-
-                 (should-passT "7" (&.run "7"
-                                          &.octal))
-                 (should-fail (&.run "8"
-                                     &.octal))
-
-                 (should-passT "1" (&.run "1"
-                                          &.hexadecimal))
-                 (should-passT "a" (&.run "a"
-                                          &.hexadecimal))
-                 (should-passT "A" (&.run "A"
-                                          &.hexadecimal))
-                 (should-fail (&.run " "
-                                     &.hexadecimal))
-                 ))
-
-      (test "Can lex alphabetic characters."
-            (and (should-passT "A" (&.run "A"
-                                          &.alpha))
-                 (should-passT "a" (&.run "a"
-                                          &.alpha))
-                 (should-fail (&.run "1"
-                                     &.alpha))))
-
-      (test "Can lex alphanumeric characters."
-            (and (should-passT "A" (&.run "A"
-                                          &.alpha-num))
-                 (should-passT "a" (&.run "a"
-                                          &.alpha-num))
-                 (should-passT "1" (&.run "1"
-                                          &.alpha-num))
-                 (should-fail (&.run " "
-                                     &.alpha-num))))
-
-      (test "Can lex white-space."
-            (and (should-passT " " (&.run " "
-                                          &.space))
-                 (should-fail (&.run "8"
-                                     &.space))))
-      ))
-
-(context: "Combinators"
-  ($_ seq
-      (test "Can combine lexers sequentially."
-            (and (|> (&.run "YO"
-                            (p.and &.any &.any))
-                     (case> (#.Right ["Y" "O"]) #1
-                            _ #0))
-                 (should-fail (&.run "Y"
-                                     (p.and &.any &.any)))))
-      
-      (test "Can create the opposite of a lexer."
-            (and (should-passT "a" (&.run "a"
-                                          (&.not (p.or &.decimal &.upper))))
-                 (should-fail (&.run "A"
-                                     (&.not (p.or &.decimal &.upper))))))
-      
-      (test "Can select from among a set of characters."
-            (and (should-passT "C" (&.run "C"
-                                          (&.one-of "ABC")))
-                 (should-fail (&.run "D"
-                                     (&.one-of "ABC")))))
-
-      (test "Can avoid a set of characters."
-            (and (should-passT "D" (&.run "D"
-                                          (&.none-of "ABC")))
-                 (should-fail (&.run "C"
-                                     (&.none-of "ABC")))))
-      
-      (test "Can lex using arbitrary predicates."
-            (and (should-passT "D" (&.run "D"
-                                          (&.satisfies (function (_ c) #1))))
-                 (should-fail (&.run "C"
-                                     (&.satisfies (function (_ c) #0))))))
-      
-      (test "Can apply a lexer multiple times."
-            (and (should-passT "0123456789ABCDEF" (&.run "0123456789ABCDEF"
-                                                         (&.many &.hexadecimal)))
-                 (should-fail (&.run "yolo"
-                                     (&.many &.hexadecimal)))
-
-                 (should-passT "" (&.run ""
-                                         (&.some &.hexadecimal)))))
-      ))
+(def: (should-pass reference sample)
+  (-> Text (Error Text) Bit)
+  (|> sample
+      (:: error.functor map (text@= reference))
+      (error.default false)))
+
+(def: #export test
+  Test
+  (<| (_.context (%name (name-of /.Lexer)))
+      ($_ _.and
+          (_.test "Can detect the end of the input."
+                  (|> (/.run ""
+                             /.end)
+                      (case> (#.Right _) true _ false)))
+          (do r.monad
+            [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))
+             sample (r.unicode size)
+             non-sample (|> (r.unicode size)
+                            (r.filter (|>> (text@= sample) not)))]
+            ($_ _.and
+                (_.test "Won't mistake non-empty text for no more input."
+                        (|> (/.run sample
+                                   /.end)
+                            (case> (#.Left _) true _ false)))
+                (_.test "Can find literal text fragments."
+                        (and (|> (/.run sample
+                                        (/.this sample))
+                                 (case> (#.Right []) true _ false))
+                             (|> (/.run non-sample
+                                        (/.this sample))
+                                 (case> (#.Left _) true _ false))))
+                ))
+          ($_ _.and
+              (_.test "Can lex anything"
+                      (and (should-pass "A" (/.run "A"
+                                                   /.any))
+                           (should-fail (/.run ""
+                                               /.any))))
+
+              (_.test "Can lex characters ranges."
+                      (and (should-pass "Y" (/.run "Y"
+                                                   (/.range (char "X") (char "Z"))))
+                           (should-fail (/.run "M"
+                                               (/.range (char "X") (char "Z"))))))
+              
+              (_.test "Can lex upper-case and lower-case letters."
+                      (and (should-pass "Y" (/.run "Y"
+                                                   /.upper))
+                           (should-fail (/.run "m"
+                                               /.upper))
+                           
+                           (should-pass "y" (/.run "y"
+                                                   /.lower))
+                           (should-fail (/.run "M"
+                                               /.lower))))
+
+              (_.test "Can lex numbers."
+                      (and (should-pass "1" (/.run "1"
+                                                   /.decimal))
+                           (should-fail (/.run " "
+                                               /.decimal))
+
+                           (should-pass "7" (/.run "7"
+                                                   /.octal))
+                           (should-fail (/.run "8"
+                                               /.octal))
+
+                           (should-pass "1" (/.run "1"
+                                                   /.hexadecimal))
+                           (should-pass "a" (/.run "a"
+                                                   /.hexadecimal))
+                           (should-pass "A" (/.run "A"
+                                                   /.hexadecimal))
+                           (should-fail (/.run " "
+                                               /.hexadecimal))
+                           ))
+
+              (_.test "Can lex alphabetic characters."
+                      (and (should-pass "A" (/.run "A"
+                                                   /.alpha))
+                           (should-pass "a" (/.run "a"
+                                                   /.alpha))
+                           (should-fail (/.run "1"
+                                               /.alpha))))
+
+              (_.test "Can lex alphanumeric characters."
+                      (and (should-pass "A" (/.run "A"
+                                                   /.alpha-num))
+                           (should-pass "a" (/.run "a"
+                                                   /.alpha-num))
+                           (should-pass "1" (/.run "1"
+                                                   /.alpha-num))
+                           (should-fail (/.run " "
+                                               /.alpha-num))))
+
+              (_.test "Can lex white-space."
+                      (and (should-pass " " (/.run " "
+                                                   /.space))
+                           (should-fail (/.run "8"
+                                               /.space))))
+              )
+          ($_ _.and
+              (_.test "Can combine lexers sequentially."
+                      (and (|> (/.run "YO"
+                                      (p.and /.any /.any))
+                               (case> (#.Right ["Y" "O"]) true
+                                      _ false))
+                           (should-fail (/.run "Y"
+                                               (p.and /.any /.any)))))
+              
+              (_.test "Can create the opposite of a lexer."
+                      (and (should-pass "a" (/.run "a"
+                                                   (/.not (p.or /.decimal /.upper))))
+                           (should-fail (/.run "A"
+                                               (/.not (p.or /.decimal /.upper))))))
+              
+              (_.test "Can select from among a set of characters."
+                      (and (should-pass "C" (/.run "C"
+                                                   (/.one-of "ABC")))
+                           (should-fail (/.run "D"
+                                               (/.one-of "ABC")))))
+
+              (_.test "Can avoid a set of characters."
+                      (and (should-pass "D" (/.run "D"
+                                                   (/.none-of "ABC")))
+                           (should-fail (/.run "C"
+                                               (/.none-of "ABC")))))
+              
+              (_.test "Can lex using arbitrary predicates."
+                      (and (should-pass "D" (/.run "D"
+                                                   (/.satisfies (function (_ c) true))))
+                           (should-fail (/.run "C"
+                                               (/.satisfies (function (_ c) false))))))
+              
+              (_.test "Can apply a lexer multiple times."
+                      (and (should-pass "0123456789ABCDEF" (/.run "0123456789ABCDEF"
+                                                                  (/.many /.hexadecimal)))
+                           (should-fail (/.run "yolo"
+                                               (/.many /.hexadecimal)))
+
+                           (should-pass "" (/.run ""
+                                                  (/.some /.hexadecimal)))))
+              )
+          )))
diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux
index ffa5612da..059adff84 100644
--- a/stdlib/source/test/lux/data/text/regex.lux
+++ b/stdlib/source/test/lux/data/text/regex.lux
@@ -1,36 +1,36 @@
 (.module:
   [lux #*
+   data/text/format
+   ["_" test (#+ Test)]
    [control
     [monad (#+ do Monad)]
     pipe
     ["p" parser]]
    [data
     [number (#+ hex)]
-    ["." text ("#;." equivalence)
-     format
-     ["." lexer (#+ Lexer)]
-     ["&" regex]]]
+    ["." text ("#@." equivalence)
+     ["." lexer (#+ Lexer)]]]
    [math
     ["r" random]]
    [macro
     ["s" syntax (#+ syntax:)]]]
-  lux/test)
+  {1
+   ["." /]})
 
-## [Utils]
 (def: (should-pass regex input)
   (-> (Lexer Text) Text Bit)
   (|> (lexer.run input regex)
       (case> (#.Right parsed)
-             (text;= parsed input)
+             (text@= parsed input)
 
              _
              #0)))
 
-(def: (should-passT test regex input)
+(def: (text-should-pass test regex input)
   (-> Text (Lexer Text) Text Bit)
   (|> (lexer.run input regex)
       (case> (#.Right parsed)
-             (text;= test parsed)
+             (text@= test parsed)
 
              _
              #0)))
@@ -48,239 +48,243 @@
                             (~' _)
                             #0))))))
 
-## [Tests]
-(context: "Regular Expressions [Basics]"
-  (test "Can parse character literals."
-        (and (should-pass (&.regex "a") "a")
-             (should-fail (&.regex "a") ".")
-             (should-pass (&.regex "\.") ".")
-             (should-fail (&.regex "\.") "a"))))
-
-(context: "Regular Expressions [System character classes]"
-  ($_ seq
-      (test "Can parse anything."
-            (should-pass (&.regex ".") "a"))
-
-      (test "Can parse digits."
-            (and (should-pass (&.regex "\d") "0")
-                 (should-fail (&.regex "\d") "m")))
-
-      (test "Can parse non digits."
-            (and (should-pass (&.regex "\D") "m")
-                 (should-fail (&.regex "\D") "0")))
-
-      (test "Can parse white-space."
-            (and (should-pass (&.regex "\s") " ")
-                 (should-fail (&.regex "\s") "m")))
-
-      (test "Can parse non white-space."
-            (and (should-pass (&.regex "\S") "m")
-                 (should-fail (&.regex "\S") " ")))
-
-      (test "Can parse word characters."
-            (and (should-pass (&.regex "\w") "_")
-                 (should-fail (&.regex "\w") "^")))
-
-      (test "Can parse non word characters."
-            (and (should-pass (&.regex "\W") ".")
-                 (should-fail (&.regex "\W") "a")))
+(def: basics
+  Test
+  (_.test "Can parse character literals."
+          (and (should-pass (/.regex "a") "a")
+               (should-fail (/.regex "a") ".")
+               (should-pass (/.regex "\.") ".")
+               (should-fail (/.regex "\.") "a"))))
+
+(def: system-character-classes
+  Test
+  ($_ _.and
+      (_.test "Can parse anything."
+              (should-pass (/.regex ".") "a"))
+
+      (_.test "Can parse digits."
+              (and (should-pass (/.regex "\d") "0")
+                   (should-fail (/.regex "\d") "m")))
+
+      (_.test "Can parse non digits."
+              (and (should-pass (/.regex "\D") "m")
+                   (should-fail (/.regex "\D") "0")))
+
+      (_.test "Can parse white-space."
+              (and (should-pass (/.regex "\s") " ")
+                   (should-fail (/.regex "\s") "m")))
+
+      (_.test "Can parse non white-space."
+              (and (should-pass (/.regex "\S") "m")
+                   (should-fail (/.regex "\S") " ")))
+
+      (_.test "Can parse word characters."
+              (and (should-pass (/.regex "\w") "_")
+                   (should-fail (/.regex "\w") "^")))
+
+      (_.test "Can parse non word characters."
+              (and (should-pass (/.regex "\W") ".")
+                   (should-fail (/.regex "\W") "a")))
       ))
 
-(context: "Regular Expressions [Special system character classes : Part 1]"
-  ($_ seq
-      (test "Can parse using special character classes."
-            (and (and (should-pass (&.regex "\p{Lower}") "m")
-                      (should-fail (&.regex "\p{Lower}") "M"))
-
-                 (and (should-pass (&.regex "\p{Upper}") "M")
-                      (should-fail (&.regex "\p{Upper}") "m"))
-
-                 (and (should-pass (&.regex "\p{Alpha}") "M")
-                      (should-fail (&.regex "\p{Alpha}") "0"))
-
-                 (and (should-pass (&.regex "\p{Digit}") "1")
-                      (should-fail (&.regex "\p{Digit}") "n"))
-
-                 (and (should-pass (&.regex "\p{Alnum}") "1")
-                      (should-fail (&.regex "\p{Alnum}") "."))
-
-                 (and (should-pass (&.regex "\p{Space}") " ")
-                      (should-fail (&.regex "\p{Space}") "."))
-                 ))
-      ))
-
-(context: "Regular Expressions [Special system character classes : Part 2]"
-  ($_ seq
-      (test "Can parse using special character classes."
-            (and (and (should-pass (&.regex "\p{HexDigit}") "a")
-                      (should-fail (&.regex "\p{HexDigit}") "."))
-
-                 (and (should-pass (&.regex "\p{OctDigit}") "6")
-                      (should-fail (&.regex "\p{OctDigit}") "."))
-
-                 (and (should-pass (&.regex "\p{Blank}") text.tab)
-                      (should-fail (&.regex "\p{Blank}") "."))
-
-                 (and (should-pass (&.regex "\p{ASCII}") text.tab)
-                      (should-fail (&.regex "\p{ASCII}") (text.from-code (hex "1234"))))
-
-                 (and (should-pass (&.regex "\p{Contrl}") (text.from-code (hex "12")))
-                      (should-fail (&.regex "\p{Contrl}") "a"))
-
-                 (and (should-pass (&.regex "\p{Punct}") "@")
-                      (should-fail (&.regex "\p{Punct}") "a"))
-
-                 (and (should-pass (&.regex "\p{Graph}") "@")
-                      (should-fail (&.regex "\p{Graph}") " "))
-
-                 (and (should-pass (&.regex "\p{Print}") (text.from-code (hex "20")))
-                      (should-fail (&.regex "\p{Print}") (text.from-code (hex "1234"))))
-                 ))
-      ))
-
-(context: "Regular Expressions [Custom character classes : Part 1]"
-  ($_ seq
-      (test "Can parse using custom character classes."
-            (and (should-pass (&.regex "[abc]") "a")
-                 (should-fail (&.regex "[abc]") "m")))
-
-      (test "Can parse using character ranges."
-            (and (should-pass (&.regex "[a-z]") "a")
-                 (should-pass (&.regex "[a-z]") "m")
-                 (should-pass (&.regex "[a-z]") "z")))
-
-      (test "Can combine character ranges."
-            (and (should-pass (&.regex "[a-zA-Z]") "a")
-                 (should-pass (&.regex "[a-zA-Z]") "m")
-                 (should-pass (&.regex "[a-zA-Z]") "z")
-                 (should-pass (&.regex "[a-zA-Z]") "A")
-                 (should-pass (&.regex "[a-zA-Z]") "M")
-                 (should-pass (&.regex "[a-zA-Z]") "Z")))
-      ))
-
-(context: "Regular Expressions [Custom character classes : Part 2]"
-  ($_ seq
-      (test "Can negate custom character classes."
-            (and (should-fail (&.regex "[^abc]") "a")
-                 (should-pass (&.regex "[^abc]") "m")))
-
-      (test "Can negate character ranges.."
-            (and (should-fail (&.regex "[^a-z]") "a")
-                 (should-pass (&.regex "[^a-z]") "0")))
-
-      (test "Can parse negate combinations of character ranges."
-            (and (should-fail (&.regex "[^a-zA-Z]") "a")
-                 (should-pass (&.regex "[^a-zA-Z]") "0")))
+(def: special-system-character-classes
+  Test
+  ($_ _.and
+      (_.test "Lower-case."
+              (and (should-pass (/.regex "\p{Lower}") "m")
+                   (should-fail (/.regex "\p{Lower}") "M")))
+      (_.test "Upper-case."
+              (and (should-pass (/.regex "\p{Upper}") "M")
+                   (should-fail (/.regex "\p{Upper}") "m")))
+      (_.test "Alphabetic."
+              (and (should-pass (/.regex "\p{Alpha}") "M")
+                   (should-fail (/.regex "\p{Alpha}") "0")))
+      (_.test "Numeric digits."
+              (and (should-pass (/.regex "\p{Digit}") "1")
+                   (should-fail (/.regex "\p{Digit}") "n")))
+      (_.test "Alphanumeric."
+              (and (should-pass (/.regex "\p{Alnum}") "1")
+                   (should-fail (/.regex "\p{Alnum}") ".")))
+      (_.test "Whitespace."
+              (and (should-pass (/.regex "\p{Space}") " ")
+                   (should-fail (/.regex "\p{Space}") ".")))
+      (_.test "Hexadecimal."
+              (and (should-pass (/.regex "\p{HexDigit}") "a")
+                   (should-fail (/.regex "\p{HexDigit}") ".")))
+      (_.test "Octal."
+              (and (should-pass (/.regex "\p{OctDigit}") "6")
+                   (should-fail (/.regex "\p{OctDigit}") ".")))
+      (_.test "Blank."
+              (and (should-pass (/.regex "\p{Blank}") text.tab)
+                   (should-fail (/.regex "\p{Blank}") ".")))
+      (_.test "ASCII."
+              (and (should-pass (/.regex "\p{ASCII}") text.tab)
+                   (should-fail (/.regex "\p{ASCII}") (text.from-code (hex "1234")))))
+      (_.test "Control characters."
+              (and (should-pass (/.regex "\p{Contrl}") (text.from-code (hex "12")))
+                   (should-fail (/.regex "\p{Contrl}") "a")))
+      (_.test "Punctuation."
+              (and (should-pass (/.regex "\p{Punct}") "@")
+                   (should-fail (/.regex "\p{Punct}") "a")))
+      (_.test "Graph."
+              (and (should-pass (/.regex "\p{Graph}") "@")
+                   (should-fail (/.regex "\p{Graph}") " ")))
+      (_.test "Print."
+              (and (should-pass (/.regex "\p{Print}") (text.from-code (hex "20")))
+                   (should-fail (/.regex "\p{Print}") (text.from-code (hex "1234")))))
       ))
 
-(context: "Regular Expressions [Custom character classes : Part 3]"
-  ($_ seq
-      (test "Can make custom character classes more specific."
-            (and (let [RE (&.regex "[a-z&&[def]]")]
-                   (and (should-fail RE "a")
-                        (should-pass RE "d")))
-
-                 (let [RE (&.regex "[a-z&&[^bc]]")]
-                   (and (should-pass RE "a")
-                        (should-fail RE "b")))
-
-                 (let [RE (&.regex "[a-z&&[^m-p]]")]
-                   (and (should-pass RE "a")
-                        (should-fail RE "m")
-                        (should-fail RE "p")))))
+(def: custom-character-classes
+  Test
+  ($_ _.and
+      (_.test "Can parse using custom character classes."
+              (and (should-pass (/.regex "[abc]") "a")
+                   (should-fail (/.regex "[abc]") "m")))
+      (_.test "Can parse using character ranges."
+              (and (should-pass (/.regex "[a-z]") "a")
+                   (should-pass (/.regex "[a-z]") "m")
+                   (should-pass (/.regex "[a-z]") "z")))
+      (_.test "Can combine character ranges."
+              (and (should-pass (/.regex "[a-zA-Z]") "a")
+                   (should-pass (/.regex "[a-zA-Z]") "m")
+                   (should-pass (/.regex "[a-zA-Z]") "z")
+                   (should-pass (/.regex "[a-zA-Z]") "A")
+                   (should-pass (/.regex "[a-zA-Z]") "M")
+                   (should-pass (/.regex "[a-zA-Z]") "Z")))
+      (_.test "Can negate custom character classes."
+              (and (should-fail (/.regex "[^abc]") "a")
+                   (should-pass (/.regex "[^abc]") "m")))
+      (_.test "Can negate character ranges.."
+              (and (should-fail (/.regex "[^a-z]") "a")
+                   (should-pass (/.regex "[^a-z]") "0")))
+      (_.test "Can parse negate combinations of character ranges."
+              (and (should-fail (/.regex "[^a-zA-Z]") "a")
+                   (should-pass (/.regex "[^a-zA-Z]") "0")))
+      (_.test "Can make custom character classes more specific."
+              (and (let [RE (/.regex "[a-z&&[def]]")]
+                     (and (should-fail RE "a")
+                          (should-pass RE "d")))
+                   (let [RE (/.regex "[a-z&&[^bc]]")]
+                     (and (should-pass RE "a")
+                          (should-fail RE "b")))
+                   (let [RE (/.regex "[a-z&&[^m-p]]")]
+                     (and (should-pass RE "a")
+                          (should-fail RE "m")
+                          (should-fail RE "p")))))
       ))
 
-(context: "Regular Expressions [Reference]"
-  (let [number (&.regex "\d+")]
-    (test "Can build complex regexs by combining simpler ones."
-          (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789"))))
-
-(context: "Regular Expressions [Fuzzy Quantifiers]"
-  ($_ seq
-      (test "Can sequentially combine patterns."
-            (should-passT "aa" (&.regex "aa") "aa"))
-
-      (test "Can match patterns optionally."
-            (and (should-passT "a" (&.regex "a?") "a")
-                 (should-passT "" (&.regex "a?") "")))
-
-      (test "Can match a pattern 0 or more times."
-            (and (should-passT "aaa" (&.regex "a*") "aaa")
-                 (should-passT "" (&.regex "a*") "")))
-
-      (test "Can match a pattern 1 or more times."
-            (and (should-passT "aaa" (&.regex "a+") "aaa")
-                 (should-passT "a" (&.regex "a+") "a")
-                 (should-fail (&.regex "a+") "")))
+(def: references
+  Test
+  (let [number (/.regex "\d+")]
+    (_.test "Can build complex regexs by combining simpler ones."
+            (should-check ["809-345-6789" "809" "345" "6789"] (/.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789"))))
+
+(def: fuzzy-quantifiers
+  Test
+  ($_ _.and
+      (_.test "Can sequentially combine patterns."
+              (text-should-pass "aa" (/.regex "aa") "aa"))
+
+      (_.test "Can match patterns optionally."
+              (and (text-should-pass "a" (/.regex "a?") "a")
+                   (text-should-pass "" (/.regex "a?") "")))
+
+      (_.test "Can match a pattern 0 or more times."
+              (and (text-should-pass "aaa" (/.regex "a*") "aaa")
+                   (text-should-pass "" (/.regex "a*") "")))
+
+      (_.test "Can match a pattern 1 or more times."
+              (and (text-should-pass "aaa" (/.regex "a+") "aaa")
+                   (text-should-pass "a" (/.regex "a+") "a")
+                   (should-fail (/.regex "a+") "")))
       ))
 
-(context: "Regular Expressions [Crisp Quantifiers]"
-  ($_ seq
-      (test "Can match a pattern N times."
-            (and (should-passT "aa" (&.regex "a{2}") "aa")
-                 (should-passT "a" (&.regex "a{1}") "a")
-                 (should-fail (&.regex "a{3}") "aa")))
-
-      (test "Can match a pattern at-least N times."
-            (and (should-passT "aa" (&.regex "a{1,}") "aa")
-                 (should-passT "aa" (&.regex "a{2,}") "aa")
-                 (should-fail (&.regex "a{3,}") "aa")))
-
-      (test "Can match a pattern at-most N times."
-            (and (should-passT "aa" (&.regex "a{,2}") "aa")
-                 (should-passT "aa" (&.regex "a{,3}") "aa")))
-
-      (test "Can match a pattern between N and M times."
-            (and (should-passT "a" (&.regex "a{1,2}") "a")
-                 (should-passT "aa" (&.regex "a{1,2}") "aa")))
+(def: crisp-quantifiers
+  Test
+  ($_ _.and
+      (_.test "Can match a pattern N times."
+              (and (text-should-pass "aa" (/.regex "a{2}") "aa")
+                   (text-should-pass "a" (/.regex "a{1}") "a")
+                   (should-fail (/.regex "a{3}") "aa")))
+
+      (_.test "Can match a pattern at-least N times."
+              (and (text-should-pass "aa" (/.regex "a{1,}") "aa")
+                   (text-should-pass "aa" (/.regex "a{2,}") "aa")
+                   (should-fail (/.regex "a{3,}") "aa")))
+
+      (_.test "Can match a pattern at-most N times."
+              (and (text-should-pass "aa" (/.regex "a{,2}") "aa")
+                   (text-should-pass "aa" (/.regex "a{,3}") "aa")))
+
+      (_.test "Can match a pattern between N and M times."
+              (and (text-should-pass "a" (/.regex "a{1,2}") "a")
+                   (text-should-pass "aa" (/.regex "a{1,2}") "aa")))
       ))
 
-(context: "Regular Expressions [Groups]"
-  ($_ seq
-      (test "Can extract groups of sub-matches specified in a pattern."
-            (and (should-check ["abc" "b"] (&.regex "a(.)c") "abc")
-                 (should-check ["abbbbbc" "bbbbb"] (&.regex "a(b+)c") "abbbbbc")
-                 (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789")
-                 (should-check ["809-345-6789" "809" "6789"] (&.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789")
-                 (should-check ["809-809-6789" "809" "6789"] (&.regex "(\d{3})-\0-(\d{4})") "809-809-6789")
-                 (should-check ["809-809-6789" "809" "6789"] (&.regex "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789")
-                 (should-check ["809-809-6789-6789" "809" "6789"] (&.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789")))
-
-      (test "Can specify groups within groups."
-            (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789"))
+(def: groups
+  Test
+  ($_ _.and
+      (_.test "Can extract groups of sub-matches specified in a pattern."
+              (and (should-check ["abc" "b"] (/.regex "a(.)c") "abc")
+                   (should-check ["abbbbbc" "bbbbb"] (/.regex "a(b+)c") "abbbbbc")
+                   (should-check ["809-345-6789" "809" "345" "6789"] (/.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789")
+                   (should-check ["809-345-6789" "809" "6789"] (/.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789")
+                   (should-check ["809-809-6789" "809" "6789"] (/.regex "(\d{3})-\0-(\d{4})") "809-809-6789")
+                   (should-check ["809-809-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789")
+                   (should-check ["809-809-6789-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789")))
+
+      (_.test "Can specify groups within groups."
+              (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (/.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789"))
       ))
 
-(context: "Regular Expressions [Alternation]"
-  ($_ seq
-      (test "Can specify alternative patterns."
-            (and (should-check ["a" (0 [])] (&.regex "a|b") "a")
-                 (should-check ["b" (1 [])] (&.regex "a|b") "b")
-                 (should-fail (&.regex "a|b") "c")))
-
-      (test "Can have groups within alternations."
-            (and (should-check ["abc" (0 ["b" "c"])] (&.regex "a(.)(.)|b(.)(.)") "abc")
-                 (should-check ["bcd" (1 ["c" "d"])] (&.regex "a(.)(.)|b(.)(.)") "bcd")
-                 (should-fail (&.regex "a(.)(.)|b(.)(.)") "cde")
-
-                 (should-check ["809-345-6789" (0 ["809" "345-6789" "345" "6789"])]
-                               (&.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d")
-                               "809-345-6789")))
+(def: alternation
+  Test
+  ($_ _.and
+      (_.test "Can specify alternative patterns."
+              (and (should-check ["a" (0 [])] (/.regex "a|b") "a")
+                   (should-check ["b" (1 [])] (/.regex "a|b") "b")
+                   (should-fail (/.regex "a|b") "c")))
+
+      (_.test "Can have groups within alternations."
+              (and (should-check ["abc" (0 ["b" "c"])] (/.regex "a(.)(.)|b(.)(.)") "abc")
+                   (should-check ["bcd" (1 ["c" "d"])] (/.regex "a(.)(.)|b(.)(.)") "bcd")
+                   (should-fail (/.regex "a(.)(.)|b(.)(.)") "cde")
+
+                   (should-check ["809-345-6789" (0 ["809" "345-6789" "345" "6789"])]
+                                 (/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d")
+                                 "809-345-6789")))
       ))
 
-(context: "Pattern-matching"
-  (<| (times 100)
-      (do @
-        [sample1 (r.unicode 3)
-         sample2 (r.unicode 3)
-         sample3 (r.unicode 4)]
-        (case (format sample1 "-" sample2 "-" sample3)
-          (&.^regex "(.{3})-(.{3})-(.{4})"
-                    [_ match1 match2 match3])
-          (test "Can pattern-match using regular-expressions."
-                (and (text;= sample1 match1)
-                     (text;= sample2 match2)
-                     (text;= sample3 match3)))
-
-          _
-          (test "Cannot pattern-match using regular-expressions."
-                #0)))))
+(def: pattern-matching
+  Test
+  (do r.monad
+    [sample1 (r.unicode 3)
+     sample2 (r.unicode 3)
+     sample3 (r.unicode 4)]
+    (case (format sample1 "-" sample2 "-" sample3)
+      (/.^regex "(.{3})-(.{3})-(.{4})"
+                [_ match1 match2 match3])
+      (_.test "Can pattern-match using regular-expressions."
+              (and (text@= sample1 match1)
+                   (text@= sample2 match2)
+                   (text@= sample3 match3)))
+
+      _
+      (_.test "Cannot pattern-match using regular-expressions."
+              #0))))
+
+(def: #export test
+  Test
+  (<| (_.context (%name (name-of /.regex)))
+      ($_ _.and
+          ..basics
+          ..system-character-classes
+          ..special-system-character-classes
+          ..custom-character-classes
+          ..references
+          ..fuzzy-quantifiers
+          ..crisp-quantifiers
+          ..groups
+          ..alternation
+          ..pattern-matching
+          )))
-- 
cgit v1.2.3