aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/parser.lux10
-rw-r--r--stdlib/source/lux/control/parser/synthesis.lux18
-rw-r--r--stdlib/source/lux/control/parser/text.lux35
-rw-r--r--stdlib/source/lux/data/format/json.lux101
-rw-r--r--stdlib/source/lux/data/text.lux4
-rw-r--r--stdlib/source/lux/data/text/regex.lux277
-rw-r--r--stdlib/source/lux/data/text/unicode.lux2
-rw-r--r--stdlib/source/lux/host.jvm.lux4
-rw-r--r--stdlib/source/lux/math/random.lux15
-rw-r--r--stdlib/source/test/lux/control/parser/text.lux545
10 files changed, 638 insertions, 373 deletions
diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux
index d854be6d0..9b1d75cd1 100644
--- a/stdlib/source/lux/control/parser.lux
+++ b/stdlib/source/lux/control/parser.lux
@@ -288,6 +288,16 @@
(#try.Success [input' _])
(#try.Success [input' true]))))
+(def: #export (parses parser)
+ (All [s a] (-> (Parser s a) (Parser s Any)))
+ (function (_ input)
+ (case (parser input)
+ (#try.Failure error)
+ (#try.Failure error)
+
+ (#try.Success [input' _])
+ (#try.Success [input' []]))))
+
(def: #export (speculative parser)
(All [s a] (-> (Parser s a) (Parser s a)))
(function (_ input)
diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux
index b4ad2184b..5384dc31f 100644
--- a/stdlib/source/lux/control/parser/synthesis.lux
+++ b/stdlib/source/lux/control/parser/synthesis.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- function i64)
+ [lux (#- function loop i64)
[abstract
[monad (#+ do)]]
[control
@@ -18,7 +18,8 @@
["." list ("#@." functor)]]]
[tool
[compiler
- [reference (#+)]
+ [reference (#+)
+ [variable (#+ Register)]]
[arity (#+ Arity)]
[language
[lux
@@ -148,3 +149,16 @@
_
(exception.throw ..cannot-parse input))))
+
+(def: #export (loop init-parsers iteration-parser)
+ (All [a b] (-> (Parser a) (Parser b) (Parser [Register a b])))
+ (.function (_ input)
+ (case input
+ (^ (list& (/.loop/scope [start inits iteration]) tail))
+ (do try.monad
+ [inits (..run init-parsers inits)
+ iteration (..run iteration-parser (list iteration))]
+ (#try.Success [tail [start inits iteration]]))
+
+ _
+ (exception.throw ..cannot-parse input))))
diff --git a/stdlib/source/lux/control/parser/text.lux b/stdlib/source/lux/control/parser/text.lux
index 5a7c2bb10..b74be5022 100644
--- a/stdlib/source/lux/control/parser/text.lux
+++ b/stdlib/source/lux/control/parser/text.lux
@@ -89,9 +89,14 @@
{#.doc "Just returns the next character without applying any logic."}
(Parser Slice)
(function (_ [offset tape])
- (#try.Success [[("lux i64 +" 1 offset) tape]
- {#basis offset
- #distance 1}])))
+ (case (/.nth offset tape)
+ (#.Some _)
+ (#try.Success [[("lux i64 +" 1 offset) tape]
+ {#basis offset
+ #distance 1}])
+
+ _
+ (exception.throw ..cannot-parse []))))
(template [<name> <type> <any>]
[(def: #export (<name> p)
@@ -124,19 +129,7 @@
_
<failure>))))
-(def: #export (this? reference)
- {#.doc "Lex a text if it matches the given sample."}
- (-> Text (Parser Bit))
- (function (_ (^@ input [offset tape]))
- (case (/.index-of' reference offset tape)
- (^multi (#.Some where) (n.= offset where))
- (#try.Success [[("lux i64 +" (/.size reference) offset) tape]
- #1])
-
- _
- (#try.Success [input #0]))))
-
-(def: #export end
+(def: #export end!
{#.doc "Ensure the parser's input is empty."}
(Parser Any)
(function (_ (^@ input [offset tape]))
@@ -144,12 +137,6 @@
(#try.Success [input []])
(exception.throw ..unconsumed-input input))))
-(def: #export end?
- {#.doc "Ask if the parser's input is empty."}
- (Parser Bit)
- (function (_ (^@ input [offset tape]))
- (#try.Success [input (n.= offset (/.size tape))])))
-
(def: #export peek
{#.doc "Lex the next character (without consuming it from the input)."}
(Parser Text)
@@ -182,7 +169,7 @@
[(def: #export <name>
{#.doc (code.text ($_ /@compose "Only lex " <desc> " characters."))}
(Parser Text)
- (range (char <bottom>) (char <top>)))]
+ (..range (char <bottom>) (char <top>)))]
[upper "A" "Z" "uppercase"]
[lower "a" "z" "lowercase"]
@@ -268,7 +255,7 @@
(def: #export space
{#.doc "Only lex white-space."}
(Parser Text)
- (satisfies /.space?))
+ (..satisfies /.space?))
(def: #export (and left right)
(-> (Parser Text) (Parser Text) (Parser Text))
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index e0975d02d..12e94a331 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -8,9 +8,8 @@
[control
pipe
["." try (#+ Try)]
- ["p" parser ("#@." monad)
- ["l" text (#+ Parser)]
- ["s" code]]]
+ ["<>" parser ("#@." monad)
+ ["<t>" text (#+ Parser)]]]
[data
["." bit]
["." maybe]
@@ -253,23 +252,23 @@
(def: space~
(Parser Text)
- (l.some l.space))
+ (<t>.some <t>.space))
(def: data-sep
(Parser [Text Any Text])
- ($_ p.and space~ (l.this ",") space~))
+ ($_ <>.and space~ (<t>.this ",") space~))
(def: null~
(Parser Null)
- (do p.monad
- [_ (l.this "null")]
+ (do <>.monad
+ [_ (<t>.this "null")]
(wrap [])))
(template [<name> <token> <value>]
[(def: <name>
(Parser Boolean)
- (do p.monad
- [_ (l.this <token>)]
+ (do <>.monad
+ [_ (<t>.this <token>)]
(wrap <value>)))]
[true~ "true" #1]
@@ -278,55 +277,55 @@
(def: boolean~
(Parser Boolean)
- (p.either true~ false~))
+ (<>.either true~ false~))
(def: number~
(Parser Number)
- (do {@ p.monad}
- [signed? (l.this? "-")
- digits (l.many l.decimal)
- decimals (p.default "0"
- (do @
- [_ (l.this ".")]
- (l.many l.decimal)))
- exp (p.default ""
- (do @
- [mark (l.one-of "eE")
- signed?' (l.this? "-")
- offset (l.many l.decimal)]
- (wrap ($_ text@compose mark (if signed?' "-" "") offset))))]
+ (do {@ <>.monad}
+ [signed? (<>.parses? (<t>.this "-"))
+ digits (<t>.many <t>.decimal)
+ decimals (<>.default "0"
+ (do @
+ [_ (<t>.this ".")]
+ (<t>.many <t>.decimal)))
+ exp (<>.default ""
+ (do @
+ [mark (<t>.one-of "eE")
+ signed?' (<>.parses? (<t>.this "-"))
+ offset (<t>.many <t>.decimal)]
+ (wrap ($_ text@compose mark (if signed?' "-" "") offset))))]
(case (f@decode ($_ text@compose (if signed? "-" "") digits "." decimals exp))
(#try.Failure message)
- (p.fail message)
+ (<>.fail message)
(#try.Success value)
(wrap value))))
(def: escaped~
(Parser Text)
- ($_ p.either
- (p.after (l.this "\t")
- (p@wrap text.tab))
- (p.after (l.this "\b")
- (p@wrap text.back-space))
- (p.after (l.this "\n")
- (p@wrap text.new-line))
- (p.after (l.this "\r")
- (p@wrap text.carriage-return))
- (p.after (l.this "\f")
- (p@wrap text.form-feed))
- (p.after (l.this (text@compose "\" text.double-quote))
- (p@wrap text.double-quote))
- (p.after (l.this "\\")
- (p@wrap "\"))))
+ ($_ <>.either
+ (<>.after (<t>.this "\t")
+ (<>@wrap text.tab))
+ (<>.after (<t>.this "\b")
+ (<>@wrap text.back-space))
+ (<>.after (<t>.this "\n")
+ (<>@wrap text.new-line))
+ (<>.after (<t>.this "\r")
+ (<>@wrap text.carriage-return))
+ (<>.after (<t>.this "\f")
+ (<>@wrap text.form-feed))
+ (<>.after (<t>.this (text@compose "\" text.double-quote))
+ (<>@wrap text.double-quote))
+ (<>.after (<t>.this "\\")
+ (<>@wrap "\"))))
(def: string~
(Parser String)
- (<| (l.enclosed [text.double-quote text.double-quote])
+ (<| (<t>.enclosed [text.double-quote text.double-quote])
(loop [_ []])
- (do {@ p.monad}
- [chars (l.some (l.none-of (text@compose "\" text.double-quote)))
- stop l.peek])
+ (do {@ <>.monad}
+ [chars (<t>.some (<t>.none-of (text@compose "\" text.double-quote)))
+ stop <t>.peek])
(if (text@= "\" stop)
(do @
[escaped escaped~
@@ -336,10 +335,10 @@
(def: (kv~ json~)
(-> (-> Any (Parser JSON)) (Parser [String JSON]))
- (do p.monad
+ (do <>.monad
[key string~
_ space~
- _ (l.this ":")
+ _ (<t>.this ":")
_ space~
value (json~ [])]
(wrap [key value])))
@@ -347,12 +346,12 @@
(template [<name> <type> <open> <close> <elem-parser> <prep>]
[(def: (<name> json~)
(-> (-> Any (Parser JSON)) (Parser <type>))
- (do p.monad
- [_ (l.this <open>)
+ (do <>.monad
+ [_ (<t>.this <open>)
_ space~
- elems (p.sep-by data-sep <elem-parser>)
+ elems (<>.sep-by data-sep <elem-parser>)
_ space~
- _ (l.this <close>)]
+ _ (<t>.this <close>)]
(wrap (<prep> elems))))]
[array~ Array "[" "]" (json~ []) row.from-list]
@@ -361,10 +360,10 @@
(def: (json~' _)
(-> Any (Parser JSON))
- ($_ p.or null~ boolean~ number~ string~ (array~ json~') (object~ json~')))
+ ($_ <>.or null~ boolean~ number~ string~ (array~ json~') (object~ json~')))
(structure: #export codec
(Codec Text JSON)
(def: encode ..format)
- (def: decode (l.run (json~' []))))
+ (def: decode (<t>.run (json~' []))))
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 99cf151b1..d257c88ee 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -252,13 +252,15 @@
(-> Text Text)
(..enclose' ..double-quote))
+(def: #export space Text " ")
+
(def: #export (space? char)
{#.doc "Checks whether the character is white-space."}
(-> Char Bit)
(`` (case char
(^or (^ (char (~~ (static ..tab))))
(^ (char (~~ (static ..vertical-tab))))
- (^ (char " "))
+ (^ (char (~~ (static ..space))))
(^ (char (~~ (static ..new-line))))
(^ (char (~~ (static ..carriage-return))))
(^ (char (~~ (static ..form-feed)))))
diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux
index 7c8395d71..af99c6f90 100644
--- a/stdlib/source/lux/data/text/regex.lux
+++ b/stdlib/source/lux/data/text/regex.lux
@@ -4,9 +4,9 @@
monad]
[control
["." try]
- ["p" parser ("#@." monad)
- ["l" text (#+ Parser)]
- ["s" code]]]
+ ["<>" parser ("#@." monad)
+ ["<t>" text (#+ Parser)]
+ ["<c>" code]]]
[data
["." product]
["." maybe]
@@ -22,101 +22,101 @@
(def: regex-char^
(Parser Text)
- (l.none-of "\.|&()[]{}"))
+ (<t>.none-of "\.|&()[]{}"))
(def: escaped-char^
(Parser Text)
- (do p.monad
- [? (l.this? "\")]
+ (do <>.monad
+ [? (<>.parses? (<t>.this "\"))]
(if ?
- l.any
+ <t>.any
regex-char^)))
(def: (refine^ refinement^ base^)
(All [a] (-> (Parser a) (Parser Text) (Parser Text)))
- (do p.monad
+ (do <>.monad
[output base^
- _ (l.local output refinement^)]
+ _ (<t>.local output refinement^)]
(wrap output)))
(def: word^
(Parser Text)
- (p.either l.alpha-num
- (l.one-of "_")))
+ (<>.either <t>.alpha-num
+ (<t>.one-of "_")))
(def: (copy reference)
(-> Text (Parser Text))
- (p.after (l.this reference) (p@wrap reference)))
+ (<>.after (<t>.this reference) (<>@wrap reference)))
(def: (join-text^ part^)
(-> (Parser (List Text)) (Parser Text))
- (do p.monad
+ (do <>.monad
[parts part^]
(wrap (//.join-with "" parts))))
(def: name-char^
(Parser Text)
- (l.none-of (format "[]{}()s#.<>" //.double-quote)))
+ (<t>.none-of (format "[]{}()s#.<>" //.double-quote)))
(def: name-part^
(Parser Text)
- (do p.monad
- [head (refine^ (l.not l.decimal)
+ (do <>.monad
+ [head (refine^ (<t>.not <t>.decimal)
name-char^)
- tail (l.some name-char^)]
+ tail (<t>.some name-char^)]
(wrap (format head tail))))
(def: (name^ current-module)
(-> Text (Parser Name))
- ($_ p.either
- (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^)))
+ ($_ <>.either
+ (<>.and (<>@wrap current-module) (<>.after (<t>.this "..") name-part^))
+ (<>.and name-part^ (<>.after (<t>.this ".") name-part^))
+ (<>.and (<>@wrap "lux") (<>.after (<t>.this ".") name-part^))
+ (<>.and (<>@wrap "") name-part^)))
(def: (re-var^ current-module)
(-> Text (Parser Code))
- (do p.monad
- [name (l.enclosed ["\@<" ">"] (name^ current-module))]
+ (do <>.monad
+ [name (<t>.enclosed ["\@<" ">"] (name^ current-module))]
(wrap (` (: (Parser Text) (~ (code.identifier name)))))))
(def: re-range^
(Parser Code)
- (do {@ p.monad}
+ (do {@ <>.monad}
[from (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume)))
- _ (l.this "-")
+ _ (<t>.this "-")
to (|> regex-char^ (:: @ map (|>> (//.nth 0) maybe.assume)))]
- (wrap (` (l.range (~ (code.nat from)) (~ (code.nat to)))))))
+ (wrap (` (<t>.range (~ (code.nat from)) (~ (code.nat to)))))))
(def: re-char^
(Parser Code)
- (do p.monad
+ (do <>.monad
[char escaped-char^]
(wrap (` ((~! ..copy) (~ (code.text char)))))))
(def: re-options^
(Parser Code)
- (do p.monad
- [options (l.many escaped-char^)]
- (wrap (` (l.one-of (~ (code.text options)))))))
+ (do <>.monad
+ [options (<t>.many escaped-char^)]
+ (wrap (` (<t>.one-of (~ (code.text options)))))))
(def: re-user-class^'
(Parser Code)
- (do p.monad
- [negate? (p.maybe (l.this "^"))
- parts (p.many ($_ p.either
- re-range^
- re-options^))]
+ (do <>.monad
+ [negate? (<>.maybe (<t>.this "^"))
+ parts (<>.many ($_ <>.either
+ re-range^
+ re-options^))]
(wrap (case negate?
- (#.Some _) (` (l.not ($_ p.either (~+ parts))))
- #.None (` ($_ p.either (~+ parts)))))))
+ (#.Some _) (` (<t>.not ($_ <>.either (~+ parts))))
+ #.None (` ($_ <>.either (~+ parts)))))))
(def: re-user-class^
(Parser Code)
- (do p.monad
+ (do <>.monad
[_ (wrap [])
init re-user-class^'
- rest (p.some (p.after (l.this "&&") (l.enclosed ["[" "]"] re-user-class^')))]
+ rest (<>.some (<>.after (<t>.this "&&") (<t>.enclosed ["[" "]"] re-user-class^')))]
(wrap (list@fold (function (_ refinement base)
(` ((~! refine^) (~ refinement) (~ base))))
init
@@ -124,85 +124,85 @@
(def: blank^
(Parser Text)
- (l.one-of (format " " //.tab)))
+ (<t>.one-of (format " " //.tab)))
(def: ascii^
(Parser Text)
- (l.range (hex "0") (hex "7F")))
+ (<t>.range (hex "0") (hex "7F")))
(def: control^
(Parser Text)
- (p.either (l.range (hex "0") (hex "1F"))
- (l.one-of (//.from-code (hex "7F")))))
+ (<>.either (<t>.range (hex "0") (hex "1F"))
+ (<t>.one-of (//.from-code (hex "7F")))))
(def: punct^
(Parser Text)
- (l.one-of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~"
- //.double-quote)))
+ (<t>.one-of (format "!#$%&'()*+,-./:;<=>?@[\]^_`{|}~"
+ //.double-quote)))
(def: graph^
(Parser Text)
- (p.either punct^ l.alpha-num))
+ (<>.either punct^ <t>.alpha-num))
(def: print^
(Parser Text)
- (p.either graph^
- (l.one-of (//.from-code (hex "20")))))
+ (<>.either graph^
+ (<t>.one-of (//.from-code (hex "20")))))
(def: re-system-class^
(Parser Code)
- (do p.monad
+ (do <>.monad
[]
- ($_ p.either
- (p.after (l.this ".") (wrap (` l.any)))
- (p.after (l.this "\d") (wrap (` l.decimal)))
- (p.after (l.this "\D") (wrap (` (l.not l.decimal))))
- (p.after (l.this "\s") (wrap (` l.space)))
- (p.after (l.this "\S") (wrap (` (l.not l.space))))
- (p.after (l.this "\w") (wrap (` (~! word^))))
- (p.after (l.this "\W") (wrap (` (l.not (~! word^)))))
-
- (p.after (l.this "\p{Lower}") (wrap (` l.lower)))
- (p.after (l.this "\p{Upper}") (wrap (` l.upper)))
- (p.after (l.this "\p{Alpha}") (wrap (` l.alpha)))
- (p.after (l.this "\p{Digit}") (wrap (` l.decimal)))
- (p.after (l.this "\p{Alnum}") (wrap (` l.alpha-num)))
- (p.after (l.this "\p{Space}") (wrap (` l.space)))
- (p.after (l.this "\p{HexDigit}") (wrap (` l.hexadecimal)))
- (p.after (l.this "\p{OctDigit}") (wrap (` l.octal)))
- (p.after (l.this "\p{Blank}") (wrap (` (~! blank^))))
- (p.after (l.this "\p{ASCII}") (wrap (` (~! ascii^))))
- (p.after (l.this "\p{Contrl}") (wrap (` (~! control^))))
- (p.after (l.this "\p{Punct}") (wrap (` (~! punct^))))
- (p.after (l.this "\p{Graph}") (wrap (` (~! graph^))))
- (p.after (l.this "\p{Print}") (wrap (` (~! print^))))
+ ($_ <>.either
+ (<>.after (<t>.this ".") (wrap (` <t>.any)))
+ (<>.after (<t>.this "\d") (wrap (` <t>.decimal)))
+ (<>.after (<t>.this "\D") (wrap (` (<t>.not <t>.decimal))))
+ (<>.after (<t>.this "\s") (wrap (` <t>.space)))
+ (<>.after (<t>.this "\S") (wrap (` (<t>.not <t>.space))))
+ (<>.after (<t>.this "\w") (wrap (` (~! word^))))
+ (<>.after (<t>.this "\W") (wrap (` (<t>.not (~! word^)))))
+
+ (<>.after (<t>.this "\p{Lower}") (wrap (` <t>.lower)))
+ (<>.after (<t>.this "\p{Upper}") (wrap (` <t>.upper)))
+ (<>.after (<t>.this "\p{Alpha}") (wrap (` <t>.alpha)))
+ (<>.after (<t>.this "\p{Digit}") (wrap (` <t>.decimal)))
+ (<>.after (<t>.this "\p{Alnum}") (wrap (` <t>.alpha-num)))
+ (<>.after (<t>.this "\p{Space}") (wrap (` <t>.space)))
+ (<>.after (<t>.this "\p{HexDigit}") (wrap (` <t>.hexadecimal)))
+ (<>.after (<t>.this "\p{OctDigit}") (wrap (` <t>.octal)))
+ (<>.after (<t>.this "\p{Blank}") (wrap (` (~! blank^))))
+ (<>.after (<t>.this "\p{ASCII}") (wrap (` (~! ascii^))))
+ (<>.after (<t>.this "\p{Contrl}") (wrap (` (~! control^))))
+ (<>.after (<t>.this "\p{Punct}") (wrap (` (~! punct^))))
+ (<>.after (<t>.this "\p{Graph}") (wrap (` (~! graph^))))
+ (<>.after (<t>.this "\p{Print}") (wrap (` (~! print^))))
)))
(def: re-class^
(Parser Code)
- (p.either re-system-class^
- (l.enclosed ["[" "]"] re-user-class^)))
+ (<>.either re-system-class^
+ (<t>.enclosed ["[" "]"] re-user-class^)))
(def: number^
(Parser Nat)
- (|> (l.many l.decimal)
- (p.codec n.decimal)))
+ (|> (<t>.many <t>.decimal)
+ (<>.codec n.decimal)))
(def: re-back-reference^
(Parser Code)
- (p.either (do p.monad
- [_ (l.this "\")
- id number^]
- (wrap (` ((~! ..copy) (~ (code.identifier ["" (n@encode id)]))))))
- (do p.monad
- [_ (l.this "\k<")
- captured-name name-part^
- _ (l.this ">")]
- (wrap (` ((~! ..copy) (~ (code.identifier ["" captured-name]))))))))
+ (<>.either (do <>.monad
+ [_ (<t>.this "\")
+ id number^]
+ (wrap (` ((~! ..copy) (~ (code.identifier ["" (n@encode id)]))))))
+ (do <>.monad
+ [_ (<t>.this "\k<")
+ captured-name name-part^
+ _ (<t>.this ">")]
+ (wrap (` ((~! ..copy) (~ (code.identifier ["" captured-name]))))))))
(def: (re-simple^ current-module)
(-> Text (Parser Code))
- ($_ p.either
+ ($_ <>.either
re-class^
(re-var^ current-module)
re-back-reference^
@@ -211,50 +211,50 @@
(def: (re-simple-quantified^ current-module)
(-> Text (Parser Code))
- (do p.monad
+ (do <>.monad
[base (re-simple^ current-module)
- quantifier (l.one-of "?*+")]
+ quantifier (<t>.one-of "?*+")]
(case quantifier
"?"
- (wrap (` (p.default "" (~ base))))
+ (wrap (` (<>.default "" (~ base))))
"*"
- (wrap (` ((~! join-text^) (p.some (~ base)))))
+ (wrap (` ((~! join-text^) (<>.some (~ base)))))
## "+"
_
- (wrap (` ((~! join-text^) (p.many (~ base)))))
+ (wrap (` ((~! join-text^) (<>.many (~ base)))))
)))
(def: (re-counted-quantified^ current-module)
(-> Text (Parser Code))
- (do {@ p.monad}
+ (do {@ <>.monad}
[base (re-simple^ current-module)]
- (l.enclosed ["{" "}"]
- ($_ p.either
- (do @
- [[from to] (p.and number^ (p.after (l.this ",") number^))]
- (wrap (` ((~! join-text^) (p.between (~ (code.nat from))
- (~ (code.nat to))
- (~ base))))))
- (do @
- [limit (p.after (l.this ",") number^)]
- (wrap (` ((~! join-text^) (p.at-most (~ (code.nat limit)) (~ base))))))
- (do @
- [limit (p.before (l.this ",") number^)]
- (wrap (` ((~! join-text^) (p.at-least (~ (code.nat limit)) (~ base))))))
- (do @
- [limit number^]
- (wrap (` ((~! join-text^) (p.exactly (~ (code.nat limit)) (~ base))))))))))
+ (<t>.enclosed ["{" "}"]
+ ($_ <>.either
+ (do @
+ [[from to] (<>.and number^ (<>.after (<t>.this ",") number^))]
+ (wrap (` ((~! join-text^) (<>.between (~ (code.nat from))
+ (~ (code.nat to))
+ (~ base))))))
+ (do @
+ [limit (<>.after (<t>.this ",") number^)]
+ (wrap (` ((~! join-text^) (<>.at-most (~ (code.nat limit)) (~ base))))))
+ (do @
+ [limit (<>.before (<t>.this ",") number^)]
+ (wrap (` ((~! join-text^) (<>.at-least (~ (code.nat limit)) (~ base))))))
+ (do @
+ [limit number^]
+ (wrap (` ((~! join-text^) (<>.exactly (~ (code.nat limit)) (~ base))))))))))
(def: (re-quantified^ current-module)
(-> Text (Parser Code))
- (p.either (re-simple-quantified^ current-module)
- (re-counted-quantified^ current-module)))
+ (<>.either (re-simple-quantified^ current-module)
+ (re-counted-quantified^ current-module)))
(def: (re-complex^ current-module)
(-> Text (Parser Code))
- ($_ p.either
+ ($_ <>.either
(re-quantified^ current-module)
(re-simple^ current-module)))
@@ -267,9 +267,9 @@
(-> Text (Parser [Re-Group Code]))
Text
(Parser [Nat Code]))
- (do p.monad
- [parts (p.many (p.or (re-complex^ current-module)
- (re-scoped^ current-module)))
+ (do <>.monad
+ [parts (<>.many (<>.or (re-complex^ current-module)
+ (re-scoped^ current-module)))
#let [g!total (code.identifier ["" "0total"])
g!temp (code.identifier ["" "0temp"])
[_ names steps] (list@fold (: (-> (Either Code [Re-Group Code])
@@ -307,7 +307,7 @@
(wrap [(if capturing?
(list.size names)
0)
- (` (do p.monad
+ (` (do <>.monad
[(~ (' #let)) [(~ g!total) ""]
(~+ (|> steps list.reverse list@join))]
((~ (' wrap)) [(~ g!total) (~+ (list.reverse names))])))])
@@ -315,7 +315,7 @@
(def: (unflatten^ lexer)
(-> (Parser Text) (Parser [Text Any]))
- (p.and lexer (:: p.monad wrap [])))
+ (<>.and lexer (:: <>.monad wrap [])))
(def: (|||^ left right)
(All [l r] (-> (Parser [Text l]) (Parser [Text r]) (Parser [Text (| l r)])))
@@ -358,10 +358,10 @@
(-> Text (Parser [Re-Group Code]))
Text
(Parser [Nat Code]))
- (do p.monad
+ (do <>.monad
[#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)]
head sub^
- tail (p.some (p.after (l.this "|") sub^))]
+ tail (<>.some (<>.after (<t>.this "|") sub^))]
(if (list.empty? tail)
(wrap head)
(wrap [(list@fold n.max (product.left head) (list@map product.left tail))
@@ -373,33 +373,33 @@
(def: (re-scoped^ current-module)
(-> Text (Parser [Re-Group Code]))
- ($_ p.either
- (do p.monad
- [_ (l.this "(?:")
+ ($_ <>.either
+ (do <>.monad
+ [_ (<t>.this "(?:")
[_ scoped] (re-alternative^ #0 re-scoped^ current-module)
- _ (l.this ")")]
+ _ (<t>.this ")")]
(wrap [#Non-Capturing scoped]))
- (do p.monad
+ (do <>.monad
[complex (re-complex^ current-module)]
(wrap [#Non-Capturing complex]))
- (do p.monad
- [_ (l.this "(?<")
+ (do <>.monad
+ [_ (<t>.this "(?<")
captured-name name-part^
- _ (l.this ">")
+ _ (<t>.this ">")
[num-captures pattern] (re-alternative^ #1 re-scoped^ current-module)
- _ (l.this ")")]
+ _ (<t>.this ")")]
(wrap [(#Capturing [(#.Some captured-name) num-captures]) pattern]))
- (do p.monad
- [_ (l.this "(")
+ (do <>.monad
+ [_ (<t>.this "(")
[num-captures pattern] (re-alternative^ #1 re-scoped^ current-module)
- _ (l.this ")")]
+ _ (<t>.this ")")]
(wrap [(#Capturing [#.None num-captures]) pattern]))))
(def: (regex^ current-module)
(-> Text (Parser Code))
- (:: p.monad map product.right (re-alternative^ #1 re-scoped^ current-module)))
+ (:: <>.monad map product.right (re-alternative^ #1 re-scoped^ current-module)))
-(syntax: #export (regex {pattern s.text})
+(syntax: #export (regex {pattern <c>.text})
{#.doc (doc "Create lexers using regular-expression syntax."
"For example:"
@@ -460,9 +460,8 @@
)}
(do macro.monad
[current-module macro.current-module-name]
- (case (l.run (p.before l.end
- (regex^ current-module))
- pattern)
+ (case (<t>.run (regex^ current-module)
+ pattern)
(#try.Failure error)
(macro.fail (format "Error while parsing regular-expression:" //.new-line
error))
@@ -471,9 +470,9 @@
(wrap (list regex))
)))
-(syntax: #export (^regex {[pattern bindings] (s.form (p.and s.text (p.maybe s.any)))}
+(syntax: #export (^regex {[pattern bindings] (<c>.form (<>.and <c>.text (<>.maybe <c>.any)))}
body
- {branches (p.many s.any)})
+ {branches (<>.many <c>.any)})
{#.doc (doc "Allows you to test text against regular expressions."
(case some-text
(^regex "(\d{3})-(\d{3})-(\d{4})"
@@ -487,7 +486,7 @@
do-something-else))}
(with-gensyms [g!temp]
(wrap (list& (` (^multi (~ g!temp)
- [((~! l.run) (..regex (~ (code.text pattern))) (~ g!temp))
+ [((~! <t>.run) (..regex (~ (code.text pattern))) (~ g!temp))
(#try.Success (~ (maybe.default g!temp bindings)))]))
body
branches))))
diff --git a/stdlib/source/lux/data/text/unicode.lux b/stdlib/source/lux/data/text/unicode.lux
index cbead2be1..6a4192b4c 100644
--- a/stdlib/source/lux/data/text/unicode.lux
+++ b/stdlib/source/lux/data/text/unicode.lux
@@ -184,6 +184,7 @@
[tags "E0000" "E007F"]
## Specialized segments
+ [basic-latin/decimal "0030" "0039"]
[basic-latin/upper-alpha "0041" "005A"]
[basic-latin/lower-alpha "0061" "007A"]
)
@@ -352,6 +353,7 @@
[ascii (list basic-latin)]
[ascii/alpha (list basic-latin/upper-alpha basic-latin/lower-alpha)]
+ [ascii/alpha-num (list basic-latin/upper-alpha basic-latin/lower-alpha basic-latin/decimal)]
[ascii/upper-alpha (list basic-latin/upper-alpha)]
[ascii/lower-alpha (list basic-latin/lower-alpha)]
)
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 6fb29097f..c59de8e92 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1220,7 +1220,7 @@
(type.class "java.lang.Object" (list)))
(syntax: #export (class:
- {#let [@ macro.monad
+ {#let [@ <>.monad
imports (..context *compiler*)]}
{im inheritance-modifier^}
{[full-class-name class-vars] (:: @ map parser.declaration (declaration^ imports))}
@@ -1281,7 +1281,7 @@
[(~+ (list@map (method-def$ replacer super) methods))]))))))
(syntax: #export (interface:
- {#let [@ macro.monad
+ {#let [@ <>.monad
imports (..context *compiler*)]}
{[full-class-name class-vars] (:: @ map parser.declaration (declaration^ imports))}
{#let [imports (add-import [(short-class-name full-class-name) full-class-name]
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index 1bca37621..744a94a89 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -16,7 +16,7 @@
["c" complex]
["f" frac]]
["." text (#+ Char) ("#@." monoid)
- ["." unicode (#+ Segment)]]
+ ["." unicode]]
[collection
["." list ("#@." fold)]
["." array (#+ Array)]
@@ -44,13 +44,17 @@
{#.doc "A producer of random values based on a PRNG."}
(-> PRNG [PRNG a]))
-(structure: #export functor (Functor Random)
+(structure: #export functor
+ (Functor Random)
+
(def: (map f fa)
(function (_ state)
(let [[state' a] (fa state)]
[state' (f a)]))))
-(structure: #export apply (Apply Random)
+(structure: #export apply
+ (Apply Random)
+
(def: &functor ..functor)
(def: (apply ff fa)
@@ -59,7 +63,9 @@
[state'' a] (fa state')]
[state'' (f a)]))))
-(structure: #export monad (Monad Random)
+(structure: #export monad
+ (Monad Random)
+
(def: &functor ..functor)
(def: (wrap a)
@@ -162,6 +168,7 @@
[unicode unicode.full]
[ascii unicode.ascii]
[ascii/alpha unicode.ascii/alpha]
+ [ascii/alpha-num unicode.ascii/alpha-num]
[ascii/upper-alpha unicode.ascii/upper-alpha]
[ascii/lower-alpha unicode.ascii/lower-alpha]
)
diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux
index d4f2568eb..860d4b7bc 100644
--- a/stdlib/source/test/lux/control/parser/text.lux
+++ b/stdlib/source/test/lux/control/parser/text.lux
@@ -1,174 +1,419 @@
(.module:
[lux #*
- [data
- ["." name]]
["_" test (#+ Test)]
- [abstract/monad (#+ do)]
+ [abstract
+ [monad (#+ do)]]
[control
- pipe
["." try (#+ Try)]
- ["p" parser]]
+ ["." exception]
+ ["." function]]
[data
- ["." text ("#@." equivalence)]
+ ["." maybe]
+ ["." text ("#@." equivalence)
+ ["." unicode]
+ ["%" format (#+ format)]]
[number
["n" nat]]
[collection
- ["." list]]]
+ ["." set]
+ ["." list ("#@." functor)]]]
[math
- ["r" random]]]
+ ["." random]]
+ [macro
+ ["." code]]]
{1
- ["." /]})
+ ["." /
+ ["<>" //
+ ["<c>" code]]]})
+
+(template: (!expect <pattern> <value>)
+ (case <value>
+ <pattern>
+ true
+
+ _
+ false))
-(def: (should-fail input)
- (All [a] (-> (Try a) Bit))
- (case input
+(def: (should-fail sample parser)
+ (All [a] (-> Text (/.Parser a) Bit))
+ (case (/.run parser sample)
(#try.Failure _)
true
_
false))
-(def: (should-pass reference sample)
- (-> Text (Try Text) Bit)
- (|> sample
- (:: try.functor map (text@= reference))
+(def: (should-pass expected parser)
+ (-> Text (/.Parser Text) Bit)
+ (|> expected
+ (/.run parser)
+ (:: try.functor map (text@= expected))
(try.default false)))
+(def: (should-pass! expected parser)
+ (-> Text (/.Parser /.Slice) Bit)
+ (..should-pass expected (/.slice parser)))
+
+(def: character-classes
+ Test
+ ($_ _.and
+ (do {@ random.monad}
+ [offset (:: @ map (n.% 50) random.nat)
+ range (:: @ map (|>> (n.% 50) (n.+ 10)) random.nat)
+ #let [limit (n.+ offset range)]
+ expected (:: @ map (|>> (n.% range) (n.+ offset) text.from-code) random.nat)
+ out-of-range (case offset
+ 0 (:: @ map (|>> (n.% 10) inc (n.+ limit) text.from-code) random.nat)
+ _ (:: @ map (|>> (n.% offset) text.from-code) random.nat))]
+ (_.cover [/.range]
+ (and (..should-pass expected (/.range offset limit))
+ (..should-fail out-of-range (/.range offset limit)))))
+ (do {@ random.monad}
+ [expected (random.char unicode.ascii/upper-alpha)
+ invalid (random.filter (|>> (unicode.within? unicode.basic-latin/upper-alpha) not)
+ (random.char unicode.full))]
+ (_.cover [/.upper]
+ (and (..should-pass (text.from-code expected) /.upper)
+ (..should-fail (text.from-code invalid) /.upper))))
+ (do {@ random.monad}
+ [expected (random.char unicode.ascii/lower-alpha)
+ invalid (random.filter (|>> (unicode.within? unicode.basic-latin/lower-alpha) not)
+ (random.char unicode.full))]
+ (_.cover [/.lower]
+ (and (..should-pass (text.from-code expected) /.lower)
+ (..should-fail (text.from-code invalid) /.lower))))
+ (do {@ random.monad}
+ [expected (:: @ map (n.% 10) random.nat)
+ invalid (random.char (unicode.set (list unicode.aegean-numbers)))]
+ (_.cover [/.decimal]
+ (and (..should-pass (:: n.decimal encode expected) /.decimal)
+ (..should-fail (text.from-code invalid) /.decimal))))
+ (do {@ random.monad}
+ [expected (:: @ map (n.% 8) random.nat)
+ invalid (random.char (unicode.set (list unicode.aegean-numbers)))]
+ (_.cover [/.octal]
+ (and (..should-pass (:: n.octal encode expected) /.octal)
+ (..should-fail (text.from-code invalid) /.octal))))
+ (do {@ random.monad}
+ [expected (:: @ map (n.% 16) random.nat)
+ invalid (random.char (unicode.set (list unicode.aegean-numbers)))]
+ (_.cover [/.hexadecimal]
+ (and (..should-pass (:: n.hex encode expected) /.hexadecimal)
+ (..should-fail (text.from-code invalid) /.hexadecimal))))
+ (do {@ random.monad}
+ [expected (random.char unicode.ascii/alpha)
+ invalid (random.filter (function (_ char)
+ (not (or (unicode.within? unicode.basic-latin/upper-alpha char)
+ (unicode.within? unicode.basic-latin/lower-alpha char))))
+ (random.char unicode.full))]
+ (_.cover [/.alpha]
+ (and (..should-pass (text.from-code expected) /.alpha)
+ (..should-fail (text.from-code invalid) /.alpha))))
+ (do {@ random.monad}
+ [expected (random.char unicode.ascii/alpha-num)
+ invalid (random.filter (function (_ char)
+ (not (or (unicode.within? unicode.basic-latin/upper-alpha char)
+ (unicode.within? unicode.basic-latin/lower-alpha char)
+ (unicode.within? unicode.basic-latin/decimal char))))
+ (random.char unicode.full))]
+ (_.cover [/.alpha-num]
+ (and (..should-pass (text.from-code expected) /.alpha-num)
+ (..should-fail (text.from-code invalid) /.alpha-num))))
+ (do {@ random.monad}
+ [expected ($_ random.either
+ (wrap text.tab)
+ (wrap text.vertical-tab)
+ (wrap text.space)
+ (wrap text.new-line)
+ (wrap text.carriage-return)
+ (wrap text.form-feed))
+ invalid (|> (random.unicode 1) (random.filter (function (_ char)
+ (not (or (text@= text.tab char)
+ (text@= text.vertical-tab char)
+ (text@= text.space char)
+ (text@= text.new-line char)
+ (text@= text.carriage-return char)
+ (text@= text.form-feed char))))))]
+ (_.cover [/.space]
+ (and (..should-pass expected /.space)
+ (..should-fail invalid /.space))))
+ (do {@ random.monad}
+ [#let [num-options 3]
+ options (|> (random.char unicode.full)
+ (random.set n.hash num-options)
+ (:: @ map (|>> set.to-list
+ (list@map text.from-code)
+ (text.join-with ""))))
+ expected (:: @ map (function (_ value)
+ (|> options
+ (text.nth (n.% num-options value))
+ maybe.assume))
+ random.nat)
+ invalid (random.filter (|>> text.from-code
+ (text.contains? options)
+ not)
+ (random.char unicode.full))]
+ (_.cover [/.one-of /.one-of!]
+ (and (..should-pass (text.from-code expected) (/.one-of options))
+ (..should-fail (text.from-code invalid) (/.one-of options))
+
+ (..should-pass! (text.from-code expected) (/.one-of! options))
+ (..should-fail (text.from-code invalid) (/.one-of options)))))
+ (do {@ random.monad}
+ [#let [num-options 3]
+ options (|> (random.char unicode.full)
+ (random.set n.hash num-options)
+ (:: @ map (|>> set.to-list
+ (list@map text.from-code)
+ (text.join-with ""))))
+ invalid (:: @ map (function (_ value)
+ (|> options
+ (text.nth (n.% num-options value))
+ maybe.assume))
+ random.nat)
+ expected (random.filter (|>> text.from-code
+ (text.contains? options)
+ not)
+ (random.char unicode.full))]
+ (_.cover [/.none-of /.none-of!]
+ (and (..should-pass (text.from-code expected) (/.none-of options))
+ (..should-fail (text.from-code invalid) (/.none-of options))
+
+ (..should-pass! (text.from-code expected) (/.none-of! options))
+ (..should-fail (text.from-code invalid) (/.none-of! options)))))
+ ))
+
+(def: runs
+ Test
+ (let [octal! (/.one-of! "01234567")]
+ ($_ _.and
+ (do {@ random.monad}
+ [left (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)
+ right (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)
+ #let [expected (format left right)]
+ invalid (|> random.nat
+ (:: @ map (n.% 16))
+ (random.filter (n.>= 8))
+ (:: @ map (:: n.hex encode)))]
+ (_.cover [/.many /.many!]
+ (and (..should-pass expected (/.many /.octal))
+ (..should-fail invalid (/.many /.octal))
+
+ (..should-pass! expected (/.many! octal!)))))
+ (do {@ random.monad}
+ [left (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)
+ right (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)
+ #let [expected (format left right)]
+ invalid (|> random.nat
+ (:: @ map (n.% 16))
+ (random.filter (n.>= 8))
+ (:: @ map (:: n.hex encode)))]
+ (_.cover [/.some /.some!]
+ (and (..should-pass expected (/.some /.octal))
+ (..should-pass "" (/.some /.octal))
+ (..should-fail invalid (/.some /.octal))
+
+ (..should-pass! expected (/.some! octal!))
+ (..should-pass! "" (/.some! octal!)))))
+ (do {@ random.monad}
+ [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
+ first octal
+ second octal
+ third octal]
+ (_.cover [/.exactly /.exactly!]
+ (and (..should-pass (format first second) (/.exactly 2 /.octal))
+ (..should-fail (format first second third) (/.exactly 2 /.octal))
+ (..should-fail (format first) (/.exactly 2 /.octal))
+
+ (..should-pass! (format first second) (/.exactly! 2 octal!))
+ (..should-fail (format first second third) (/.exactly! 2 octal!))
+ (..should-fail (format first) (/.exactly! 2 octal!)))))
+ (do {@ random.monad}
+ [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
+ first octal
+ second octal
+ third octal]
+ (_.cover [/.at-most /.at-most!]
+ (and (..should-pass (format first second) (/.at-most 2 /.octal))
+ (..should-pass (format first) (/.at-most 2 /.octal))
+ (..should-fail (format first second third) (/.at-most 2 /.octal))
+
+ (..should-pass! (format first second) (/.at-most! 2 octal!))
+ (..should-pass! (format first) (/.at-most! 2 octal!))
+ (..should-fail (format first second third) (/.at-most! 2 octal!)))))
+ (do {@ random.monad}
+ [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
+ first octal
+ second octal
+ third octal]
+ (_.cover [/.at-least /.at-least!]
+ (and (..should-pass (format first second) (/.at-least 2 /.octal))
+ (..should-pass (format first second third) (/.at-least 2 /.octal))
+ (..should-fail (format first) (/.at-least 2 /.octal))
+
+ (..should-pass! (format first second) (/.at-least! 2 octal!))
+ (..should-pass! (format first second third) (/.at-least! 2 octal!))
+ (..should-fail (format first) (/.at-least! 2 octal!)))))
+ (do {@ random.monad}
+ [#let [octal (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
+ first octal
+ second octal
+ third octal]
+ (_.cover [/.between /.between!]
+ (and (..should-pass (format first second) (/.between 2 3 /.octal))
+ (..should-pass (format first second third) (/.between 2 3 /.octal))
+ (..should-fail (format first) (/.between 2 3 /.octal))
+
+ (..should-pass! (format first second) (/.between! 2 3 octal!))
+ (..should-pass! (format first second third) (/.between! 2 3 octal!))
+ (..should-fail (format first) (/.between! 2 3 octal!)))))
+ )))
+
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
+ (<| (_.covering /._)
+ (_.with-cover [/.Parser])
($_ _.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 /.end
- sample)
- (case> (#.Left _) true _ false)))
- (_.test "Can find literal text fragments."
- (and (|> (/.run (/.this sample)
- sample)
- (case> (#.Right []) true _ false))
- (|> (/.run (/.this sample)
- non-sample)
- (case> (#.Left _) true _ false))))
- ))
- ($_ _.and
- (_.test "Can lex anything"
- (and (should-pass "A" (/.run /.any
- "A"))
- (should-fail (/.run /.any
- ""))))
-
- (_.test "Can lex characters ranges."
- (and (should-pass "Y" (/.run (/.range (char "X") (char "Z"))
- "Y"))
- (should-fail (/.run (/.range (char "X") (char "Z"))
- "M"))))
-
- (_.test "Can lex upper-case and lower-case letters."
- (and (should-pass "Y" (/.run /.upper
- "Y"))
- (should-fail (/.run /.upper
- "m"))
-
- (should-pass "y" (/.run /.lower
- "y"))
- (should-fail (/.run /.lower
- "M"))))
-
- (_.test "Can lex numbers."
- (and (should-pass "1" (/.run /.decimal
- "1"))
- (should-fail (/.run /.decimal
- " "))
-
- (should-pass "7" (/.run /.octal
- "7"))
- (should-fail (/.run /.octal
- "8"))
-
- (should-pass "1" (/.run /.hexadecimal
- "1"))
- (should-pass "a" (/.run /.hexadecimal
- "a"))
- (should-pass "A" (/.run /.hexadecimal
- "A"))
- (should-fail (/.run /.hexadecimal
- " "))
- ))
-
- (_.test "Can lex alphabetic characters."
- (and (should-pass "A" (/.run /.alpha
- "A"))
- (should-pass "a" (/.run /.alpha
- "a"))
- (should-fail (/.run /.alpha
- "1"))))
-
- (_.test "Can lex alphanumeric characters."
- (and (should-pass "A" (/.run /.alpha-num
- "A"))
- (should-pass "a" (/.run /.alpha-num
- "a"))
- (should-pass "1" (/.run /.alpha-num
- "1"))
- (should-fail (/.run /.alpha-num
- " "))))
-
- (_.test "Can lex white-space."
- (and (should-pass " " (/.run /.space
- " "))
- (should-fail (/.run /.space
- "8"))))
- )
- ($_ _.and
- (_.test "Can combine lexers sequentially."
- (and (|> (/.run (p.and /.any /.any)
- "YO")
- (case> (#.Right ["Y" "O"]) true
- _ false))
- (should-fail (/.run (p.and /.any /.any)
- "Y"))))
-
- (_.test "Can create the opposite of a lexer."
- (and (should-pass "a" (/.run (/.not (p.or /.decimal /.upper))
- "a"))
- (should-fail (/.run (/.not (p.or /.decimal /.upper))
- "A"))))
-
- (_.test "Can select from among a set of characters."
- (and (should-pass "C" (/.run (/.one-of "ABC")
- "C"))
- (should-fail (/.run (/.one-of "ABC")
- "D"))))
-
- (_.test "Can avoid a set of characters."
- (and (should-pass "D" (/.run (/.none-of "ABC")
- "D"))
- (should-fail (/.run (/.none-of "ABC")
- "C"))))
-
- (_.test "Can lex using arbitrary predicates."
- (and (should-pass "D" (/.run (/.satisfies (function (_ c) true))
- "D"))
- (should-fail (/.run (/.satisfies (function (_ c) false))
- "C"))))
-
- (_.test "Can apply a lexer multiple times."
- (and (should-pass "0123456789ABCDEF" (/.run (/.many /.hexadecimal)
- "0123456789ABCDEF"))
- (should-fail (/.run (/.many /.hexadecimal)
- "yolo"))
-
- (should-pass "" (/.run (/.some /.hexadecimal)
- ""))))
- )
+ (do {@ random.monad}
+ [sample (random.unicode 1)]
+ (_.cover [/.run /.end!]
+ (and (|> (/.run /.end!
+ "")
+ (!expect (#try.Success _)))
+ (|> (/.run /.end!
+ sample)
+ (!expect (#try.Failure _))))))
+ (do {@ random.monad}
+ [#let [size 10]
+ expected (random.unicode size)
+ dummy (|> (random.unicode size)
+ (random.filter (|>> (text@= expected) not)))]
+ (_.cover [/.this]
+ (and (|> (/.run (/.this expected)
+ expected)
+ (!expect (#try.Success [])))
+ (|> (/.run (/.this expected)
+ dummy)
+ (!expect (#try.Failure _))))))
+ (do {@ random.monad}
+ [expected (random.unicode 1)]
+ (_.cover [/.Slice /.slice /.cannot-slice]
+ (|> ""
+ (/.run (/.slice /.any!))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.cannot-slice error))))))
+ (do {@ random.monad}
+ [expected (random.unicode 1)]
+ (_.cover [/.any /.any!]
+ (and (..should-pass expected /.any)
+ (..should-fail "" /.any)
+
+ (..should-pass! expected /.any!)
+ (..should-fail "" /.any!))))
+ (do {@ random.monad}
+ [expected (random.unicode 1)]
+ (_.cover [/.peek /.cannot-parse]
+ (and (..should-pass expected (<>.before /.any /.peek))
+ (|> ""
+ (/.run (<>.before /.any /.peek))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.cannot-parse error)))))))
+ (do {@ random.monad}
+ [dummy (random.unicode 1)]
+ (_.cover [/.unconsumed-input]
+ (|> (format dummy dummy)
+ (/.run /.any)
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.unconsumed-input error))))))
+ (do {@ random.monad}
+ [sample (random.unicode 1)]
+ (_.cover [/.Offset /.offset]
+ (|> sample
+ (/.run (do <>.monad
+ [pre /.offset
+ _ /.any
+ post /.offset]
+ (wrap [pre post])))
+ (!expect (#try.Success [0 1])))))
+ (do {@ random.monad}
+ [left (random.unicode 1)
+ right (random.unicode 1)
+ #let [input (format left right)]]
+ (_.cover [/.get-input]
+ (|> input
+ (/.run (do <>.monad
+ [pre /.get-input
+ _ /.any
+ post /.get-input]
+ (wrap (and (text@= input pre)
+ (text@= right post)))))
+ (!expect (#try.Success #1)))))
+ (do {@ random.monad}
+ [left (random.unicode 1)
+ right (random.unicode 1)
+ expected (random.filter (|>> (text@= right) not)
+ (random.unicode 1))]
+ (_.cover [/.enclosed]
+ (|> (format left expected right)
+ (/.run (/.enclosed [left right] (/.this expected)))
+ (!expect (#try.Success _)))))
+ (do {@ random.monad}
+ [in (random.unicode 1)
+ out (random.unicode 1)]
+ (_.cover [/.local]
+ (|> out
+ (/.run (do <>.monad
+ [_ (/.local in (/.this in))]
+ (/.this out)))
+ (!expect (#try.Success _)))))
+ (do {@ random.monad}
+ [expected (:: @ map (|>> (n.% 8) (:: n.octal encode)) random.nat)]
+ (_.cover [/.embed]
+ (|> (list (code.text expected))
+ (<c>.run (/.embed /.octal <c>.text))
+ (!expect (^multi (#try.Success actual)
+ (text@= expected actual))))))
+ (do {@ random.monad}
+ [invalid (random.ascii/upper-alpha 1)
+ expected (random.filter (|>> (unicode.within? unicode.basic-latin/upper-alpha)
+ not)
+ (random.char unicode.full))
+ #let [upper! (/.one-of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]]
+ (_.cover [/.not /.not! /.expected-to-fail]
+ (and (..should-pass (text.from-code expected) (/.not /.upper))
+ (|> invalid
+ (/.run (/.not /.upper))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.expected-to-fail error))))
+
+ (..should-pass! (text.from-code expected) (/.not! upper!))
+ (|> invalid
+ (/.run (/.not! upper!))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.expected-to-fail error)))))))
+ (do {@ random.monad}
+ [upper (random.ascii/upper-alpha 1)
+ lower (random.ascii/lower-alpha 1)
+ invalid (random.filter (function (_ char)
+ (not (or (unicode.within? unicode.basic-latin/upper-alpha char)
+ (unicode.within? unicode.basic-latin/lower-alpha char))))
+ (random.char unicode.full))
+ #let [upper! (/.one-of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ lower! (/.one-of! "abcdefghijklmnopqrstuvwxyz")]]
+ (_.cover [/.and /.and!]
+ (and (..should-pass (format upper lower) (/.and /.upper /.lower))
+ (..should-fail (format (text.from-code invalid) lower) (/.and /.upper /.lower))
+ (..should-fail (format upper (text.from-code invalid)) (/.and /.upper /.lower))
+
+ (..should-pass! (format upper lower) (/.and! upper! lower!))
+ (..should-fail (format (text.from-code invalid) lower) (/.and! upper! lower!))
+ (..should-fail (format upper (text.from-code invalid)) (/.and! upper! lower!)))))
+ (do {@ random.monad}
+ [expected (random.unicode 1)
+ invalid (random.unicode 1)]
+ (_.cover [/.satisfies]
+ (and (..should-pass expected (/.satisfies (function.constant true)))
+ (..should-fail invalid (/.satisfies (function.constant false))))))
+ ..character-classes
+ ..runs
)))