diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/control/parser.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/lux/control/parser/synthesis.lux | 18 | ||||
| -rw-r--r-- | stdlib/source/lux/control/parser/text.lux | 35 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 101 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text/regex.lux | 277 | ||||
| -rw-r--r-- | stdlib/source/lux/data/text/unicode.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/host.jvm.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/math/random.lux | 15 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/parser/text.lux | 545 |
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 ))) |