aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/format/json.lux20
-rw-r--r--stdlib/source/lux/lexer.lux34
-rw-r--r--stdlib/source/lux/macro/syntax.lux2
-rw-r--r--stdlib/source/lux/pipe.lux10
-rw-r--r--stdlib/source/lux/regex.lux100
-rw-r--r--stdlib/test/test/lux/lexer.lux349
-rw-r--r--stdlib/test/test/lux/pipe.lux105
-rw-r--r--stdlib/test/test/lux/regex.lux361
-rw-r--r--stdlib/test/tests.lux7
9 files changed, 599 insertions, 389 deletions
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 280aab24b..e8189a594 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -217,19 +217,19 @@
(def: data-sep
(Lexer [Text Char Text])
- ($_ lexer;seq space~ (lexer;this-char #",") space~))
+ ($_ lexer;seq space~ (lexer;char #",") space~))
(def: null~
(Lexer Null)
(do Monad<Lexer>
- [_ (lexer;this "null")]
+ [_ (lexer;text "null")]
(wrap [])))
(do-template [<name> <token> <value>]
[(def: <name>
(Lexer Boolean)
(do Monad<Lexer>
- [_ (lexer;this <token>)]
+ [_ (lexer;text <token>)]
(wrap <value>)))]
[t~ "true" true]
@@ -244,12 +244,12 @@
(Lexer Number)
(do Monad<Lexer>
[?sign (: (Lexer (Maybe Text))
- (lexer;opt (lexer;this "-")))
+ (lexer;opt (lexer;text "-")))
digits (: (Lexer Text)
(lexer;many' lexer;digit))
?decimals (: (Lexer (Maybe Text))
(lexer;opt (do @
- [_ (lexer;this ".")]
+ [_ (lexer;text ".")]
(lexer;many' lexer;digit))))]
(case (: (Error Real)
(Real/decode (format (default "" ?sign)
@@ -290,9 +290,9 @@
(def: string~
(Lexer String)
(do Monad<Lexer>
- [_ (lexer;this "\"")
+ [_ (lexer;text "\"")
string-body string-body~
- _ (lexer;this "\"")]
+ _ (lexer;text "\"")]
(wrap string-body)))
(def: (kv~ json~)
@@ -300,7 +300,7 @@
(do Monad<Lexer>
[key string~
_ space~
- _ (lexer;this-char #":")
+ _ (lexer;char #":")
_ space~
value (json~ [])]
(wrap [key value])))
@@ -309,11 +309,11 @@
[(def: (<name> json~)
(-> (-> Unit (Lexer JSON)) (Lexer <type>))
(do Monad<Lexer>
- [_ (lexer;this-char <open>)
+ [_ (lexer;char <open>)
_ space~
elems (lexer;sep-by data-sep <elem-parser>)
_ space~
- _ (lexer;this-char <close>)]
+ _ (lexer;char <close>)]
(wrap (<prep> elems))))]
[array~ Array #"[" #"]" (json~ []) vector;from-list]
diff --git a/stdlib/source/lux/lexer.lux b/stdlib/source/lux/lexer.lux
index 6d54f2614..e27e1925a 100644
--- a/stdlib/source/lux/lexer.lux
+++ b/stdlib/source/lux/lexer.lux
@@ -147,8 +147,8 @@
output
output)))
-(def: #export (assert test message)
- (-> Bool Text (Lexer Unit))
+(def: #export (assert message test)
+ (-> Text Bool (Lexer Unit))
(lambda [input]
(if test
(#;Right [input []])
@@ -225,14 +225,14 @@
(#;Right [input (#;Some value)])
)))
-(def: #export (this text)
+(def: #export (text test)
(-> Text (Lexer Text))
(lambda [input]
- (if (text;starts-with? text input)
- (case (text;split (text;size text) input)
+ (if (text;starts-with? test input)
+ (case (text;split (text;size test) input)
#;None (#;Left "")
- (#;Some [_ input']) (#;Right [input' text]))
- (#;Left (format "Invalid match: " text " @ " (:: text;Codec<Text,Text> encode input))))
+ (#;Some [_ input']) (#;Right [input' test]))
+ (#;Left (format "Invalid match: " test " @ " (:: text;Codec<Text,Text> encode input))))
))
(def: #export (sep-by sep p)
@@ -268,15 +268,15 @@
(#;Left "Can't peek character from empty text."))
))
-(def: #export (this-char char)
+(def: #export (char test)
(-> Char (Lexer Char))
(lambda [input]
(case [(text;at +0 input) (text;split +1 input)]
[(#;Some char') (#;Some [_ input'])]
- (if (Char/= char char')
- (#;Right [input' char])
- (#;Left (format "Expected " (:: char;Codec<Text,Char> encode char) " @ " (:: text;Codec<Text,Text> encode input)
- " " (Int/encode (c2l char))" " (Int/encode (c2l [char'])))))
+ (if (Char/= test char')
+ (#;Right [input' test])
+ (#;Left (format "Expected " (:: char;Codec<Text,Char> encode test) " @ " (:: text;Codec<Text,Text> encode input)
+ " " (Int/encode (c2l test))" " (Int/encode (c2l [char'])))))
_
(#;Left "Can't parse character from empty text."))
@@ -292,9 +292,9 @@
(do Monad<Lexer>
[input get-input
char any
- _ (assert (and (Char/>= bottom char)
- (Char/<= top char))
- (format "Character is not within range: " (:: char;Codec<Text,Char> encode bottom) "-" (:: char;Codec<Text,Char> encode top) " @ " (:: text;Codec<Text,Text> encode input)))]
+ _ (assert (format "Character is not within range: " (:: char;Codec<Text,Char> encode bottom) "-" (:: char;Codec<Text,Char> encode top) " @ " (:: text;Codec<Text,Text> encode input))
+ (and (Char/>= bottom char)
+ (Char/<= top char)))]
(wrap char)))
(do-template [<name> <bottom> <top>]
@@ -434,6 +434,6 @@
(def: #export (enclosed [start end] lexer)
(All [a] (-> [Text Text] (Lexer a) (Lexer a)))
- (_& (this start)
+ (_& (text start)
(&_ lexer
- (this end))))
+ (text end))))
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index 00a2ba96e..ce36cef19 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -446,7 +446,7 @@
(wrap [(ast;symbol var-name) (` any)])
_
- (compiler;fail "Syntax pattern expects records or symbols."))))
+ (compiler;fail "Syntax pattern expects tuples or symbols."))))
args)
#let [g!state (ast;symbol ["" "*compiler*"])
g!end (ast;symbol ["" ""])
diff --git a/stdlib/source/lux/pipe.lux b/stdlib/source/lux/pipe.lux
index 95167f7f2..5c553b7ec 100644
--- a/stdlib/source/lux/pipe.lux
+++ b/stdlib/source/lux/pipe.lux
@@ -31,13 +31,17 @@
_
(undefined)))
-(syntax: #export (@> [body body^]
+(syntax: #export (@> [name (s;default "@" s;local-symbol)]
+ [body body^]
prev)
{#;doc (doc "Gives the name '@' to the piped-argument, within the given expression."
(|> 5
- (@> [(i.+ @ @)])))}
+ (@> [(i.+ @ @)]))
+
+ (|> 5
+ (@> X [(i.+ X X)])))}
(wrap (list (fold (lambda [next prev]
- (` (let% [(~' @) (~ prev)]
+ (` (let% [(~ (ast;symbol ["" name])) (~ prev)]
(~ next))))
prev
body))))
diff --git a/stdlib/source/lux/regex.lux b/stdlib/source/lux/regex.lux
index 95599852c..e3cd95811 100644
--- a/stdlib/source/lux/regex.lux
+++ b/stdlib/source/lux/regex.lux
@@ -31,7 +31,7 @@
(def: escaped-char^
(Lexer Char)
(do Monad<Lexer>
- [? (&;opt (&;this-char #"\\"))
+ [? (&;opt (&;char #"\\"))
char (case ?
(#;Some _) &;any
#;None regex-char^)]
@@ -57,7 +57,7 @@
(def: #hidden word^
(Lexer Char)
(&;either &;alpha-num
- (&;this-char #"_")))
+ (&;char #"_")))
(def: #hidden (join-text^ part^)
(-> (Lexer (List Text)) (Lexer Text))
@@ -82,9 +82,9 @@
(do Monad<Lexer>
[]
($_ &;either
- (&;seq (wrap current-module) (&;_& (&;this ";;") identifier-part^))
- (&;seq identifier-part^ (&;_& (&;this ";") identifier-part^))
- (&;seq (wrap "lux") (&;_& (&;this ";") identifier-part^))
+ (&;seq (wrap current-module) (&;_& (&;text ";;") identifier-part^))
+ (&;seq identifier-part^ (&;_& (&;text ";") identifier-part^))
+ (&;seq (wrap "lux") (&;_& (&;text ";") identifier-part^))
(&;seq (wrap "") identifier-part^))))
(def: (re-var^ current-module)
@@ -97,7 +97,7 @@
(Lexer AST)
(do Monad<Lexer>
[from regex-char^
- _ (&;this-char #"-")
+ _ (&;char #"-")
to regex-char^]
(wrap (` (&;char-range (~ (ast;char from)) (~ (ast;char to)))))))
@@ -105,7 +105,7 @@
(Lexer AST)
(do Monad<Lexer>
[char escaped-char^]
- (wrap (` (&;this-char (~ (ast;char char)))))))
+ (wrap (` (&;char (~ (ast;char char)))))))
(def: re-char+^
(Lexer AST)
@@ -122,7 +122,7 @@
(def: re-user-class^'
(Lexer AST)
(do Monad<Lexer>
- [negate? (&;opt (&;this-char #"^"))
+ [negate? (&;opt (&;char #"^"))
parts (&;many ($_ &;either
re-char-range^
re-char-options^))]
@@ -135,7 +135,7 @@
(do Monad<Lexer>
[_ (wrap [])
init re-user-class^'
- rest (&;some (&;_& (&;this "&&") (&;enclosed ["[" "]"] re-user-class^')))]
+ rest (&;some (&;_& (&;text "&&") (&;enclosed ["[" "]"] re-user-class^')))]
(wrap (fold (lambda [refinement base]
(` (refine^ (~ refinement) (~ base))))
init
@@ -152,7 +152,7 @@
(def: #hidden control^
(Lexer Char)
(&;either (&;char-range #"\u0000" #"\u001F")
- (&;this-char #"\u007F")))
+ (&;char #"\u007F")))
(def: #hidden punct^
(Lexer Char)
@@ -165,36 +165,36 @@
(def: #hidden print^
(Lexer Char)
(&;either graph^
- (&;this-char #"\u0020")))
+ (&;char #"\u0020")))
(def: re-system-class^
(Lexer AST)
(do Monad<Lexer>
[]
($_ &;either
- (&;_& (&;this-char #".") (wrap (` (->Text &;any))))
- (&;_& (&;this "\\d") (wrap (` (->Text &;digit))))
- (&;_& (&;this "\\D") (wrap (` (->Text (&;not &;digit)))))
- (&;_& (&;this "\\s") (wrap (` (->Text &;space))))
- (&;_& (&;this "\\S") (wrap (` (->Text (&;not &;space)))))
- (&;_& (&;this "\\w") (wrap (` (->Text word^))))
- (&;_& (&;this "\\W") (wrap (` (->Text (&;not word^)))))
- (&;_& (&;this "\\d") (wrap (` (->Text &;digit))))
-
- (&;_& (&;this "\\p{Lower}") (wrap (` (->Text &;lower))))
- (&;_& (&;this "\\p{Upper}") (wrap (` (->Text &;upper))))
- (&;_& (&;this "\\p{Alpha}") (wrap (` (->Text &;alpha))))
- (&;_& (&;this "\\p{Digit}") (wrap (` (->Text &;digit))))
- (&;_& (&;this "\\p{Alnum}") (wrap (` (->Text &;alpha-num))))
- (&;_& (&;this "\\p{Space}") (wrap (` (->Text &;space))))
- (&;_& (&;this "\\p{HexDigit}") (wrap (` (->Text &;hex-digit))))
- (&;_& (&;this "\\p{OctDigit}") (wrap (` (->Text &;oct-digit))))
- (&;_& (&;this "\\p{Blank}") (wrap (` (->Text blank^))))
- (&;_& (&;this "\\p{ASCII}") (wrap (` (->Text ascii^))))
- (&;_& (&;this "\\p{Contrl}") (wrap (` (->Text control^))))
- (&;_& (&;this "\\p{Punct}") (wrap (` (->Text punct^))))
- (&;_& (&;this "\\p{Graph}") (wrap (` (->Text graph^))))
- (&;_& (&;this "\\p{Print}") (wrap (` (->Text print^))))
+ (&;_& (&;char #".") (wrap (` (->Text &;any))))
+ (&;_& (&;text "\\d") (wrap (` (->Text &;digit))))
+ (&;_& (&;text "\\D") (wrap (` (->Text (&;not &;digit)))))
+ (&;_& (&;text "\\s") (wrap (` (->Text &;space))))
+ (&;_& (&;text "\\S") (wrap (` (->Text (&;not &;space)))))
+ (&;_& (&;text "\\w") (wrap (` (->Text word^))))
+ (&;_& (&;text "\\W") (wrap (` (->Text (&;not word^)))))
+ (&;_& (&;text "\\d") (wrap (` (->Text &;digit))))
+
+ (&;_& (&;text "\\p{Lower}") (wrap (` (->Text &;lower))))
+ (&;_& (&;text "\\p{Upper}") (wrap (` (->Text &;upper))))
+ (&;_& (&;text "\\p{Alpha}") (wrap (` (->Text &;alpha))))
+ (&;_& (&;text "\\p{Digit}") (wrap (` (->Text &;digit))))
+ (&;_& (&;text "\\p{Alnum}") (wrap (` (->Text &;alpha-num))))
+ (&;_& (&;text "\\p{Space}") (wrap (` (->Text &;space))))
+ (&;_& (&;text "\\p{HexDigit}") (wrap (` (->Text &;hex-digit))))
+ (&;_& (&;text "\\p{OctDigit}") (wrap (` (->Text &;oct-digit))))
+ (&;_& (&;text "\\p{Blank}") (wrap (` (->Text blank^))))
+ (&;_& (&;text "\\p{ASCII}") (wrap (` (->Text ascii^))))
+ (&;_& (&;text "\\p{Contrl}") (wrap (` (->Text control^))))
+ (&;_& (&;text "\\p{Punct}") (wrap (` (->Text punct^))))
+ (&;_& (&;text "\\p{Graph}") (wrap (` (->Text graph^))))
+ (&;_& (&;text "\\p{Print}") (wrap (` (->Text print^))))
)))
(def: re-class^
@@ -209,14 +209,14 @@
(def: re-back-reference^
(Lexer AST)
(&;either (do Monad<Lexer>
- [_ (&;this-char #"\\")
+ [_ (&;char #"\\")
id int^]
- (wrap (` (&;this (~ (ast;symbol ["" (Int/encode id)]))))))
+ (wrap (` (&;text (~ (ast;symbol ["" (Int/encode id)]))))))
(do Monad<Lexer>
- [_ (&;this "\\k<")
+ [_ (&;text "\\k<")
captured-name identifier-part^
- _ (&;this ">")]
- (wrap (` (&;this (~ (ast;symbol ["" captured-name]))))))))
+ _ (&;text ">")]
+ (wrap (` (&;text (~ (ast;symbol ["" captured-name]))))))))
(def: (re-simple^ current-module)
(-> Text (Lexer AST))
@@ -250,15 +250,15 @@
(&;enclosed ["{" "}"]
($_ &;either
(do @
- [[from to] (&;seq int^ (&;_& (&;this-char #",") int^))]
+ [[from to] (&;seq int^ (&;_& (&;char #",") int^))]
(wrap (` (join-text^ (&;between (~ (ast;nat (int-to-nat from)))
(~ (ast;nat (int-to-nat to)))
(~ base))))))
(do @
- [limit (&;_& (&;this-char #",") int^)]
+ [limit (&;_& (&;char #",") int^)]
(wrap (` (join-text^ (&;at-most (~ (ast;nat (int-to-nat limit))) (~ base))))))
(do @
- [limit (&;&_ int^ (&;this-char #","))]
+ [limit (&;&_ int^ (&;char #","))]
(wrap (` (join-text^ (&;at-least (~ (ast;nat (int-to-nat limit))) (~ base))))))
(do @
[limit int^]
@@ -382,7 +382,7 @@
(do Monad<Lexer>
[#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)]
head sub^
- tail (&;some (&;_& (&;this-char #"|") sub^))
+ tail (&;some (&;_& (&;char #"|") sub^))
#let [g!op (if capturing?
(` |||^)
(` |||_^))]]
@@ -395,24 +395,24 @@
(-> Text (Lexer [Re-Group AST]))
($_ &;either
(do Monad<Lexer>
- [_ (&;this "(?:")
+ [_ (&;text "(?:")
[_ scoped] (re-alternative^ false re-scoped^ current-module)
- _ (&;this-char #")")]
+ _ (&;char #")")]
(wrap [#Non-Capturing scoped]))
(do Monad<Lexer>
[complex (re-complex^ current-module)]
(wrap [#Non-Capturing complex]))
(do Monad<Lexer>
- [_ (&;this "(?<")
+ [_ (&;text "(?<")
captured-name identifier-part^
- _ (&;this ">")
+ _ (&;text ">")
[num-captures pattern] (re-alternative^ true re-scoped^ current-module)
- _ (&;this-char #")")]
+ _ (&;char #")")]
(wrap [(#Capturing [(#;Some captured-name) num-captures]) pattern]))
(do Monad<Lexer>
- [_ (&;this-char #"(")
+ [_ (&;char #"(")
[num-captures pattern] (re-alternative^ true re-scoped^ current-module)
- _ (&;this-char #")")]
+ _ (&;char #")")]
(wrap [(#Capturing [#;None num-captures]) pattern]))))
(def: (regex^ current-module)
diff --git a/stdlib/test/test/lux/lexer.lux b/stdlib/test/test/lux/lexer.lux
index d0b17fe4b..fc51deafd 100644
--- a/stdlib/test/test/lux/lexer.lux
+++ b/stdlib/test/test/lux/lexer.lux
@@ -4,130 +4,247 @@
## You can obtain one at http://mozilla.org/MPL/2.0/.
(;module:
- [lux #- not]
+ lux
(lux (control monad)
(codata [io])
- (data error)
- [test #- fail assert]
- lexer))
+ (data [error #- fail]
+ [text "T/" Eq<Text>]
+ text/format
+ [char "C/" Eq<Char>]
+ (struct [list]))
+ (math ["R" random])
+ pipe
+ ["&" lexer])
+ lux/test)
+
+## [Utils]
+(def: (should-fail input)
+ (All [a] (-> (Error a) Bool))
+ (case input
+ (#;Left _) true
+ _ false))
+
+(def: (should-passC test input)
+ (-> Char (Error Char) Bool)
+ (case input
+ (#;Right output)
+ (C/= test output)
+
+ _
+ false))
+
+(def: (should-passT test input)
+ (-> Text (Error Text) Bool)
+ (case input
+ (#;Right output)
+ (T/= test output)
+
+ _
+ false))
+
+(def: (should-passL test input)
+ (-> (List Char) (Error (List Char)) Bool)
+ (let [(^open "L/") (list;Eq<List> char;Eq<Char>)]
+ (case input
+ (#;Right output)
+ (L/= test output)
+
+ _
+ false)))
+
+(def: (should-passE test input)
+ (-> (Either Char Char) (Error (Either Char Char)) Bool)
+ (case input
+ (#;Right output)
+ (case [test output]
+ [(#;Left test) (#;Left output)]
+ (C/= test output)
+
+ [(#;Right test) (#;Right output)]
+ (C/= test output)
+
+ _
+ false)
+
+ _
+ false))
## [Tests]
-(test: "Lexer end works"
- (test-all (should-pass (run end ""))
- (should-fail (run end "YOLO"))))
+(test: "End"
+ ($_ seq
+ (assert "Can detect the end of the input."
+ (|> (&;run &;end "")
+ (case> (#;Right _) true _ false)))
+
+ (assert "Won't mistake non-empty text for no more input."
+ (|> (&;run &;end "YOLO")
+ (case> (#;Left _) true _ false)))
+ ))
-(test: "Simple text lexers"
- (test-all (match (#;Right "YO")
- (run (this "YO") "YOLO"))
- (should-fail (run (this "YO") "MEME"))))
+(test: "Literals"
+ [size (|> R;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+ pre (R;text size)
+ post (|> (R;text size)
+ (R;filter (|>. (text;starts-with? pre) not)))]
+ ($_ seq
+ (assert "Can find literal text fragments."
+ (and (|> (&;run (&;text pre) (format pre post))
+ (case> (#;Right found) (T/= pre found) _ false))
+ (|> (&;run (&;text pre) post)
+ (case> (#;Left _) true _ false))))
+ ))
(test: "Char lexers"
- (test-all (match (#;Right #"Y")
- (run (this-char #"Y") "YOLO"))
- (should-fail (run (this-char #"Y") "MEME"))
- (match (#;Right #"Y")
- (run (char-range #"X" #"Z") "YOLO"))
- (should-fail (run (char-range #"X" #"Z") "MEME"))
- (match (#;Right #"Y")
- (run upper "YOLO"))
- (should-fail (run upper "meme"))
- (match (#;Right #"y")
- (run lower "yolo"))
- (should-fail (run lower "MEME"))
- (match (#;Right #"1")
- (run digit "1"))
- (should-fail (run digit " "))
- (match (#;Right #"7")
- (run oct-digit "7"))
- (should-fail (run oct-digit "8"))
- (match (#;Right #"A")
- (run any "A"))
- (should-fail (run any ""))))
+ ($_ seq
+ (assert "Can lex characters."
+ (and (|> (&;run (&;char #"Y") "YOLO")
+ (case> (#;Right #"Y") true _ false))
+ (|> (&;run (&;char #"Y") "MEME")
+ (case> (#;Left _) true _ false))))
+
+ (assert "Can lex characters ranges."
+ (and (should-passC #"Y" (&;run (&;char-range #"X" #"Z") "YOLO"))
+ (should-fail (&;run (&;char-range #"X" #"Z") "MEME"))))
+ ))
+
+(test: "Custom lexers"
+ ($_ seq
+ (assert "Can lex anything"
+ (and (should-passC #"A" (&;run &;any "A"))
+ (should-fail (&;run &;any ""))))
+
+ (assert "Can lex upper-case and &;lower-case letters."
+ (and (should-passC #"Y" (&;run &;upper "YOLO"))
+ (should-fail (&;run &;upper "meme"))
+
+ (should-passC #"y" (&;run &;lower "yolo"))
+ (should-fail (&;run &;lower "MEME"))))
+
+ (assert "Can lex numbers."
+ (and (should-passC #"1" (&;run &;digit "1"))
+ (should-fail (&;run &;digit " "))
+
+ (should-passC #"7" (&;run &;oct-digit "7"))
+ (should-fail (&;run &;oct-digit "8"))
+
+ (should-passC #"1" (&;run &;hex-digit "1"))
+ (should-passC #"a" (&;run &;hex-digit "a"))
+ (should-passC #"A" (&;run &;hex-digit "A"))
+ (should-fail (&;run &;hex-digit " "))
+ ))
+
+ (assert "Can lex alphabetic characters."
+ (and (should-passC #"A" (&;run &;alpha "A"))
+ (should-passC #"a" (&;run &;alpha "a"))
+ (should-fail (&;run &;alpha "1"))))
+
+ (assert "Can lex alphanumeric characters."
+ (and (should-passC #"A" (&;run &;alpha-num "A"))
+ (should-passC #"a" (&;run &;alpha-num "a"))
+ (should-passC #"1" (&;run &;alpha-num "1"))
+ (should-fail (&;run &;alpha-num " "))))
+
+ (assert "Can lex white-space."
+ (and (should-passC #" " (&;run &;space " "))
+ (should-fail (&;run &;space "8"))))
+ ))
(test: "Combinators"
- (test-all (match (#;Right [#"Y" #"O"])
- (run (seq any any) "YOLO"))
- (should-fail (run (seq any any) "Y"))
- (match+ (#;Left #"0")
- (should-pass (run (alt digit upper) "0")))
- (match+ (#;Right #"A")
- (should-pass (run (alt digit upper) "A")))
- (should-fail (run (alt digit upper) "a"))
- (should-pass (run (not (alt digit upper)) "a"))
- (should-fail (run (not (alt digit upper)) "A"))
- (match (#;Right #"0")
- (run (either digit upper) "0"))
- (match (#;Right #"A")
- (run (either digit upper) "A"))
- (should-fail (run (either digit upper) "a"))
- (match (#;Right #"A")
- (run alpha "A"))
- (match (#;Right #"a")
- (run alpha "a"))
- (should-fail (run alpha "1"))
- (match (#;Right #"A")
- (run alpha-num "A"))
- (match (#;Right #"a")
- (run alpha-num "a"))
- (match (#;Right #"1")
- (run alpha-num "1"))
- (should-fail (run alpha-num " "))
- (match (#;Right #"1")
- (run hex-digit "1"))
- (match (#;Right #"a")
- (run hex-digit "a"))
- (match (#;Right #"A")
- (run hex-digit "A"))
- (should-fail (run hex-digit " "))
- (match (#;Right #" ")
- (run space " "))
- (should-fail (run space "8"))
- (match (#;Right #"C")
- (run (one-of "ABC") "C"))
- (should-fail (run (one-of "ABC") "D"))
- (match (#;Right #"D")
- (run (none-of "ABC") "D"))
- (should-fail (run (none-of "ABC") "C"))
- (match (#;Right #"D")
- (run (satisfies (lambda [c] true)) "D"))
- (should-fail (run (satisfies (lambda [c] false)) "C"))
- (match (#;Right "0123456789ABCDEF")
- (run (many' hex-digit) "0123456789ABCDEF yolo"))
- (should-fail (run (many' hex-digit) "yolo"))
- (match (#;Right "")
- (run (some' hex-digit) "yolo"))
- ))
+ ($_ seq
+ (assert "Can combine lexers sequentially."
+ (and (|> (&;run (&;seq &;any &;any) "YOLO")
+ (case> (#;Right [#"Y" #"O"]) true
+ _ false))
+ (should-fail (&;run (&;seq &;any &;any) "Y"))))
+
+ (assert "Can combine lexers alternatively."
+ (and (should-passE (#;Left #"0") (&;run (&;alt &;digit &;upper) "0"))
+ (should-passE (#;Right #"A") (&;run (&;alt &;digit &;upper) "A"))
+ (should-fail (&;run (&;alt &;digit &;upper) "a"))))
+
+ (assert "Can create the opposite of a lexer."
+ (and (should-passC #"a" (&;run (&;not (&;alt &;digit &;upper)) "a"))
+ (should-fail (&;run (&;not (&;alt &;digit &;upper)) "A"))))
+
+ (assert "Can use either lexer."
+ (and (should-passC #"0" (&;run (&;either &;digit &;upper) "0"))
+ (should-passC #"A" (&;run (&;either &;digit &;upper) "A"))
+ (should-fail (&;run (&;either &;digit &;upper) "a"))))
+
+ (assert "Can select from among a set of characters."
+ (and (should-passC #"C" (&;run (&;one-of "ABC") "C"))
+ (should-fail (&;run (&;one-of "ABC") "D"))))
+
+ (assert "Can avoid a set of characters."
+ (and (should-passC #"D" (&;run (&;none-of "ABC") "D"))
+ (should-fail (&;run (&;none-of "ABC") "C"))))
+
+ (assert "Can lex using arbitrary predicates."
+ (and (should-passC #"D" (&;run (&;satisfies (lambda [c] true)) "D"))
+ (should-fail (&;run (&;satisfies (lambda [c] false)) "C"))))
+
+ (assert "Can apply a lexer multiple times."
+ (and (should-passT "0123456789ABCDEF" (&;run (&;many' &;hex-digit) "0123456789ABCDEF yolo"))
+ (should-fail (&;run (&;many' &;hex-digit) "yolo"))
+
+ (should-passT "" (&;run (&;some' &;hex-digit) "yolo"))))
+ ))
(test: "Yet more combinators..."
- (test-all (should-fail (run (fail "Well, it really SHOULD fail...") "yolo"))
- (should-fail (run (assert false "Well, it really SHOULD fail...") "yolo"))
- (should-pass (run (assert true "GO, GO, GO!") "yolo"))
- (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
- (run (many hex-digit) "0123456789ABCDEF yolo"))
- (should-fail (run (many hex-digit) "yolo"))
- (match (^ (#;Right (list)))
- (run (some hex-digit) "yolo"))
- (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
- (run (exactly +16 hex-digit) "0123456789ABCDEF yolo"))
- (match (^ (#;Right (list #"0" #"1" #"2")))
- (run (exactly +3 hex-digit) "0123456789ABCDEF yolo"))
- (should-fail (run (exactly +17 hex-digit) "0123456789ABCDEF yolo"))
- (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
- (run (at-most +16 hex-digit) "0123456789ABCDEF yolo"))
- (match (^ (#;Right (list #"0" #"1" #"2")))
- (run (at-most +3 hex-digit) "0123456789ABCDEF yolo"))
- (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
- (run (at-most +17 hex-digit) "0123456789ABCDEF yolo"))
- (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
- (run (between +0 +16 hex-digit) "0123456789ABCDEF yolo"))
- (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
- (run (between +3 +16 hex-digit) "0123456789ABCDEF yolo"))
- (should-fail (run (between +17 +100 hex-digit) "0123456789ABCDEF yolo"))
- (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")))
- (run (between +15 +20 hex-digit) "0123456789ABCDEF yolo"))
- (match (#;Right (#;Some #"1")) (run (opt hex-digit) "123abc"))
- (match (#;Right #;None) (run (opt hex-digit) "yolo"))
- (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"a" #"b" #"c" #"d" #"e" #"f")))
- (run (sep-by space hex-digit) "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO"))
- (match (#;Right "yolo") (run get-input "yolo"))
- ))
+ ($_ seq
+ (assert "Can fail at will."
+ (should-fail (&;run (&;fail "Well, it really SHOULD fail...") "yolo")))
+
+ (assert "Can make assertions."
+ (and (should-fail (&;run (&;assert "Well, it really SHOULD fail..." false) "yolo"))
+ (|> (&;run (&;assert "GO, GO, GO!" true) "yolo")
+ (case> (#;Right []) true
+ _ false))))
+
+ (assert "Can apply a lexer multiple times."
+ (and (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")
+ (&;run (&;many &;hex-digit) "0123456789ABCDEF yolo"))
+ (should-fail (&;run (&;many &;hex-digit) "yolo"))
+
+ (should-passL (list)
+ (&;run (&;some &;hex-digit) "yolo"))))
+
+ (assert "Can lex exactly N elements."
+ (and (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")
+ (&;run (&;exactly +16 &;hex-digit) "0123456789ABCDEF yolo"))
+ (should-passL (list #"0" #"1" #"2")
+ (&;run (&;exactly +3 &;hex-digit) "0123456789ABCDEF yolo"))
+ (should-fail (&;run (&;exactly +17 &;hex-digit) "0123456789ABCDEF yolo"))))
+
+ (assert "Can lex at-most N elements."
+ (and (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")
+ (&;run (&;at-most +16 &;hex-digit) "0123456789ABCDEF yolo"))
+ (should-passL (list #"0" #"1" #"2")
+ (&;run (&;at-most +3 &;hex-digit) "0123456789ABCDEF yolo"))
+ (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")
+ (&;run (&;at-most +17 &;hex-digit) "0123456789ABCDEF yolo"))))
+
+ (assert "Can lex tokens between lower and upper boundaries of quantity."
+ (and (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")
+ (&;run (&;between +0 +16 &;hex-digit) "0123456789ABCDEF yolo"))
+ (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")
+ (&;run (&;between +3 +16 &;hex-digit) "0123456789ABCDEF yolo"))
+ (should-fail (&;run (&;between +17 +100 &;hex-digit) "0123456789ABCDEF yolo"))
+ (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F")
+ (&;run (&;between +15 +20 &;hex-digit) "0123456789ABCDEF yolo"))))
+
+ (assert "Can optionally lex a token."
+ (and (|> (&;run (&;opt &;hex-digit) "123abc")
+ (case> (#;Right (#;Some #"1")) true
+ _ false))
+ (|> (&;run (&;opt &;hex-digit) "yolo")
+ (case> (#;Right #;None) true
+ _ false))))
+
+ (assert "Can take into account separators during lexing."
+ (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"a" #"b" #"c" #"d" #"e" #"f")
+ (&;run (&;sep-by &;space &;hex-digit) "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO")))
+
+ (assert "Can obtain the whole of the remaining input."
+ (should-passT "yolo" (&;run &;get-input "yolo")))
+ ))
diff --git a/stdlib/test/test/lux/pipe.lux b/stdlib/test/test/lux/pipe.lux
index 681c4bf71..92ca205b8 100644
--- a/stdlib/test/test/lux/pipe.lux
+++ b/stdlib/test/test/lux/pipe.lux
@@ -1,3 +1,8 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
(;module:
lux
(lux (codata [io])
@@ -5,43 +10,71 @@
(data text/format
[number]
[product]
- identity)
+ identity
+ [text "T/" Eq<Text>])
(codata function)
+ (math ["R" random])
pipe)
lux/test)
-(test: "lux/pipe exports"
- (test-all (match 1 (|> 20
- (i.* 3)
- (i.+ 4)
- (_> 0 i.inc)))
- (match 10 (|> 5
- (@> [(i.+ @ @)])))
- (match 15 (|> 5
- (?> [i.even?] [(i.* 2)]
- [i.odd?] [(i.* 3)]
- [(_> -1)])))
- (match 15 (|> 5
- (?> [i.even?] [(i.* 2)]
- [i.odd?] [(i.* 3)])))
- (match 10 (|> 1
- (!> [(i.< 10)]
- [i.inc])))
- (match 20 (|> 5
- (%> Monad<Identity>
- [(i.* 3)]
- [(i.+ 4)]
- [i.inc])))
- (match "five" (|> 5
- (case> 0 "zero"
- 1 "one"
- 2 "two"
- 3 "three"
- 4 "four"
- 5 "five"
- 6 "six"
- 7 "seven"
- 8 "eight"
- 9 "nine"
- _ "???")))
- ))
+(test: "Pipes"
+ ($_ seq
+ (assert "Can dismiss previous pipeline results and begin a new line."
+ (|> 20
+ (i.* 3)
+ (i.+ 4)
+ (_> 0 i.inc)
+ (i.= 1)))
+
+ (assert "Can give names to piped values within a pipeline's scope."
+ (and (|> 5
+ (@> [(i.+ @ @)])
+ (i.= 10))
+ (|> 5
+ (@> X [(i.+ X X)])
+ (i.= 10))))
+
+ (assert "Can do branching in pipelines."
+ (and (|> 5
+ (?> [i.even?] [(i.* 2)]
+ [i.odd?] [(i.* 3)]
+ [(_> -1)])
+ (i.= 15))
+ (|> 4
+ (?> [i.even?] [(i.* 2)]
+ [i.odd?] [(i.* 3)])
+ (i.= 8))
+ (|> 5
+ (?> [i.even?] [(i.* 2)]
+ [(_> -1)])
+ (i.= -1))))
+
+ (assert "Can loop within pipelines."
+ (|> 1
+ (!> [(i.< 10)]
+ [i.inc])
+ (i.= 10)))
+
+ (assert "Can use monads within pipelines."
+ (|> 5
+ (%> Monad<Identity>
+ [(i.* 3)]
+ [(i.+ 4)]
+ [i.inc])
+ (i.= 20)))
+
+ (assert "Can pattern-match against piped values."
+ (|> 5
+ (case> 0 "zero"
+ 1 "one"
+ 2 "two"
+ 3 "three"
+ 4 "four"
+ 5 "five"
+ 6 "six"
+ 7 "seven"
+ 8 "eight"
+ 9 "nine"
+ _ "???")
+ (T/= "five")))
+ ))
diff --git a/stdlib/test/test/lux/regex.lux b/stdlib/test/test/lux/regex.lux
index 66355bdca..bb366ac90 100644
--- a/stdlib/test/test/lux/regex.lux
+++ b/stdlib/test/test/lux/regex.lux
@@ -7,194 +7,251 @@
lux
(lux (codata [io])
(control monad)
- (data error
- [product])
+ (data [error #- fail]
+ [product]
+ [text "T/" Eq<Text>]
+ text/format)
[compiler]
(macro [ast]
["s" syntax #+ syntax:])
- test
+ (math ["R" random])
+ pipe
[lexer]
- regex))
-
-(syntax: (should-regex {veredict (s;alt s;bool s;any)} {regex s;text} {input s;text})
- (case veredict
- (+0 ?)
- (if ?
- (wrap (list (` (match+ (~ (ast;text input))
- (should-pass (lexer;run (regex (~ (ast;text regex)))
- (~ (ast;text input))))))))
- (wrap (list (` (should-fail (lexer;run (regex (~ (ast;text regex)))
- (~ (ast;text input))))))))
-
- (+1 result)
- (wrap (list (` (match+ (~ result)
- (should-pass (lexer;run (regex (~ (ast;text regex)))
- (~ (ast;text input))))))))))
+ ["&" regex])
+ lux/test)
-## [Tests]
-(test: "Regular Expressions [Basics]"
- (test-all (should-regex true "a" "a")
- (should-regex false "a" ".")
- (should-regex true "\\." ".")
- (should-regex false "\\." "a")
- ))
+## [Utils]
+(def: (should-pass regex input)
+ (-> (lexer;Lexer Text) Text Bool)
+ (|> (lexer;run regex input)
+ (case> (#;Right parsed)
+ (T/= parsed input)
-(test: "Regular Expressions [System character classes]"
- (test-all (should-regex true "." "a")
+ _
+ false)))
- (should-regex true "\\d" "0")
- (should-regex false "\\d" "m")
- (should-regex true "\\D" "m")
- (should-regex false "\\D" "0")
+(def: (should-passT test regex input)
+ (-> Text (lexer;Lexer Text) Text Bool)
+ (|> (lexer;run regex input)
+ (case> (#;Right parsed)
+ (T/= test parsed)
- (should-regex true "\\s" " ")
- (should-regex false "\\s" "m")
- (should-regex true "\\S" "m")
- (should-regex false "\\S" " ")
+ _
+ false)))
- (should-regex true "\\w" "_")
- (should-regex false "\\w" "^")
- (should-regex true "\\W" ".")
- (should-regex false "\\W" "a")
+(def: (should-fail regex input)
+ (All [a] (-> (lexer;Lexer a) Text Bool))
+ (|> (lexer;run regex input)
+ (case> (#;Left _) true _ false)))
- (should-regex true "\\p{Lower}" "m")
- (should-regex false "\\p{Lower}" "M")
+(syntax: (should-check pattern regex input)
+ (wrap (list (` (|> (lexer;run (~ regex) (~ input))
+ (case> (^ (#;Right (~ pattern)))
+ true
- (should-regex true "\\p{Upper}" "M")
- (should-regex false "\\p{Upper}" "m")
+ (~' _)
+ false))))))
- (should-regex true "\\p{Alpha}" "M")
- (should-regex false "\\p{Alpha}" "0")
+## [Tests]
+(test: "Regular Expressions [Basics]"
+ (assert "Can parse character literals."
+ (and (should-pass (&;regex "a") "a")
+ (should-fail (&;regex "a") ".")
+ (should-pass (&;regex "\\.") ".")
+ (should-fail (&;regex "\\.") "a"))))
- (should-regex true "\\p{Digit}" "1")
- (should-regex false "\\p{Digit}" "n")
+(test: "Regular Expressions [System character classes]"
+ ($_ seq
+ (assert "Can parse anything."
+ (should-pass (&;regex ".") "a"))
- (should-regex true "\\p{Alnum}" "1")
- (should-regex false "\\p{Alnum}" ".")
+ (assert "Can parse digits."
+ (and (should-pass (&;regex "\\d") "0")
+ (should-fail (&;regex "\\d") "m")))
+
+ (assert "Can parse non digits."
+ (and (should-pass (&;regex "\\D") "m")
+ (should-fail (&;regex "\\D") "0")))
- (should-regex true "\\p{Space}" " ")
- (should-regex false "\\p{Space}" ".")
+ (assert "Can parse white-space."
+ (and (should-pass (&;regex "\\s") " ")
+ (should-fail (&;regex "\\s") "m")))
+
+ (assert "Can parse non white-space."
+ (and (should-pass (&;regex "\\S") "m")
+ (should-fail (&;regex "\\S") " ")))
- (should-regex true "\\p{HexDigit}" "a")
- (should-regex false "\\p{HexDigit}" ".")
+ (assert "Can parse word characters."
+ (and (should-pass (&;regex "\\w") "_")
+ (should-fail (&;regex "\\w") "^")))
+
+ (assert "Can parse non word characters."
+ (and (should-pass (&;regex "\\W") ".")
+ (should-fail (&;regex "\\W") "a")))
- (should-regex true "\\p{OctDigit}" "6")
- (should-regex false "\\p{OctDigit}" ".")
+ (assert "Can parse using special character classes."
+ (and (and (should-pass (&;regex "\\p{Lower}") "m")
+ (should-fail (&;regex "\\p{Lower}") "M"))
- (should-regex true "\\p{Blank}" "\t")
- (should-regex false "\\p{Blank}" ".")
+ (and (should-pass (&;regex "\\p{Upper}") "M")
+ (should-fail (&;regex "\\p{Upper}") "m"))
- (should-regex true "\\p{ASCII}" "\t")
- (should-regex false "\\p{ASCII}" "\u1234")
+ (and (should-pass (&;regex "\\p{Alpha}") "M")
+ (should-fail (&;regex "\\p{Alpha}") "0"))
- (should-regex true "\\p{Contrl}" "\u0012")
- (should-regex false "\\p{Contrl}" "a")
+ (and (should-pass (&;regex "\\p{Digit}") "1")
+ (should-fail (&;regex "\\p{Digit}") "n"))
- (should-regex true "\\p{Punct}" "@")
- (should-regex false "\\p{Punct}" "a")
+ (and (should-pass (&;regex "\\p{Alnum}") "1")
+ (should-fail (&;regex "\\p{Alnum}") "."))
- (should-regex true "\\p{Graph}" "@")
- (should-regex false "\\p{Graph}" " ")
+ (and (should-pass (&;regex "\\p{Space}") " ")
+ (should-fail (&;regex "\\p{Space}") "."))
- (should-regex true "\\p{Print}" "\u0020")
- (should-regex false "\\p{Print}" "\u1234")
- ))
+ (and (should-pass (&;regex "\\p{HexDigit}") "a")
+ (should-fail (&;regex "\\p{HexDigit}") "."))
-(test: "Regular Expressions [Custom character classes]"
- (test-all (should-regex true "[abc]" "a")
- (should-regex false "[abc]" "m")
+ (and (should-pass (&;regex "\\p{OctDigit}") "6")
+ (should-fail (&;regex "\\p{OctDigit}") "."))
- (should-regex true "[a-z]" "a")
- (should-regex true "[a-z]" "m")
- (should-regex true "[a-z]" "z")
+ (and (should-pass (&;regex "\\p{Blank}") "\t")
+ (should-fail (&;regex "\\p{Blank}") "."))
- (should-regex true "[a-zA-Z]" "a")
- (should-regex true "[a-zA-Z]" "m")
- (should-regex true "[a-zA-Z]" "z")
- (should-regex true "[a-zA-Z]" "A")
- (should-regex true "[a-zA-Z]" "M")
- (should-regex true "[a-zA-Z]" "Z")
+ (and (should-pass (&;regex "\\p{ASCII}") "\t")
+ (should-fail (&;regex "\\p{ASCII}") "\u1234"))
- (should-regex false "[^abc]" "a")
- (should-regex true "[^abc]" "m")
+ (and (should-pass (&;regex "\\p{Contrl}") "\u0012")
+ (should-fail (&;regex "\\p{Contrl}") "a"))
- (should-regex false "[^a-z]" "a")
- (should-regex true "[^a-z]" "0")
- (should-regex false "[^a-zA-Z]" "a")
- (should-regex true "[^a-zA-Z]" "0")
+ (and (should-pass (&;regex "\\p{Punct}") "@")
+ (should-fail (&;regex "\\p{Punct}") "a"))
- (should-regex false "[a-z&&[def]]" "a")
- (should-regex true "[a-z&&[def]]" "d")
+ (and (should-pass (&;regex "\\p{Graph}") "@")
+ (should-fail (&;regex "\\p{Graph}") " "))
- (should-regex true "[a-z&&[^bc]]" "a")
- (should-regex false "[a-z&&[^bc]]" "b")
+ (and (should-pass (&;regex "\\p{Print}") "\u0020")
+ (should-fail (&;regex "\\p{Print}") "\u1234"))))
+ ))
- (should-regex true "[a-z&&[^m-p]]" "a")
- (should-regex false "[a-z&&[^m-p]]" "m")
- (should-regex false "[a-z&&[^m-p]]" "p")
- ))
+(test: "Regular Expressions [Custom character classes]"
+ ($_ seq
+ (assert "Can parse using custom character classes."
+ (and (should-pass (&;regex "[abc]") "a")
+ (should-fail (&;regex "[abc]") "m")))
+
+ (assert "Can parse using character ranges."
+ (and (should-pass (&;regex "[a-z]") "a")
+ (should-pass (&;regex "[a-z]") "m")
+ (should-pass (&;regex "[a-z]") "z")))
+
+ (assert "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")))
+
+ (assert "Can negate custom character classes."
+ (and (should-fail (&;regex "[^abc]") "a")
+ (should-pass (&;regex "[^abc]") "m")))
+
+ (assert "Can negate character ranges.."
+ (and (should-fail (&;regex "[^a-z]") "a")
+ (should-pass (&;regex "[^a-z]") "0")))
+
+ (assert "Can parse negate combinations of character ranges."
+ (and (should-fail (&;regex "[^a-zA-Z]") "a")
+ (should-pass (&;regex "[^a-zA-Z]") "0")))
+
+ (assert "Can make custom character classes more specific."
+ (and (and (should-fail (&;regex "[a-z&&[def]]") "a")
+ (should-pass (&;regex "[a-z&&[def]]") "d"))
+
+ (and (should-pass (&;regex "[a-z&&[^bc]]") "a")
+ (should-fail (&;regex "[a-z&&[^bc]]") "b"))
+
+ (and (should-pass (&;regex "[a-z&&[^m-p]]") "a")
+ (should-fail (&;regex "[a-z&&[^m-p]]") "m")
+ (should-fail (&;regex "[a-z&&[^m-p]]") "p"))))
+ ))
(test: "Regular Expressions [Reference]"
- (test-all (let [number (regex "\\d+")]
- (should-regex ["809-345-6789" "809" "345" "6789"] "(\\@<number>)-(\\@<number>)-(\\@<number>)" "809-345-6789"))
- ))
+ (let [number (&;regex "\\d+")]
+ (assert "Can build complex regexs by combining simpler ones."
+ (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\@<number>)-(\\@<number>)-(\\@<number>)") "809-345-6789"))))
(test: "Regular Expressions [Quantifiers]"
- (test-all (should-regex "aa" "aa" "aa")
-
- (should-regex "a" "a?" "a")
- (should-regex "" "a?" "")
-
- (should-regex "aaa" "a*" "aaa")
- (should-regex "" "a*" "")
-
- (should-regex "aaa" "a+" "aaa")
- (should-regex "a" "a+" "a")
- (should-regex false "a+" "")
-
- (should-regex "aa" "a{2}" "aa")
- (should-regex "a" "a{1}" "aa")
- (should-regex false "a{3}" "aa")
-
- (should-regex "aa" "a{1,}" "aa")
- (should-regex "aa" "a{2,}" "aa")
- (should-regex false "a{3,}" "aa")
-
- (should-regex "a" "a{,1}" "aa")
- (should-regex "aa" "a{,2}" "aa")
- (should-regex "aa" "a{,3}" "aa")
-
- (should-regex "a" "a{1,2}" "a")
- (should-regex "aa" "a{1,2}" "aa")
- (should-regex "aa" "a{1,2}" "aaa")
- ))
+ ($_ seq
+ (assert "Can sequentially combine patterns."
+ (should-passT "aa" (&;regex "aa") "aa"))
+
+ (assert "Can match patterns optionally."
+ (and (should-passT "a" (&;regex "a?") "a")
+ (should-passT "" (&;regex "a?") "")))
+
+ (assert "Can match a pattern 0 or more times."
+ (and (should-passT "aaa" (&;regex "a*") "aaa")
+ (should-passT "" (&;regex "a*") "")))
+
+ (assert "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+") "")))
+
+ (assert "Can match a pattern N times."
+ (and (should-passT "aa" (&;regex "a{2}") "aa")
+ (should-passT "a" (&;regex "a{1}") "aa")
+ (should-fail (&;regex "a{3}") "aa")))
+
+ (assert "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")))
+
+ (assert "Can match a pattern at-most N times."
+ (and (should-passT "a" (&;regex "a{,1}") "aa")
+ (should-passT "aa" (&;regex "a{,2}") "aa")
+ (should-passT "aa" (&;regex "a{,3}") "aa")))
+
+ (assert "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")
+ (should-passT "aa" (&;regex "a{1,2}") "aaa")))
+ ))
(test: "Regular Expressions [Groups]"
- (test-all (should-regex ["abc" "b"] "a(.)c" "abc")
- (should-regex ["abbbbbc" "bbbbb"] "a(b+)c" "abbbbbc")
- (should-regex ["809-345-6789" "809" "345" "6789"] "(\\d{3})-(\\d{3})-(\\d{4})" "809-345-6789")
- (should-regex ["809-345-6789" "809" "6789"] "(\\d{3})-(?:\\d{3})-(\\d{4})" "809-345-6789")
- (should-regex ["809-809-6789" "809" "6789"] "(\\d{3})-\\0-(\\d{4})" "809-809-6789")
- (should-regex ["809-809-6789" "809" "6789"] "(?<code>\\d{3})-\\k<code>-(\\d{4})" "809-809-6789")
- (should-regex ["809-809-6789-6789" "809" "6789"] "(?<code>\\d{3})-\\k<code>-(\\d{4})-\\0" "809-809-6789-6789")
-
- (should-regex ["809-345-6789" "809" ["345-6789" "345" "6789"]] "(\\d{3})-((\\d{3})-(\\d{4}))" "809-345-6789")
- ))
+ ($_ seq
+ (assert "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")))
+
+ (assert "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"))
+ ))
(test: "Regular Expressions [Alternation]"
- (test-all (should-regex ["a" (+0 [])] "a|b" "a")
- (should-regex ["b" (+1 [])] "a|b" "b")
- (should-regex false "a|b" "c")
-
- (should-regex ["abc" (+0 "b")] "a(.)c|b(.)d" "abc")
- (should-regex ["bcd" (+1 "c")] "a(.)c|b(.)d" "bcd")
- (should-regex false "a(.)c|b(.)d" "cde")
-
- (should-regex ["abc" (+0 ["b" "c"])] "a(.)(.)|b(.)(.)" "abc")
- (should-regex ["bcd" (+1 ["c" "d"])] "a(.)(.)|b(.)(.)" "bcd")
- (should-regex false "a(.)(.)|b(.)(.)" "cde")
-
- (should-regex ["809-345-6789" (+0 ["809" "345-6789" "345" "6789"])]
- "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d"
- "809-345-6789")
- ))
+ ($_ seq
+ (assert "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")))
+
+ (assert "Can have groups within alternations."
+ (and (should-check ["abc" (+0 "b")] (&;regex "a(.)c|b(.)d") "abc")
+ (should-check ["bcd" (+1 "c")] (&;regex "a(.)c|b(.)d") "bcd")
+ (should-fail (&;regex "a(.)c|b(.)d") "cde")
+
+ (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")))
+ ))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 4b46a7cd5..857d5c25c 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -13,6 +13,9 @@
(test lux
(lux ["_;" cli]
["_;" host]
+ ["_;" pipe]
+ ["_;" lexer]
+ ["_;" regex]
(codata ["_;" io]
[env]
[state]
@@ -52,10 +55,6 @@
## ["_;" random]
["_;" simple]
)
- ## ["_;" pipe]
- ## ["_;" lexer]
- ## ["_;" regex]
-
## (macro [ast]
## [syntax])
## [type]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 13:32:00 +0000