aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/data/text/regex.lux40
-rw-r--r--stdlib/source/test/lux.lux9
-rw-r--r--stdlib/source/test/lux/data.lux15
-rw-r--r--stdlib/source/test/lux/data/product.lux31
-rw-r--r--stdlib/source/test/lux/data/sum.lux56
-rw-r--r--stdlib/source/test/lux/data/text.lux233
-rw-r--r--stdlib/source/test/lux/data/text/format.lux21
-rw-r--r--stdlib/source/test/lux/data/text/lexer.lux340
-rw-r--r--stdlib/source/test/lux/data/text/regex.lux466
9 files changed, 583 insertions, 628 deletions
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
+ )))