From 2431e767a09894c2f685911ba7f1ba0b7de2a165 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 13 Jul 2021 02:41:45 -0400 Subject: Improved the XML parsing library. --- stdlib/source/test/lux/control/parser/xml.lux | 78 +++++------------ stdlib/source/test/lux/data/text/unicode/set.lux | 1 + stdlib/source/test/lux/debug.lux | 63 ++++++++------ stdlib/source/test/lux/ffi.js.lux | 104 ++++++++++++++++------- 4 files changed, 132 insertions(+), 114 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux index 116f948da..435e3f4d3 100644 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -84,51 +84,31 @@ (do {! random.monad} [expected ..random_tag] (_.cover [/.node] - (|> (/.run (do //.monad - [_ (/.node expected)] - /.ignore) + (|> (/.run (/.node expected (//\wrap [])) (list (#xml.Node expected (dictionary.new name.hash) (list)))) (!expect (#try.Success []))))) (!failure /.wrong_tag - [[(/.node ["" expected]) + [[(/.node ["" expected] (//\wrap [])) (#xml.Node [expected ""] (dictionary.new name.hash) (list))]]) (do {! random.monad} [expected_tag ..random_tag expected_attribute ..random_attribute expected_value (random.ascii/alpha 1)] (_.cover [/.attribute] - (|> (/.run (do //.monad - [_ (/.node expected_tag) - _ (/.attribute expected_attribute)] - /.ignore) + (|> (/.run (<| (/.node expected_tag) + (//.after (/.attribute expected_attribute)) + (//\wrap [])) (list (#xml.Node expected_tag (|> (dictionary.new name.hash) (dictionary.put expected_attribute expected_value)) (list)))) (!expect (#try.Success []))))) (!failure /.unknown_attribute - [[(do //.monad - [_ (/.attribute ["" expected])] - /.ignore) + [[(/.attribute ["" expected]) (#xml.Node [expected expected] (|> (dictionary.new name.hash) (dictionary.put [expected ""] expected)) (list))]]) - (do {! random.monad} - [expected ..random_tag] - (_.cover [/.children] - (|> (/.run (do {! //.monad} - [_ (/.node expected)] - (/.children - (do ! - [_ (/.node expected)] - /.ignore))) - (list (#xml.Node expected - (dictionary.new name.hash) - (list (#xml.Node expected - (dictionary.new name.hash) - (list)))))) - (!expect (#try.Success []))))) (!failure /.empty_input [[(do //.monad [_ /.ignore] @@ -140,43 +120,27 @@ (#xml.Text expected)] [(do //.monad [_ /.ignore] - (/.node [expected expected])) + (/.node [expected expected] + (//\wrap []))) (#xml.Node [expected expected] (dictionary.new name.hash) (list))] [(do //.monad [_ /.ignore] - (/.node [expected expected])) + (/.node [expected expected] + (/.attribute [expected expected]))) (#xml.Node [expected expected] (|> (dictionary.new name.hash) (dictionary.put [expected expected] expected)) - (list))] - [(do //.monad - [_ /.ignore] - (/.children - (/.node [expected expected]))) - (#xml.Node [expected expected] - (dictionary.new name.hash) - (list (#xml.Node [expected expected] - (dictionary.new name.hash) - (list))))]]) + (list))]]) (!failure /.unexpected_input [[/.text (#xml.Node [expected expected] (dictionary.new name.hash) (list))] - [(do //.monad - [_ (/.node [expected expected])] - /.ignore) - (#xml.Text expected)] - [(do //.monad - [_ (/.attribute [expected expected])] - /.ignore) + [(/.node [expected expected] + (//\wrap [])) (#xml.Text expected)] - [(do {! //.monad} - [_ (/.node [expected expected])] - (/.children - (do ! - [_ (/.node [expected expected])] - /.ignore))) + [(/.node [expected expected] + (/.attribute [expected expected])) (#xml.Text expected)]]) (do {! random.monad} [#let [node (: (-> xml.Tag (List xml.XML) xml.XML) @@ -186,11 +150,13 @@ right ..random_tag wrong (random.filter (|>> (name\= right) not) ..random_tag) - #let [parser (/.children - (do //.monad - [_ (/.somewhere (/.node right)) - _ (//.some /.ignore)] - (wrap [])))] + #let [parser (<| (/.node parent) + (do //.monad + [_ (<| /.somewhere + (/.node right) + (//\wrap [])) + _ (//.some /.ignore)] + (wrap [])))] repetitions (\ ! map (n.% 10) random.nat)] ($_ _.and (_.cover [/.somewhere] diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index 0fc394a63..631d3b511 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -85,6 +85,7 @@ [/.ascii/alpha_num] [/.ascii/lower] [/.ascii/upper] + [/.ascii/numeric] [/.character] [/.non_character] [/.full] diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index 29e4493f8..5c0a950dc 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -228,31 +228,38 @@ (def: #export test Test (<| (_.covering /._) - ($_ _.and - ..inspection - ..representation - (_.cover [/.:hole /.type_hole] - (let [error (: My_Text (..macro_error (/.:hole)))] - (and (exception.match? /.type_hole error) - (text.contains? (%.type My_Text) error)))) - (do random.monad - [foo (random.ascii/upper 10) - bar random.nat - baz random.bit] - (_.cover [/.here] - (with_expansions [ (for {@.js (~~ (as_is))} - (~~ (as_is (/.here))))] - (`` (exec - - (/.here foo - {bar %.nat}) - true))))) - (_.cover [/.unknown_local_binding] - (exception.match? /.unknown_local_binding - (..macro_error (/.here yolo)))) - (_.cover [/.private] - (exec - (: (/.private /.Inspector) - /.inspect) - true)) - ))) + (do random.monad + [message (random.ascii/lower 5)] + ($_ _.and + ..inspection + ..representation + (_.cover [/.:hole /.type_hole] + (let [error (: My_Text (..macro_error (/.:hole)))] + (and (exception.match? /.type_hole error) + (text.contains? (%.type My_Text) error)))) + (do random.monad + [foo (random.ascii/upper 10) + bar random.nat + baz random.bit] + (_.cover [/.here] + (with_expansions [ (for {@.js (~~ (as_is))} + (~~ (as_is (/.here))))] + (`` (exec + + (/.here foo + {bar %.nat}) + true))))) + (_.cover [/.unknown_local_binding] + (exception.match? /.unknown_local_binding + (..macro_error (/.here yolo)))) + (_.cover [/.private] + (exec + (: (/.private /.Inspector) + /.inspect) + true)) + (_.cover [/.log!] + (exec + (/.log! (format (%.name (name_of /.log!)) + " works: " (%.text message))) + true)) + )))) diff --git a/stdlib/source/test/lux/ffi.js.lux b/stdlib/source/test/lux/ffi.js.lux index 57a8332e2..e2c699dbd 100644 --- a/stdlib/source/test/lux/ffi.js.lux +++ b/stdlib/source/test/lux/ffi.js.lux @@ -6,6 +6,7 @@ [control ["." try]] [data + ["." bit ("#\." equivalence)] ["." text ("#\." equivalence)]] [math ["." random (#+ Random)] @@ -53,33 +54,76 @@ ## I64s get compiled as JavaScript objects with a specific structure. object random.nat] (<| (_.covering /._) - ($_ _.and - (_.cover [/.on_browser? /.on_node_js? /.on_nashorn?] - (or /.on_nashorn? - /.on_node_js? - /.on_browser?)) - (_.cover [/.type_of] - (and (text\= "boolean" (/.type_of boolean)) - (text\= "number" (/.type_of number)) - (text\= "string" (/.type_of string)) - (text\= "function" (/.type_of function)) - (text\= "object" (/.type_of object)))) - (_.cover [/.import:] - (let [encoding "utf8"] - (text\= string - (cond /.on_nashorn? - (let [binary (java/lang/String::getBytes [encoding] (:as java/lang/String string))] - (|> (java/lang/String::new [binary encoding]) - (:as Text))) - - /.on_node_js? - (|> (Buffer::from [string encoding]) - (Buffer::toString [encoding])) - - ## On the browser - (let [binary (|> (TextEncoder::new [encoding]) - (TextEncoder::encode [string]))] - (|> (TextDecoder::new [encoding]) - (TextDecoder::decode [binary]))) - )))) - )))) + (`` ($_ _.and + (~~ (template [ ] + [(_.cover [] + (exec + (: ) + true))] + + [/.Boolean boolean] + [/.Number number] + [/.String string] + )) + (_.for [/.Object] + ($_ _.and + (~~ (template [] + [(_.cover [] + (exec + (: (Ex [a] (/.Object a)) + (: + (:assume []))) + true))] + + [/.Function] + [/.Symbol] + [/.Null] + [/.Undefined] + )) + )) + (_.cover [/.constant] + (|> (/.constant /.Function [parseFloat]) + "js object null?" + not)) + (_.cover [/.closure] + (|> (/.closure [input/0] input/0) + "js object null?" + not)) + (_.cover [/.on_browser? /.on_node_js? /.on_nashorn?] + (and (or /.on_nashorn? + /.on_node_js? + /.on_browser?) + (bit\= /.on_nashorn? + (not (or /.on_node_js? + /.on_browser?))) + (bit\= /.on_node_js? + (not (or /.on_nashorn? + /.on_browser?))) + (bit\= /.on_browser? + (not (or /.on_nashorn? + /.on_node_js?))))) + (_.cover [/.type_of] + (and (text\= "boolean" (/.type_of boolean)) + (text\= "number" (/.type_of number)) + (text\= "string" (/.type_of string)) + (text\= "function" (/.type_of function)) + (text\= "object" (/.type_of object)))) + (_.cover [/.import:] + (let [encoding "utf8"] + (text\= string + (cond /.on_nashorn? + (let [binary (java/lang/String::getBytes [encoding] (:as java/lang/String string))] + (|> (java/lang/String::new [binary encoding]) + (:as Text))) + + /.on_node_js? + (|> (Buffer::from [string encoding]) + (Buffer::toString [encoding])) + + ## On the browser + (let [binary (|> (TextEncoder::new [encoding]) + (TextEncoder::encode [string]))] + (|> (TextDecoder::new [encoding]) + (TextDecoder::decode [binary]))) + )))) + ))))) -- cgit v1.2.3