aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2022-10-24 16:58:07 -0400
committerEduardo Julian2022-10-24 16:58:07 -0400
commit45c599e49ae2659331d13222948f7e755967fdf9 (patch)
tree1f1b0be2423b69562d7479fd8db9abb509aaaf7f /stdlib
parent99d196a528804b3b136ac6c45cb872a5e7c70cde (diff)
New module just for the Char type + fixes to JSON parsing.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/library/lux/data/format/json.lux63
-rw-r--r--stdlib/source/library/lux/data/format/tar.lux3
-rw-r--r--stdlib/source/library/lux/data/text.lux26
-rw-r--r--stdlib/source/library/lux/data/text/char.lux59
-rw-r--r--stdlib/source/library/lux/data/text/escape.lux3
-rw-r--r--stdlib/source/library/lux/data/text/unicode/block.lux3
-rw-r--r--stdlib/source/library/lux/data/text/unicode/set.lux276
-rw-r--r--stdlib/source/library/lux/math/number/int.lux4
-rw-r--r--stdlib/source/library/lux/math/random.lux3
-rw-r--r--stdlib/source/library/lux/world/console.lux3
-rw-r--r--stdlib/source/library/lux/world/net/http/header.lux35
-rw-r--r--stdlib/source/library/lux/world/net/uri/encoding.lux116
-rw-r--r--stdlib/source/parser/lux/data/text.lux3
-rw-r--r--stdlib/source/test/lux/data/format/json.lux54
-rw-r--r--stdlib/source/test/lux/data/format/xml.lux2
-rw-r--r--stdlib/source/test/lux/data/text.lux4
-rw-r--r--stdlib/source/test/lux/data/text/char.lux83
-rw-r--r--stdlib/source/test/lux/data/text/escape.lux3
-rw-r--r--stdlib/source/test/lux/world/net.lux2
-rw-r--r--stdlib/source/test/lux/world/net/uri/encoding.lux55
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)))
+ )))