diff options
Diffstat (limited to '')
20 files changed, 592 insertions, 208 deletions
diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index a5b036478..32cfd2a3e 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -360,29 +360,34 @@ offset (<text>.many <text>.decimal)] (in (all text#composite mark (if signed?' "-" "") offset))))] (when (f#decoded (all text#composite (if signed? "-" "") digits "." decimals exp)) - {try.#Failure message} - (<>.failure message) - {try.#Success value} - (in value)))) + (in value) + + {try.#Failure message} + (<>.failure message)))) (def escaped_parser (Parser Text) - (all <>.either - (<>.after (<text>.this "\t") - (<>#in text.tab)) - (<>.after (<text>.this "\b") - (<>#in text.back_space)) - (<>.after (<text>.this "\n") - (<>#in text.new_line)) - (<>.after (<text>.this "\r") - (<>#in text.carriage_return)) - (<>.after (<text>.this "\f") - (<>#in text.form_feed)) - (<>.after (<text>.this (text#composite "\" text.double_quote)) - (<>#in text.double_quote)) - (<>.after (<text>.this "\\") - (<>#in "\")))) + (`` (all <>.either + (,, (with_template [<when> <then>] + [(<>.after (<text>.this <when>) + (<>#in <then>))] + + ["\t" text.tab] + ["\b" text.back_space] + ["\n" text.new_line] + ["\r" text.carriage_return] + ["\f" text.form_feed] + [(text#composite "\" text.double_quote) text.double_quote] + ["\\" "\"] + )) + (<>.after (<text>.this "\u") + (|> <text>.hexadecimal! + (<text>.exactly! 4) + <text>.slice + (<>.codec n.hex) + (<>#each text.of_char))) + ))) (def string_parser (Parser String) @@ -425,15 +430,17 @@ (def json_parser (Parser JSON) - (<>.rec - (function (_ json_parser) - (all <>.or - null_parser - boolean_parser - number_parser - string_parser - (array_parser json_parser) - (object_parser json_parser))))) + (<| (<>.after ..space_parser) + (<>.before ..space_parser) + (<>.rec + (function (_ json_parser) + (all <>.or + null_parser + boolean_parser + number_parser + string_parser + (array_parser json_parser) + (object_parser json_parser)))))) (def .public codec (Codec Text JSON) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index cc6317ae5..9220719da 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -15,7 +15,8 @@ ["[1]!" \\unsafe] ["[0]" \\format (.only Format) (.use "[1]#[0]" monoid)] ["<[1]>" \\parser (.only Parser)]] - ["[0]" text (.only Char) + ["[0]" text (.only) + [char (.only Char)] ["%" \\format] [encoding ["[0]" utf8]]] diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index 2df34e163..c66e10c61 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -18,10 +18,9 @@ ["n" nat] ["[0]" i64]]] [meta - ["@" target]]]]) - -(type .public Char - Nat) + ["@" target]]]] + [/ + ["[0]" char (.only Char)]]) ... TODO: Instead of ints, chars should be produced fron nats. ... (The JVM specifies chars as 16-bit unsigned integers) @@ -33,18 +32,19 @@ [(def .public <long> (..of_char <code>)) (def .public <short> <long>)] - [00 \0 null] - [07 \a alarm] - [08 \b back_space] - [09 \t tab] - [10 \n new_line] - [11 \v vertical_tab] - [12 \f form_feed] - [13 \r carriage_return] - [34 \'' double_quote] + [char.\0 \0 null] + [char.\a \a alarm] + [char.\b \b back_space] + [char.\t \t tab] + [char.\n \n new_line] + [char.\v \v vertical_tab] + [char.\f \f form_feed] + [char.\r \r carriage_return] + [char.\'' \'' double_quote] ) (def .public line_feed + Text ..new_line) (def .public size diff --git a/stdlib/source/library/lux/data/text/char.lux b/stdlib/source/library/lux/data/text/char.lux new file mode 100644 index 000000000..fd419342f --- /dev/null +++ b/stdlib/source/library/lux/data/text/char.lux @@ -0,0 +1,59 @@ +(.require + [library + [lux (.except)]]) + +(type .public Unicode + Nat) + +(type .public Char + Unicode) + +... https://en.wikipedia.org/wiki/ASCII +(with_template [<code> <short> <long>] + [(def .public <long> Char <code>) + (def .public <short> Char <long>)] + + [00 \0 null] + [07 \a alarm] + [08 \b back_space] + [09 \t tab] + [10 \n new_line] + [11 \v vertical_tab] + [12 \f form_feed] + [13 \r carriage_return] + [34 \'' double_quote] + ) + +(def .public line_feed + Char + ..new_line) + +(with_template [<code> <long>] + [(def .public <long> Char <code>)] + + [001 start_of_heading] + [002 start_of_text] + [003 end_of_text] + [004 end_of_transmission] + [005 enquiry] + [006 acknowledgement] + [014 shift_out] + [015 shift_in] + [016 data_link_escape] + [017 device_control_1] + [018 device_control_2] + [019 device_control_3] + [020 device_control_4] + [021 negative_acknowledgement] + [022 synchronous_idle] + [023 end_of_transmission_block] + [024 cancel] + [025 end_of_medium] + [026 substitute] + [027 escape] + [028 file_separator] + [029 group_separator] + [030 record_separator] + [031 unit_separator] + [127 delete] + ) diff --git a/stdlib/source/library/lux/data/text/escape.lux b/stdlib/source/library/lux/data/text/escape.lux index 46e2ca8e2..f16005def 100644 --- a/stdlib/source/library/lux/data/text/escape.lux +++ b/stdlib/source/library/lux/data/text/escape.lux @@ -17,7 +17,8 @@ [macro [syntax (.only syntax)] ["^" pattern]]]]] - ["[0]" // (.only Char) + ["[0]" // (.only) + [char (.only Char)] ["%" \\format (.only format)]]) (def sigil "\") diff --git a/stdlib/source/library/lux/data/text/unicode/block.lux b/stdlib/source/library/lux/data/text/unicode/block.lux index bb61c05be..7a97b8803 100644 --- a/stdlib/source/library/lux/data/text/unicode/block.lux +++ b/stdlib/source/library/lux/data/text/unicode/block.lux @@ -13,7 +13,8 @@ [meta [type [primitive (.except)]]]]] - [/// (.only Char)]) + [/// + [char (.only Char)]]) (primitive .public Block (Interval Char) diff --git a/stdlib/source/library/lux/data/text/unicode/set.lux b/stdlib/source/library/lux/data/text/unicode/set.lux index 771fb287f..732a52ddc 100644 --- a/stdlib/source/library/lux/data/text/unicode/set.lux +++ b/stdlib/source/library/lux/data/text/unicode/set.lux @@ -12,13 +12,13 @@ [meta [type (.only by_example) [primitive (.except)]]]]] - ["[0]" / - ["/[1]" // - [// (.only Char)] - ["[1][0]" block (.only Block)]]]) + [// + ["[0]" block (.only Block)] + [// + [char (.only Char)]]]) (def builder - (tree.builder //block.monoid)) + (tree.builder block.monoid)) (def :@: (by_example [@] @@ -52,103 +52,103 @@ (def character/0 Set - (..set [//block.basic_latin - (list //block.latin_1_supplement - //block.latin_extended_a - //block.latin_extended_b - //block.ipa_extensions - //block.spacing_modifier_letters - //block.combining_diacritical_marks - //block.greek_and_coptic - //block.cyrillic - //block.cyrillic_supplementary - //block.armenian - //block.hebrew - //block.arabic - //block.syriac - //block.thaana - //block.devanagari - //block.bengali - //block.gurmukhi - //block.gujarati - //block.oriya - //block.tamil - //block.telugu - //block.kannada - //block.malayalam - //block.sinhala - //block.thai - //block.lao - //block.tibetan - //block.myanmar - //block.georgian)])) + (..set [block.basic_latin + (list block.latin_1_supplement + block.latin_extended_a + block.latin_extended_b + block.ipa_extensions + block.spacing_modifier_letters + block.combining_diacritical_marks + block.greek_and_coptic + block.cyrillic + block.cyrillic_supplementary + block.armenian + block.hebrew + block.arabic + block.syriac + block.thaana + block.devanagari + block.bengali + block.gurmukhi + block.gujarati + block.oriya + block.tamil + block.telugu + block.kannada + block.malayalam + block.sinhala + block.thai + block.lao + block.tibetan + block.myanmar + block.georgian)])) (def character/1 Set - (..set [//block.hangul_jamo - (list //block.ethiopic - //block.cherokee - //block.unified_canadian_aboriginal_syllabics - //block.ogham - //block.runic - //block.tagalog - //block.hanunoo - //block.buhid - //block.tagbanwa - //block.khmer - //block.mongolian - //block.limbu - //block.tai_le - //block.khmer_symbols - //block.phonetic_extensions - //block.latin_extended_additional - //block.greek_extended - //block.general_punctuation - //block.superscripts_and_subscripts - //block.currency_symbols - //block.combining_diacritical_marks_for_symbols - //block.letterlike_symbols - //block.number_forms - //block.arrows - //block.mathematical_operators - //block.miscellaneous_technical - //block.control_pictures - //block.optical_character_recognition - //block.enclosed_alphanumerics - //block.box_drawing)])) + (..set [block.hangul_jamo + (list block.ethiopic + block.cherokee + block.unified_canadian_aboriginal_syllabics + block.ogham + block.runic + block.tagalog + block.hanunoo + block.buhid + block.tagbanwa + block.khmer + block.mongolian + block.limbu + block.tai_le + block.khmer_symbols + block.phonetic_extensions + block.latin_extended_additional + block.greek_extended + block.general_punctuation + block.superscripts_and_subscripts + block.currency_symbols + block.combining_diacritical_marks_for_symbols + block.letterlike_symbols + block.number_forms + block.arrows + block.mathematical_operators + block.miscellaneous_technical + block.control_pictures + block.optical_character_recognition + block.enclosed_alphanumerics + block.box_drawing)])) (def character/2 Set - (..set [//block.block_elements - (list //block.geometric_shapes - //block.miscellaneous_symbols - //block.dingbats - //block.miscellaneous_mathematical_symbols_a - //block.supplemental_arrows_a - //block.braille_patterns - //block.supplemental_arrows_b - //block.miscellaneous_mathematical_symbols_b - //block.supplemental_mathematical_operators - //block.miscellaneous_symbols_and_arrows - //block.cjk_radicals_supplement - //block.kangxi_radicals - //block.ideographic_description_characters - //block.cjk_symbols_and_punctuation - //block.hiragana - //block.katakana - //block.bopomofo - //block.hangul_compatibility_jamo - //block.kanbun - //block.bopomofo_extended - //block.katakana_phonetic_extensions - //block.enclosed_cjk_letters_and_months - //block.cjk_compatibility - //block.cjk_unified_ideographs_extension_a - //block.yijing_hexagram_symbols - //block.cjk_unified_ideographs - //block.yi_syllables - //block.yi_radicals - //block.hangul_syllables + (..set [block.block_elements + (list block.geometric_shapes + block.miscellaneous_symbols + block.dingbats + block.miscellaneous_mathematical_symbols_a + block.supplemental_arrows_a + block.braille_patterns + block.supplemental_arrows_b + block.miscellaneous_mathematical_symbols_b + block.supplemental_mathematical_operators + block.miscellaneous_symbols_and_arrows + block.cjk_radicals_supplement + block.kangxi_radicals + block.ideographic_description_characters + block.cjk_symbols_and_punctuation + block.hiragana + block.katakana + block.bopomofo + block.hangul_compatibility_jamo + block.kanbun + block.bopomofo_extended + block.katakana_phonetic_extensions + block.enclosed_cjk_letters_and_months + block.cjk_compatibility + block.cjk_unified_ideographs_extension_a + block.yijing_hexagram_symbols + block.cjk_unified_ideographs + block.yi_syllables + block.yi_radicals + block.hangul_syllables )])) (def .public character @@ -161,37 +161,37 @@ (def .public non_character Set - (..set [//block.high_surrogates - (list //block.high_private_use_surrogates - //block.low_surrogates - //block.private_use_area - //block.cjk_compatibility_ideographs - //block.alphabetic_presentation_forms - //block.arabic_presentation_forms_a - //block.variation_selectors - //block.combining_half_marks - //block.cjk_compatibility_forms - //block.small_form_variants - //block.arabic_presentation_forms_b - //block.halfwidth_and_fullwidth_forms - //block.specials - ... //block.linear_b_syllabary - ... //block.linear_b_ideograms - ... //block.aegean_numbers - ... //block.old_italic - ... //block.gothic - ... //block.ugaritic - ... //block.deseret - ... //block.shavian - ... //block.osmanya - ... //block.cypriot_syllabary - ... //block.byzantine_musical_symbols - ... //block.musical_symbols - ... //block.tai_xuan_jing_symbols - ... //block.mathematical_alphanumeric_symbols - ... //block.cjk_unified_ideographs_extension_b - ... //block.cjk_compatibility_ideographs_supplement - ... //block.tags + (..set [block.high_surrogates + (list block.high_private_use_surrogates + block.low_surrogates + block.private_use_area + block.cjk_compatibility_ideographs + block.alphabetic_presentation_forms + block.arabic_presentation_forms_a + block.variation_selectors + block.combining_half_marks + block.cjk_compatibility_forms + block.small_form_variants + block.arabic_presentation_forms_b + block.halfwidth_and_fullwidth_forms + block.specials + ... block.linear_b_syllabary + ... block.linear_b_ideograms + ... block.aegean_numbers + ... block.old_italic + ... block.gothic + ... block.ugaritic + ... block.deseret + ... block.shavian + ... block.osmanya + ... block.cypriot_syllabary + ... block.byzantine_musical_symbols + ... block.musical_symbols + ... block.tai_xuan_jing_symbols + ... block.mathematical_alphanumeric_symbols + ... block.cjk_unified_ideographs_extension_b + ... block.cjk_compatibility_ideographs_supplement + ... block.tags )])) (def .public full @@ -205,18 +205,18 @@ (-> Set Char) (|>> representation tree.tag - //block.start)) + block.start)) (def .public end (-> Set Char) (|>> representation tree.tag - //block.end)) + block.end)) (def .public (member? set character) (-> Set Char Bit) (loop (again [tree (representation set)]) - (if (//block.within? (tree.tag tree) character) + (if (block.within? (tree.tag tree) character) (when (tree.root tree) {0 #0 _} true @@ -230,8 +230,8 @@ (Equivalence Set) (implementation (def (= reference subject) - (set#= (set.of_list //block.hash (tree.tags (representation reference))) - (set.of_list //block.hash (tree.tags (representation subject))))))) + (set#= (set.of_list block.hash (tree.tags (representation reference))) + (set.of_list block.hash (tree.tags (representation subject))))))) ) (with_template [<name> <blocks>] @@ -239,10 +239,10 @@ Set (..set <blocks>))] - [ascii [//block.basic_latin (list)]] - [alphabetic [//block.upper_case (list //block.lower_case)]] - [alpha_numeric [//block.upper_case (list //block.lower_case //block.numeric)]] - [numeric [//block.numeric (list)]] - [upper_case [//block.upper_case (list)]] - [lower_case [//block.lower_case (list)]] + [ascii [block.basic_latin (list)]] + [alphabetic [block.upper_case (list block.lower_case)]] + [alpha_numeric [block.upper_case (list block.lower_case block.numeric)]] + [numeric [block.numeric (list)]] + [upper_case [block.upper_case (list)]] + [lower_case [block.lower_case (list)]] ) diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 711e36c8f..4de53bfe9 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -13,9 +13,7 @@ ["[0]" maybe] ["[0]" try (.only Try)] [function - [predicate (.only Predicate)]]] - [data - [text (.only Char)]]]] + [predicate (.only Predicate)]]]]] ["[0]" // ["[1][0]" nat] ["[1][0]" i64]]) diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index 7f08ef23a..0027d81a9 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -7,7 +7,8 @@ [apply (.only Apply)] ["[0]" monad (.only Monad do)]] [data - ["[0]" text (.only Char) (.use "[1]#[0]" monoid) + ["[0]" text (.use "[1]#[0]" monoid) + [char (.only Char)] ["[0]" unicode ["[1]" set]]] [collection diff --git a/stdlib/source/library/lux/world/console.lux b/stdlib/source/library/lux/world/console.lux index ac83dcc9f..37d8b3b07 100644 --- a/stdlib/source/library/lux/world/console.lux +++ b/stdlib/source/library/lux/world/console.lux @@ -13,7 +13,8 @@ ["[0]" async (.only Async) (.use "[1]#[0]" monad)] ["[0]" atom]]] [data - ["[0]" text (.only Char) + ["[0]" text (.only) + [char (.only Char)] ["%" \\format (.only format)]]] [meta ["@" target]]]]) diff --git a/stdlib/source/library/lux/world/net/http/header.lux b/stdlib/source/library/lux/world/net/http/header.lux index 9c8a75ff0..662310def 100644 --- a/stdlib/source/library/lux/world/net/http/header.lux +++ b/stdlib/source/library/lux/world/net/http/header.lux @@ -1,9 +1,11 @@ (.require [library [lux (.except has) + [abstract + ["[0]" monad (.only do)]] [control ["[0]" pipe] - ["[0]" try (.only Try)] + ["[0]" try (.only Try) (.use "[1]#[0]" monad)] ["[0]" exception (.only Exception)]] [data ["[0]" text (.only) @@ -17,7 +19,9 @@ [// ["[0]" mime (.only MIME)] ["[0]" cookie] - [// (.only URL)]]) + [// (.only URL) + ["[0]" uri + ["[1]" encoding]]]]) (type .public Headers (Dictionary Text Text)) @@ -88,17 +92,20 @@ [#name "Set-Cookie" #in (|>> dictionary.entries (list#mix (function (_ [name value] previous) - (when previous - "" (%.format name ..assignment value) - _ (%.format previous ..separator name ..assignment value))) + (with_expansions [<key,value> (these (uri.encoded name) ..assignment value)] + (when previous + "" (%.format <key,value>) + _ (%.format previous ..separator <key,value>)))) "")) #out (|>> (text.all_split_by ..separator) - (list#mix (function (_ cookie jar) - (when (text.split_by ..assignment cookie) - {.#Some [name value]} - (dictionary.has name value jar) - - {.#None} - jar)) - cookie.empty) - {try.#Success})]) + (monad.mix try.monad + (function (_ cookie jar) + (when (text.split_by ..assignment cookie) + {.#Some [name value]} + (do try.monad + [name (uri.decoded name)] + (in (dictionary.has name value jar))) + + {.#None} + (try#in jar))) + cookie.empty))]) diff --git a/stdlib/source/library/lux/world/net/uri/encoding.lux b/stdlib/source/library/lux/world/net/uri/encoding.lux new file mode 100644 index 000000000..91a5c2020 --- /dev/null +++ b/stdlib/source/library/lux/world/net/uri/encoding.lux @@ -0,0 +1,116 @@ +... https://en.wikipedia.org/wiki/Percent-encoding +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" try (.only Try)] + ["[0]" exception (.only Exception)]] + [data + ["[0]" text (.only) + [char (.only Char)]] + [collection + ["[0]" set (.only Set)]]] + [math + [number + ["[0]" nat]]]]]) + +(type .public URI_Encoded + Text) + +(with_expansions [<reserved> (these [" " "%20"] + ["!" "%21"] + ["#" "%23"] + ["$" "%24"] + ["%" "%25"] + ["&" "%26"] + ["'" "%27"] + ["(" "%28"] + [")" "%29"] + ["*" "%2A"] + ["+" "%2B"] + ["," "%2C"] + ["/" "%2F"] + [":" "%3A"] + [";" "%3B"] + ["=" "%3D"] + ["?" "%3F"] + ["@" "%40"] + ["[" "%5B"] + ["]" "%5D"])] + (def .public reserved + (Set Char) + (set.of_list nat.hash + (`` (list (,, (with_template [<char> <encoding>] + [(char <char>)] + + <reserved>)))))) + + (def .public (encoded input) + (-> Text URI_Encoded) + (let [size (text.size input)] + (loop (again [index 0 + slice_start 0 + output ""]) + (if (nat.< size index) + (`` (when (.text_char# index input) + (,, (with_template [<char> <encoding>] + [(char <char>) + (let [index' (++ index)] + (again index' + index' + (all .text_composite# + output + (.text_clip# slice_start (nat.- slice_start index) input) + <encoding>)))] + + <reserved>)) + + _ + (again (++ index) + slice_start + output))) + (all .text_composite# + output + (.text_clip# slice_start (nat.- slice_start index) input)))))) + ) + +(def escape (char "%")) + +(exception.def (invalid it) + (Exception URI_Encoded) + (exception.report + (list ["Value" (text.format it)]))) + +(def .public (decoded input) + (-> URI_Encoded (Try Text)) + (let [size (text.size input)] + (loop (again [index 0 + slice_start 0 + output ""]) + (if (nat.< size index) + (`` (when (.text_char# index input) + ..escape + (let [encoding_start (++ index) + encoding_end (++ encoding_start)] + (if (nat.< size encoding_end) + (do try.monad + [value (|> input + (.text_clip# encoding_start 2) + (at nat.hex decoded)) + .let [index' (++ encoding_end)]] + (again index' + index' + (all .text_composite# output + (.text_clip# slice_start (nat.- slice_start index) input) + (text.of_char value)))) + (exception.except ..invalid [input]))) + + _ + (again (++ index) + slice_start + output))) + {try.#Success (|> input + (.text_clip# slice_start (nat.- slice_start index)) + (.text_composite# output))})))) diff --git a/stdlib/source/parser/lux/data/text.lux b/stdlib/source/parser/lux/data/text.lux index dc2507cff..3c2b9baf8 100644 --- a/stdlib/source/parser/lux/data/text.lux +++ b/stdlib/source/parser/lux/data/text.lux @@ -9,7 +9,8 @@ ["[0]" try (.only Try)] ["[0]" exception (.only Exception)]] [data - ["/" text (.only Char) (.use "[1]#[0]" monoid)] + ["/" text (.use "[1]#[0]" monoid) + [char (.only Char)]] ["[0]" product] [collection ["[0]" list (.use "[1]#[0]" mix)]]] diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index e04705902..ad9427770 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -26,9 +26,10 @@ ["[0]" set] ["[0]" list (.use "[1]#[0]" functor)]]] [math - ["[0]" random (.only Random)] - [number + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] + [number (.only hex) ["n" nat] + ["[0]" i64] ["[0]" frac]]] ["[0]" meta (.only) ["@" target] @@ -297,6 +298,42 @@ [value (macro.symbol "string")] (in (list (code.text (%.code value))))))) +(def (digits/4 it) + (-> Nat Text) + (<| (if (n.< (hex "10") it) + (format "000" (%.nat_16 it))) + (if (n.< (hex "100") it) + (format "00" (%.nat_16 it))) + (if (n.< (hex "1000") it) + (format "0" (%.nat_16 it))) + (%.nat_16 it))) + +(def escaped_string + (Random [Text Text]) + (all random.either + (random#in [text.tab "\t"]) + (random#in [text.back_space "\b"]) + (random#in [text.new_line "\n"]) + (random#in [text.carriage_return "\r"]) + (random#in [text.form_feed "\f"]) + (random#in [text.double_quote (format "\" text.double_quote)]) + (random#in ["\" "\\"]) + (do [! random.monad] + [char (at ! each (i64.and (hex "FF")) + random.nat)] + (in [(text.of_char char) + (format "\u" (digits/4 char))])) + )) + +(def any_string + (Random [Text Text]) + (all random.either + escaped_string + (do random.monad + [it (random.alphabetic 1)] + (in [it it])) + )) + (def .public test Test (<| (_.covering /._) @@ -305,7 +342,18 @@ (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) + (all _.and + ($codec.spec /.equivalence /.codec ..random) + (do random.monad + [key (random.alphabetic 1) + [expected escaped] any_string] + (_.coverage [/.#String] + (|> {/.#String escaped} + (at /.codec encoded) + (at /.codec decoded) + (try#each (at /.equivalence = {/.#String expected})) + (try.else false)))) + )) (do random.monad [sample ..random] diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 44e3c2553..653027509 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -228,7 +228,7 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.XML]) + (_.for [/.XML /.#Text /.#Node]) (all _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence ..random)) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 8d560a409..99171b434 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -69,6 +69,7 @@ ["[1][0]" symbol] ["[1][0]" type]]]] ["[0]" / + ["[1][0]" char] ["[1][0]" buffer] ["[1][0]" encoding] ["[1][0]" regex] @@ -721,7 +722,7 @@ (def char Test (all _.and - (_.for [/.Char /.of_char] + (_.for [/.of_char] (`` (all _.and (,, (with_template [<short> <long>] [(_.coverage [<short> <long>] @@ -925,6 +926,7 @@ (/#= sample2 (/.replaced sep1 sep2 sample1)))) + /char.test /buffer.test /encoding.test /regex.test diff --git a/stdlib/source/test/lux/data/text/char.lux b/stdlib/source/test/lux/data/text/char.lux new file mode 100644 index 000000000..3c19f277c --- /dev/null +++ b/stdlib/source/test/lux/data/text/char.lux @@ -0,0 +1,83 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [data + [collection + ["[0]" list] + ["[0]" set]]] + [math + ["[0]" random (.only Random)] + [number + ["[0]" nat]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + []) + (_.for [/.Unicode /.Char]) + (`` (all _.and + (with_expansions [<chars> (these /.null + /.alarm + /.back_space + /.tab + /.new_line + /.vertical_tab + /.form_feed + /.carriage_return + /.double_quote + + /.start_of_heading + /.start_of_text + /.end_of_text + /.end_of_transmission + /.enquiry + /.acknowledgement + /.shift_out + /.shift_in + /.data_link_escape + /.device_control_1 + /.device_control_2 + /.device_control_3 + /.device_control_4 + /.negative_acknowledgement + /.synchronous_idle + /.end_of_transmission_block + /.cancel + /.end_of_medium + /.substitute + /.escape + /.file_separator + /.group_separator + /.record_separator + /.unit_separator + /.delete + )] + (_.coverage [<chars>] + (let [options (list <chars>) + uniques (set.of_list nat.hash options)] + (nat.= (list.size options) + (set.size uniques))))) + (,, (with_template [<short> <long>] + [(_.coverage [<short>] + (same? <long> <short>))] + + [/.\0 /.null] + [/.\a /.alarm] + [/.\b /.back_space] + [/.\t /.tab] + [/.\n /.new_line] + [/.\v /.vertical_tab] + [/.\f /.form_feed] + [/.\r /.carriage_return] + [/.\'' /.double_quote] + )) + (_.coverage [/.line_feed] + (same? /.new_line /.line_feed)) + )))) diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index 554aaa16f..82be1dcb4 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -9,7 +9,8 @@ ["[0]" exception]] [data ["[0]" bit (.use "[1]#[0]" equivalence)] - ["[0]" text (.only Char) (.use "[1]#[0]" equivalence) + ["[0]" text (.use "[1]#[0]" equivalence) + [char (.only Char)] ["%" \\format (.only format)]] [collection ["[0]" set (.only Set)]]] diff --git a/stdlib/source/test/lux/world/net.lux b/stdlib/source/test/lux/world/net.lux index f9b3417ed..e7780f688 100644 --- a/stdlib/source/test/lux/world/net.lux +++ b/stdlib/source/test/lux/world/net.lux @@ -17,6 +17,7 @@ ["[1]/[0]" status] ["[1]/[0]" version]] ["[1][0]" uri + ["[1]/[0]" encoding] ["[1]/[0]" scheme] ["[1]/[0]" path]]]) @@ -41,6 +42,7 @@ /http/status.test /http/version.test + /uri/encoding.test /uri/scheme.test /uri/path.test ))) diff --git a/stdlib/source/test/lux/world/net/uri/encoding.lux b/stdlib/source/test/lux/world/net/uri/encoding.lux new file mode 100644 index 000000000..f9a627e25 --- /dev/null +++ b/stdlib/source/test/lux/world/net/uri/encoding.lux @@ -0,0 +1,55 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" maybe] + ["[0]" try (.use "[1]#[0]" functor)]] + [data + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format]] + [collection + ["[0]" list] + ["[0]" set]]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (let [choices (set.list /.reserved) + variety (list.size choices)]) + (do [! random.monad] + [safe (random.lower_case 1) + + left (random.lower_case 1) + middle (random.lower_case 1) + right (random.lower_case 1) + left_choice (at ! each (n.% variety) random.nat) + right_choice (at ! each (n.% variety) random.nat) + .let [left_choice (maybe.trusted (list.item left_choice choices)) + right_choice (maybe.trusted (list.item right_choice choices)) + unsafe (%.format left + (text.of_char left_choice) middle + (text.of_char right_choice) right)]]) + (_.for [/.URI_Encoded]) + (all _.and + (_.coverage [/.reserved] + (not (set.empty? /.reserved))) + (_.coverage [/.encoded] + (and (text#= safe (/.encoded safe)) + (not (text#= unsafe (/.encoded unsafe))))) + (_.coverage [/.decoded] + (|> unsafe + /.encoded + /.decoded + (try#each (text#= unsafe)) + (try.else false))) + ))) |