(.using [library [lux (.except) ["_" test (.only Test)] [abstract [monad (.only do)]] [control ["[0]" pipe] ["[0]" try] [parser ["<[0]>" code]]] [data ["[0]" text (.open: "[1]#[0]" equivalence) ["%" \\format (.only format)] ["<[1]>" \\parser (.only Parser)]]] ["[0]" macro (.only) [syntax (.only syntax)] ["[0]" code]] [math [number (.only hex)] ["[0]" random]]]] [\\library ["[0]" /]]) (def: (should_pass regex input) (-> (Parser Text) Text Bit) (|> input (.result regex) (pipe.case {try.#Success parsed} (text#= parsed input) _ #0))) (def: (text_should_pass test regex input) (-> Text (Parser Text) Text Bit) (|> input (.result regex) (pipe.case {try.#Success parsed} (text#= test parsed) _ false))) (def: (should_fail regex input) (All (_ a) (-> (Parser a) Text Bit)) (|> input (.result regex) (pipe.case {try.#Failure _} true _ false))) (def: should_check (syntax (_ [pattern .any regex .any input .any]) (macro.with_symbols [g!message g!_] (in (list (` (|> (~ input) (.result (~ regex)) (pipe.case (pattern {try.#Success (~ pattern)}) true (~ g!_) false)))))))) (def: basics Test (_.property "Can parse character literals." (and (should_pass (/.regex "a") "a") (should_fail (/.regex "a") ".") (should_pass (/.regex "\.") ".") (should_fail (/.regex "\.") "a")))) (def: system_character_classes Test (all _.and (_.property "Can parse anything." (should_pass (/.regex ".") "a")) (_.property "Can parse digits." (and (should_pass (/.regex "\d") "0") (should_fail (/.regex "\d") "m"))) (_.property "Can parse non digits." (and (should_pass (/.regex "\D") "m") (should_fail (/.regex "\D") "0"))) (_.property "Can parse white-space." (and (should_pass (/.regex "\s") " ") (should_fail (/.regex "\s") "m"))) (_.property "Can parse non white-space." (and (should_pass (/.regex "\S") "m") (should_fail (/.regex "\S") " "))) (_.property "Can parse word characters." (and (should_pass (/.regex "\w") "_") (should_fail (/.regex "\w") "^"))) (_.property "Can parse non word characters." (and (should_pass (/.regex "\W") ".") (should_fail (/.regex "\W") "a"))) )) (def: special_system_character_classes Test (all _.and (_.property "Lower-case." (and (should_pass (/.regex "\p{Lower}") "m") (should_fail (/.regex "\p{Lower}") "M"))) (_.property "Upper-case." (and (should_pass (/.regex "\p{Upper}") "M") (should_fail (/.regex "\p{Upper}") "m"))) (_.property "Alphabetic." (and (should_pass (/.regex "\p{Alpha}") "M") (should_fail (/.regex "\p{Alpha}") "0"))) (_.property "Numeric digits." (and (should_pass (/.regex "\p{Digit}") "1") (should_fail (/.regex "\p{Digit}") "n"))) (_.property "Alphanumeric." (and (should_pass (/.regex "\p{Alnum}") "1") (should_fail (/.regex "\p{Alnum}") "."))) (_.property "Whitespace." (and (should_pass (/.regex "\p{Space}") " ") (should_fail (/.regex "\p{Space}") "."))) (_.property "Hexadecimal." (and (should_pass (/.regex "\p{HexDigit}") "a") (should_fail (/.regex "\p{HexDigit}") "."))) (_.property "Octal." (and (should_pass (/.regex "\p{OctDigit}") "6") (should_fail (/.regex "\p{OctDigit}") "."))) (_.property "Blank." (and (should_pass (/.regex "\p{Blank}") text.tab) (should_fail (/.regex "\p{Blank}") "."))) (_.property "ASCII." (and (should_pass (/.regex "\p{ASCII}") text.tab) (should_fail (/.regex "\p{ASCII}") (text.of_char (hex "1234"))))) (_.property "Control characters." (and (should_pass (/.regex "\p{Contrl}") (text.of_char (hex "12"))) (should_fail (/.regex "\p{Contrl}") "a"))) (_.property "Punctuation." (and (should_pass (/.regex "\p{Punct}") "@") (should_fail (/.regex "\p{Punct}") "a"))) (_.property "Graph." (and (should_pass (/.regex "\p{Graph}") "@") (should_fail (/.regex "\p{Graph}") " "))) (_.property "Print." (and (should_pass (/.regex "\p{Print}") (text.of_char (hex "20"))) (should_fail (/.regex "\p{Print}") (text.of_char (hex "1234"))))) )) (def: custom_character_classes Test (all _.and (_.property "Can parse using custom character classes." (and (should_pass (/.regex "[abc]") "a") (should_fail (/.regex "[abc]") "m"))) (_.property "Can parse using character ranges." (and (should_pass (/.regex "[a-z]") "a") (should_pass (/.regex "[a-z]") "m") (should_pass (/.regex "[a-z]") "z"))) (_.property "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"))) (_.property "Can negate custom character classes." (and (should_fail (/.regex "[^abc]") "a") (should_pass (/.regex "[^abc]") "m"))) (_.property "Can negate character ranges.." (and (should_fail (/.regex "[^a-z]") "a") (should_pass (/.regex "[^a-z]") "0"))) (_.property "Can parse negate combinations of character ranges." (and (should_fail (/.regex "[^a-zA-Z]") "a") (should_pass (/.regex "[^a-zA-Z]") "0"))) (_.property "Can make custom character classes more specific." (and (let [RE (/.regex "[a-z&&[def]]")] (and (should_fail RE "a") (should_pass RE "d"))) (let [RE (/.regex "[a-z&&[^bc]]")] (and (should_pass RE "a") (should_fail RE "b"))) (let [RE (/.regex "[a-z&&[^m-p]]")] (and (should_pass RE "a") (should_fail RE "m") (should_fail RE "p"))))) )) (def: references Test (let [number (/.regex "\d+")] (_.property "Can build complex regexs by combining simpler ones." (should_check ["809-345-6789" "809" "345" "6789"] (/.regex "(\@)-(\@)-(\@)") "809-345-6789")))) (def: fuzzy_quantifiers Test (all _.and (_.property "Can sequentially combine patterns." (text_should_pass "aa" (/.regex "aa") "aa")) (_.property "Can match patterns optionally." (and (text_should_pass "a" (/.regex "a?") "a") (text_should_pass "" (/.regex "a?") ""))) (_.property "Can match a pattern 0 or more times." (and (text_should_pass "aaa" (/.regex "a*") "aaa") (text_should_pass "" (/.regex "a*") ""))) (_.property "Can match a pattern 1 or more times." (and (text_should_pass "aaa" (/.regex "a+") "aaa") (text_should_pass "a" (/.regex "a+") "a") (should_fail (/.regex "a+") ""))) )) (def: crisp_quantifiers Test (all _.and (_.property "Can match a pattern N times." (and (text_should_pass "aa" (/.regex "a{2}") "aa") (text_should_pass "a" (/.regex "a{1}") "a") (should_fail (/.regex "a{3}") "aa"))) (_.property "Can match a pattern at-least N times." (and (text_should_pass "aa" (/.regex "a{1,}") "aa") (text_should_pass "aa" (/.regex "a{2,}") "aa") (should_fail (/.regex "a{3,}") "aa"))) (_.property "Can match a pattern at-most N times." (and (text_should_pass "aa" (/.regex "a{,2}") "aa") (text_should_pass "aa" (/.regex "a{,3}") "aa"))) (_.property "Can match a pattern between N and M times." (and (text_should_pass "a" (/.regex "a{1,2}") "a") (text_should_pass "aa" (/.regex "a{1,2}") "aa"))) )) (def: groups Test (all _.and (_.property "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 "(?\d{3})-\k-(\d{4})") "809-809-6789") (should_check ["809-809-6789-6789" "809" "6789"] (/.regex "(?\d{3})-\k-(\d{4})-\0") "809-809-6789-6789"))) (_.property "Can specify groups within groups." (should_check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (/.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) )) (def: alternation Test (all _.and (_.property "Can specify alternative patterns." (and (should_check ["a" {0 #0 []}] (/.regex "a|b") "a") (should_check ["b" {0 #1 []}] (/.regex "a|b") "b") (should_fail (/.regex "a|b") "c"))) (_.property "Can have groups within alternations." (and (should_check ["abc" {0 #0 ["b" "c"]}] (/.regex "a(.)(.)|b(.)(.)") "abc") (should_check ["bcd" {0 #1 ["c" "d"]}] (/.regex "a(.)(.)|b(.)(.)") "bcd") (should_fail (/.regex "a(.)(.)|b(.)(.)") "cde") (should_check ["123-456-7890" {0 #0 ["123" "456-7890" "456" "7890"]}] (/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") "123-456-7890"))) )) (def: expands? (syntax (_ [form .any]) (function (_ lux) {try.#Success [lux (list (code.bit (case (macro.single_expansion form lux) {try.#Success _} true {try.#Failure error} false)))]}))) (def: .public test Test (<| (_.covering /._) (all _.and (_.for [/.regex] (all _.and ..basics ..system_character_classes ..special_system_character_classes ..custom_character_classes ..references ..fuzzy_quantifiers ..crisp_quantifiers ..groups ..alternation )) (do random.monad [sample1 (random.unicode 3) sample2 (random.unicode 3) sample3 (random.unicode 4)] (_.coverage [/.pattern] (case (format sample1 "-" sample2 "-" sample3) (/.pattern "(.{3})-(.{3})-(.{4})" [_ match1 match2 match3]) (and (text#= sample1 match1) (text#= sample2 match2) (text#= sample3 match3)) _ false))) (_.coverage [/.incorrect_quantification] (and (expands? (/.regex "a{1,2}")) (not (expands? (/.regex "a{2,1}"))))) )))