From e00e0b5f1e5fb509cf8f32424397110f524b8148 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 16 Jun 2022 02:16:07 -0400 Subject: New "parser" hierarchy. [Part 3] --- stdlib/source/test/aedifex/artifact/snapshot.lux | 8 +- .../test/aedifex/artifact/snapshot/build.lux | 8 +- .../test/aedifex/artifact/snapshot/stamp.lux | 8 +- .../test/aedifex/artifact/snapshot/version.lux | 8 +- stdlib/source/test/aedifex/artifact/versioning.lux | 8 +- stdlib/source/test/aedifex/metadata/artifact.lux | 6 +- stdlib/source/test/aedifex/metadata/snapshot.lux | 6 +- stdlib/source/test/aedifex/pom.lux | 6 +- stdlib/source/test/lux/control/parser.lux | 6 +- stdlib/source/test/lux/control/parser/json.lux | 167 ------------------- stdlib/source/test/lux/control/parser/xml.lux | 182 --------------------- stdlib/source/test/lux/data/format/json.lux | 159 ++++++++++++++++-- stdlib/source/test/lux/data/format/xml.lux | 174 +++++++++++++++++++- 13 files changed, 352 insertions(+), 394 deletions(-) delete mode 100644 stdlib/source/test/lux/control/parser/json.lux delete mode 100644 stdlib/source/test/lux/control/parser/xml.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux index 8888dc848..a318672eb 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot.lux @@ -7,9 +7,11 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try (.open: "[1]#[0]" functor)] - [parser - ["<[0]>" xml]]] + ["[0]" try (.open: "[1]#[0]" functor)]] + [data + [format + ["[0]" xml + ["<[1]>" \\parser]]]] [math ["[0]" random (.only Random) (.open: "[1]#[0]" monad)]]]] ["$[0]" / diff --git a/stdlib/source/test/aedifex/artifact/snapshot/build.lux b/stdlib/source/test/aedifex/artifact/snapshot/build.lux index f6224dd0b..259698287 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/build.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/build.lux @@ -7,9 +7,11 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try (.open: "[1]#[0]" functor)] - [parser - ["<[0]>" xml]]] + ["[0]" try (.open: "[1]#[0]" functor)]] + [data + [format + ["[0]" xml + ["<[1]>" \\parser]]]] [math ["[0]" random (.only Random)]]]] [\\program diff --git a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux index c24a06f5a..36b72daa8 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux @@ -7,9 +7,11 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try (.open: "[1]#[0]" functor)] - [parser - ["<[0]>" xml]]] + ["[0]" try (.open: "[1]#[0]" functor)]] + [data + [format + ["[0]" xml + ["<[1]>" \\parser]]]] [math ["[0]" random (.only Random)]] [time diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version.lux b/stdlib/source/test/aedifex/artifact/snapshot/version.lux index d2a3e01e4..97b51465d 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/version.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/version.lux @@ -7,9 +7,11 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try (.open: "[1]#[0]" functor)] - [parser - ["<[0]>" xml]]] + ["[0]" try (.open: "[1]#[0]" functor)]] + [data + [format + ["[0]" xml + ["<[1]>" \\parser]]]] [math ["[0]" random (.only Random)]]]] [\\program diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux index 451d0b824..ecd2ed616 100644 --- a/stdlib/source/test/aedifex/artifact/versioning.lux +++ b/stdlib/source/test/aedifex/artifact/versioning.lux @@ -7,9 +7,11 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try (.open: "[1]#[0]" functor)] - [parser - ["<[0]>" xml]]] + ["[0]" try (.open: "[1]#[0]" functor)]] + [data + [format + ["[0]" xml + ["<[1]>" \\parser]]]] [math ["[0]" random (.only Random)]]]] [\\program diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index a43777707..8dd0ef2b1 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -10,12 +10,14 @@ ["[0]" maybe] ["[0]" try (.open: "[1]#[0]" functor)] [parser - ["[0]" environment] - ["<[0]>" xml]] + ["[0]" environment]] [concurrency ["[0]" async]]] [data ["[0]" text (.open: "[1]#[0]" equivalence)] + [format + ["[0]" xml + ["<[1]>" \\parser]]] [collection ["[0]" list]]] [macro diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index a40ed0553..77975ddad 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -10,12 +10,14 @@ ["[0]" maybe] ["[0]" try (.open: "[1]#[0]" functor)] [parser - ["[0]" environment] - ["<[0]>" xml]] + ["[0]" environment]] [concurrency ["[0]" async]]] [data ["[0]" text (.open: "[1]#[0]" equivalence)] + [format + ["[0]" xml + ["<[1]>" \\parser]]] [collection ["[0]" list]]] [macro diff --git a/stdlib/source/test/aedifex/pom.lux b/stdlib/source/test/aedifex/pom.lux index e72eef0ef..a4956b3a4 100644 --- a/stdlib/source/test/aedifex/pom.lux +++ b/stdlib/source/test/aedifex/pom.lux @@ -7,12 +7,12 @@ [control ["[0]" try] ["[0]" exception] - ["<>" parser (.only) - ["<[0]>" xml]]] + ["<>" parser]] [data ["[0]" text (.open: "[1]#[0]" equivalence)] [format - ["[0]" xml]]] + ["[0]" xml (.only) + ["<[1]>" \\parser]]]] [math ["[0]" random]]]] [// diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 8bd0632d5..9d852ad86 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -31,10 +31,8 @@ ["[1][0]" cli] ["[1][0]" code] ["[1][0]" environment] - ["[1][0]" json] ["[1][0]" tree] - ["[1][0]" type] - ["[1][0]" xml]]) + ["[1][0]" type]]) (def (should_fail expected input) (All (_ a) (-> Text (Try a) Bit)) @@ -385,8 +383,6 @@ /cli.test /code.test /environment.test - /json.test /tree.test /type.test - /xml.test )))) diff --git a/stdlib/source/test/lux/control/parser/json.lux b/stdlib/source/test/lux/control/parser/json.lux deleted file mode 100644 index cf4faf7c4..000000000 --- a/stdlib/source/test/lux/control/parser/json.lux +++ /dev/null @@ -1,167 +0,0 @@ -(.using - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)]] - [control - ["[0]" pipe] - ["[0]" maybe] - ["[0]" try] - ["[0]" exception] - ["<>" parser]] - [data - ["[0]" bit] - ["[0]" text] - [collection - ["[0]" list (.open: "[1]#[0]" functor)] - ["[0]" set] - ["[0]" dictionary] - ["[0]" sequence (.only sequence) (.open: "[1]#[0]" functor)]] - [format - ["[0]" json]]] - [macro - ["^" pattern]] - [math - ["[0]" random (.only Random)] - [number - ["n" nat] - ["[0]" frac]]]]] - [\\library - ["[0]" /]]) - -(def !expect - (template (_ ) - [(case - - true - - _ - false)])) - -(def safe_frac - (Random Frac) - (random.only (|>> frac.not_a_number? not) random.frac)) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Parser]) - (`` (all _.and - (do [! random.monad] - [expected (at ! each (|>> {json.#String}) (random.unicode 1))] - (_.coverage [/.result /.any] - (|> (/.result /.any expected) - (!expect (^.multi {try.#Success actual} - (at json.equivalence = expected actual)))))) - (_.coverage [/.null] - (|> (/.result /.null {json.#Null}) - (!expect {try.#Success _}))) - (~~ (with_template [ ] - [(do [! random.monad] - [expected - dummy (|> (random.only (|>> (at = expected) not)))] - (all _.and - (_.coverage [] - (|> (/.result { expected}) - (!expect (^.multi {try.#Success actual} - (at = expected actual))))) - (_.coverage [] - (and (|> (/.result ( expected) { expected}) - (!expect {try.#Success #1})) - (|> (/.result ( expected) { dummy}) - (!expect {try.#Success #0})))) - (_.coverage [] - (and (|> (/.result ( expected) { expected}) - (!expect {try.#Success _})) - (|> (/.result ( expected) { dummy}) - (!expect {try.#Failure _}))))))] - - [/.boolean /.boolean? /.this_boolean random.bit json.#Boolean bit.equivalence] - [/.number /.number? /.this_number ..safe_frac json.#Number frac.equivalence] - [/.string /.string? /.this_string (random.unicode 1) json.#String text.equivalence] - )) - (do [! random.monad] - [expected (random.unicode 1) - dummy random.bit] - (_.coverage [/.unexpected_value] - (|> (/.result /.string {json.#Boolean dummy}) - (!expect (^.multi {try.#Failure error} - (exception.match? /.unexpected_value error)))))) - (do [! random.monad] - [expected (random.unicode 1) - dummy (|> (random.unicode 1) (random.only (|>> (at text.equivalence = expected) not)))] - (_.coverage [/.value_mismatch] - (|> (/.result (/.this_string expected) {json.#String dummy}) - (!expect (^.multi {try.#Failure error} - (exception.match? /.value_mismatch error)))))) - (do [! random.monad] - [expected (random.unicode 1)] - (_.coverage [/.nullable] - (and (|> (/.result (/.nullable /.string) {json.#Null}) - (!expect (^.multi {try.#Success actual} - (at (maybe.equivalence text.equivalence) = {.#None} actual)))) - (|> (/.result (/.nullable /.string) {json.#String expected}) - (!expect (^.multi {try.#Success actual} - (at (maybe.equivalence text.equivalence) = {.#Some expected} actual))))))) - (do [! random.monad] - [size (at ! each (n.% 10) random.nat) - expected (|> (random.unicode 1) - (random.list size) - (at ! each sequence.of_list))] - (_.coverage [/.array] - (|> (/.result (/.array (<>.some /.string)) - {json.#Array (sequence#each (|>> {json.#String}) expected)}) - (!expect (^.multi {try.#Success actual} - (at (sequence.equivalence text.equivalence) = expected (sequence.of_list actual))))))) - (do [! random.monad] - [expected (at ! each (|>> {json.#String}) (random.unicode 1))] - (_.coverage [/.unconsumed_input] - (|> (/.result (/.array /.any) {json.#Array (sequence expected expected)}) - (!expect (^.multi {try.#Failure error} - (exception.match? /.unconsumed_input error)))))) - (_.coverage [/.empty_input] - (|> (/.result (/.array /.any) {json.#Array (sequence)}) - (!expect (^.multi {try.#Failure error} - (exception.match? /.empty_input error))))) - (do [! random.monad] - [expected_boolean random.bit - expected_number ..safe_frac - expected_string (random.unicode 1) - [boolean_field number_field string_field] (|> (random.set text.hash 3 (random.unicode 3)) - (at ! each (|>> set.list - (pipe.case - (pattern (list boolean_field number_field string_field)) - [boolean_field number_field string_field] - - _ - (undefined)))))] - (_.coverage [/.object /.field] - (|> (/.result (/.object (all <>.and - (/.field boolean_field /.boolean) - (/.field number_field /.number) - (/.field string_field /.string))) - {json.#Object - (dictionary.of_list text.hash - (list [boolean_field {json.#Boolean expected_boolean}] - [number_field {json.#Number expected_number}] - [string_field {json.#String expected_string}]))}) - (!expect (^.multi {try.#Success [actual_boolean actual_number actual_string]} - (and (at bit.equivalence = expected_boolean actual_boolean) - (at frac.equivalence = expected_number actual_number) - (at text.equivalence = expected_string actual_string))))))) - (do [! random.monad] - [size (at ! each (n.% 10) random.nat) - keys (random.list size (random.unicode 1)) - values (random.list size (random.unicode 1)) - .let [expected (dictionary.of_list text.hash (list.zipped_2 keys values))]] - (_.coverage [/.dictionary] - (|> (/.result (/.dictionary /.string) - {json.#Object - (|> values - (list#each (|>> {json.#String})) - (list.zipped_2 keys) - (dictionary.of_list text.hash))}) - (!expect (^.multi {try.#Success actual} - (at (dictionary.equivalence text.equivalence) = expected actual)))))) - )))) diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux deleted file mode 100644 index b671c071e..000000000 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ /dev/null @@ -1,182 +0,0 @@ -(.using - [library - [lux (.except) - ["_" test (.only Test)] - ["[0]" type (.open: "[1]#[0]" equivalence)] - [abstract - [monad (.only do)]] - [control - ["[0]" try (.open: "[1]#[0]" functor)] - ["[0]" exception]] - [data - ["[0]" text (.open: "[1]#[0]" equivalence)] - [format - ["[0]" xml (.open: "[1]#[0]" equivalence)]] - [collection - ["[0]" dictionary] - ["[0]" list]]] - [macro - ["^" pattern] - ["[0]" template]] - [math - ["[0]" random (.only Random)] - [number - ["n" nat]]] - [meta - ["[0]" symbol (.open: "[1]#[0]" equivalence)]]]] - [\\library - ["[0]" / (.only) - ["/[1]" // (.open: "[1]#[0]" monad)]]]) - -(def !expect - (template (_ ) - [(case - - true - - _ - false)])) - -(def !failure - (template (_ ) - [(with_expansions [<> (template.spliced )] - (do [! random.monad] - [expected (random.alphabetic 1)] - (_.coverage [] - (`` (and (~~ (with_template [ ] - [(|> (/.result (list )) - (!expect (^.multi {try.#Failure error} - (exception.match? error))))] - - <>)))))))])) - -(def random_label - (Random Symbol) - (random.and (random.alphabetic 1) - (random.alphabetic 1))) - -(def random_tag ..random_label) -(def random_attribute ..random_label) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Parser]) - (all _.and - (do [! random.monad] - [expected (random.alphabetic 1)] - (_.coverage [/.result /.text] - (|> (/.result /.text (list {xml.#Text expected})) - (!expect (^.multi {try.#Success actual} - (text#= expected actual)))))) - (!failure /.unconsumed_inputs - [[(//#in expected) - {xml.#Text expected}]]) - (do [! random.monad] - [expected (at ! each (|>> {xml.#Text}) (random.alphabetic 1))] - (_.coverage [/.any] - (|> (/.result /.any (list expected)) - (try#each (xml#= expected)) - (try.else false)))) - (do [! random.monad] - [expected ..random_tag] - (_.coverage [/.tag] - (|> (/.result (do //.monad - [actual /.tag - _ /.any] - (in (symbol#= expected actual))) - (list {xml.#Node expected (dictionary.empty symbol.hash) (list)})) - (!expect {try.#Success #1})))) - (do [! random.monad] - [expected ..random_tag] - (_.coverage [/.node] - (|> (/.result (/.node expected (//#in [])) - (list {xml.#Node expected (dictionary.empty symbol.hash) (list)})) - (!expect {try.#Success []})))) - (!failure /.wrong_tag - [[(/.node ["" expected] (//#in [])) - {xml.#Node [expected ""] (dictionary.empty symbol.hash) (list)}]]) - (do [! random.monad] - [expected_tag ..random_tag - expected_attribute ..random_attribute - expected_value (random.alphabetic 1)] - (_.coverage [/.attribute] - (|> (/.result (<| (/.node expected_tag) - (//.after (/.attribute expected_attribute)) - (//#in [])) - (list {xml.#Node expected_tag - (|> (dictionary.empty symbol.hash) - (dictionary.has expected_attribute expected_value)) - (list)})) - (!expect {try.#Success []})))) - (!failure /.unknown_attribute - [[(/.attribute ["" expected]) - {xml.#Node [expected expected] - (|> (dictionary.empty symbol.hash) - (dictionary.has [expected ""] expected)) - (list)}]]) - (!failure /.empty_input - [[(do //.monad - [_ /.any] - /.any) - {xml.#Text expected}] - [(do //.monad - [_ /.any] - /.text) - {xml.#Text expected}] - [(do //.monad - [_ /.any] - (/.node [expected expected] - (//#in []))) - {xml.#Node [expected expected] - (dictionary.empty symbol.hash) - (list)}] - [(do //.monad - [_ /.any] - (/.node [expected expected] - (/.attribute [expected expected]))) - {xml.#Node [expected expected] - (|> (dictionary.empty symbol.hash) - (dictionary.has [expected expected] expected)) - (list)}]]) - (!failure /.unexpected_input - [[/.text - {xml.#Node [expected expected] (dictionary.empty symbol.hash) (list)}] - [(/.node [expected expected] - (//#in [])) - {xml.#Text expected}] - [(/.node [expected expected] - (/.attribute [expected expected])) - {xml.#Text expected}]]) - (do [! random.monad] - [.let [node (is (-> xml.Tag (List xml.XML) xml.XML) - (function (_ tag children) - {xml.#Node tag (dictionary.empty symbol.hash) children}))] - parent ..random_tag - right ..random_tag - wrong (random.only (|>> (symbol#= right) not) - ..random_tag) - .let [parser (<| (/.node parent) - (do //.monad - [_ (<| /.somewhere - (/.node right) - (//#in [])) - _ (//.some /.any)] - (in [])))] - repetitions (at ! each (n.% 10) random.nat)] - (all _.and - (_.coverage [/.somewhere] - (|> (/.result parser - (list (node parent - (list.together (list (list.repeated repetitions (node wrong (list))) - (list (node right (list))) - (list.repeated repetitions (node wrong (list)))))))) - (!expect {try.#Success []}))) - (_.coverage [/.nowhere] - (|> (/.result parser - (list (node parent - (list.repeated repetitions (node wrong (list)))))) - (!expect (^.multi {try.#Failure error} - (exception.match? /.nowhere error))))) - )) - ))) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 13d7f11cc..1f626c15d 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -13,41 +13,179 @@ ["$[0]" equivalence] ["$[0]" codec]]] [control - ["[0]" try (.open: "[1]#[0]" functor)] - ["p" parser - ... TODO: Get rid of this import ASAP - [json (.only)]]] + ["<>" parser] + ["[0]" pipe] + ["[0]" maybe] + ["[0]" exception] + ["[0]" try (.open: "[1]#[0]" functor)]] [data ["[0]" product] ["[0]" bit] ["[0]" text (.only) ["%" \\format (.only format)]] [collection - ["[0]" sequence (.only sequence)] + ["[0]" sequence (.only sequence) (.open: "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)] ["[0]" set] ["[0]" list (.open: "[1]#[0]" functor)]]] + ["[0]" macro (.only) + ["^" pattern] + ["[0]" syntax (.only syntax)] + ["[0]" code]] [math ["[0]" random (.only Random)] [number ["n" nat] ["[0]" frac]]] - ["[0]" macro (.only) - ["[0]" syntax (.only syntax)] - ["[0]" code]] [time ["[0]" date] ["[0]" instant ["[0]/[1]" \\test]] ["[0]" duration - ["[0]/[1]" \\test]] - ] + ["[0]/[1]" \\test]]] [type ["[0]" unit]]]] ["[0]" \\polytypic] + ["[0]" \\parser] [\\library ["[0]" / (.only JSON) (.open: "[1]#[0]" equivalence)]]) +(def !expect + (template (_ ) + [(case + + true + + _ + false)])) + +(def safe_frac + (Random Frac) + (random.only (|>> frac.not_a_number? not) random.frac)) + +(def \\parser + Test + (<| (_.covering \\parser._) + (_.for [\\parser.Parser]) + (`` (all _.and + (do [! random.monad] + [expected (at ! each (|>> {/.#String}) (random.unicode 1))] + (_.coverage [\\parser.result \\parser.any] + (|> (\\parser.result \\parser.any expected) + (!expect (^.multi {try.#Success actual} + (at /.equivalence = expected actual)))))) + (_.coverage [\\parser.null] + (|> (\\parser.result \\parser.null {/.#Null}) + (!expect {try.#Success _}))) + (~~ (with_template [ ] + [(do [! random.monad] + [expected + dummy (|> (random.only (|>> (at = expected) not)))] + (all _.and + (_.coverage [] + (|> (\\parser.result { expected}) + (!expect (^.multi {try.#Success actual} + (at = expected actual))))) + (_.coverage [] + (and (|> (\\parser.result ( expected) { expected}) + (!expect {try.#Success #1})) + (|> (\\parser.result ( expected) { dummy}) + (!expect {try.#Success #0})))) + (_.coverage [] + (and (|> (\\parser.result ( expected) { expected}) + (!expect {try.#Success _})) + (|> (\\parser.result ( expected) { dummy}) + (!expect {try.#Failure _}))))))] + + [\\parser.boolean \\parser.boolean? \\parser.this_boolean random.bit /.#Boolean bit.equivalence] + [\\parser.number \\parser.number? \\parser.this_number ..safe_frac /.#Number frac.equivalence] + [\\parser.string \\parser.string? \\parser.this_string (random.unicode 1) /.#String text.equivalence] + )) + (do [! random.monad] + [expected (random.unicode 1) + dummy random.bit] + (_.coverage [\\parser.unexpected_value] + (|> (\\parser.result \\parser.string {/.#Boolean dummy}) + (!expect (^.multi {try.#Failure error} + (exception.match? \\parser.unexpected_value error)))))) + (do [! random.monad] + [expected (random.unicode 1) + dummy (|> (random.unicode 1) (random.only (|>> (at text.equivalence = expected) not)))] + (_.coverage [\\parser.value_mismatch] + (|> (\\parser.result (\\parser.this_string expected) {/.#String dummy}) + (!expect (^.multi {try.#Failure error} + (exception.match? \\parser.value_mismatch error)))))) + (do [! random.monad] + [expected (random.unicode 1)] + (_.coverage [\\parser.nullable] + (and (|> (\\parser.result (\\parser.nullable \\parser.string) {/.#Null}) + (!expect (^.multi {try.#Success actual} + (at (maybe.equivalence text.equivalence) = {.#None} actual)))) + (|> (\\parser.result (\\parser.nullable \\parser.string) {/.#String expected}) + (!expect (^.multi {try.#Success actual} + (at (maybe.equivalence text.equivalence) = {.#Some expected} actual))))))) + (do [! random.monad] + [size (at ! each (n.% 10) random.nat) + expected (|> (random.unicode 1) + (random.list size) + (at ! each sequence.of_list))] + (_.coverage [\\parser.array] + (|> (\\parser.result (\\parser.array (<>.some \\parser.string)) + {/.#Array (sequence#each (|>> {/.#String}) expected)}) + (!expect (^.multi {try.#Success actual} + (at (sequence.equivalence text.equivalence) = expected (sequence.of_list actual))))))) + (do [! random.monad] + [expected (at ! each (|>> {/.#String}) (random.unicode 1))] + (_.coverage [\\parser.unconsumed_input] + (|> (\\parser.result (\\parser.array \\parser.any) {/.#Array (sequence expected expected)}) + (!expect (^.multi {try.#Failure error} + (exception.match? \\parser.unconsumed_input error)))))) + (_.coverage [\\parser.empty_input] + (|> (\\parser.result (\\parser.array \\parser.any) {/.#Array (sequence)}) + (!expect (^.multi {try.#Failure error} + (exception.match? \\parser.empty_input error))))) + (do [! random.monad] + [expected_boolean random.bit + expected_number ..safe_frac + expected_string (random.unicode 1) + [boolean_field number_field string_field] (|> (random.set text.hash 3 (random.unicode 3)) + (at ! each (|>> set.list + (pipe.case + (pattern (list boolean_field number_field string_field)) + [boolean_field number_field string_field] + + _ + (undefined)))))] + (_.coverage [\\parser.object \\parser.field] + (|> (\\parser.result (\\parser.object (all <>.and + (\\parser.field boolean_field \\parser.boolean) + (\\parser.field number_field \\parser.number) + (\\parser.field string_field \\parser.string))) + {/.#Object + (dictionary.of_list text.hash + (list [boolean_field {/.#Boolean expected_boolean}] + [number_field {/.#Number expected_number}] + [string_field {/.#String expected_string}]))}) + (!expect (^.multi {try.#Success [actual_boolean actual_number actual_string]} + (and (at bit.equivalence = expected_boolean actual_boolean) + (at frac.equivalence = expected_number actual_number) + (at text.equivalence = expected_string actual_string))))))) + (do [! random.monad] + [size (at ! each (n.% 10) random.nat) + keys (random.list size (random.unicode 1)) + values (random.list size (random.unicode 1)) + .let [expected (dictionary.of_list text.hash (list.zipped_2 keys values))]] + (_.coverage [\\parser.dictionary] + (|> (\\parser.result (\\parser.dictionary \\parser.string) + {/.#Object + (|> values + (list#each (|>> {/.#String})) + (list.zipped_2 keys) + (dictionary.of_list text.hash))}) + (!expect (^.multi {try.#Success actual} + (at (dictionary.equivalence text.equivalence) = expected actual)))))) + )))) + (type: Variant (.Variant {#Bit Bit} @@ -294,4 +432,5 @@ ))) ..\\polytypic + ..\\parser )))) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 0798b1d83..d003276e9 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -2,16 +2,17 @@ [library [lux (.except char symbol) ["_" test (.only Test)] + ["[0]" type (.open: "[1]#[0]" equivalence)] [abstract - [monad (.only Monad do)] + [monad (.only do)] [\\specification ["$[0]" equivalence] ["$[0]" codec]]] [control + ["<>" parser (.open: "[1]#[0]" monad)] ["[0]" maybe] - ["[0]" try] - ["p" parser - ["" xml]]] + ["[0]" try (.open: "[1]#[0]" functor)] + ["[0]" exception]] [data ["[0]" text (.open: "[1]#[0]" equivalence) ["%" \\format (.only format)]] @@ -19,15 +20,170 @@ ["[0]" dictionary] ["[0]" list (.open: "[1]#[0]" functor)]]] [macro - ["^" pattern]] + ["^" pattern] + ["[0]" template]] [math ["[0]" random (.only Random) (.open: "[1]#[0]" monad)] [number ["n" nat]]] [meta - ["[0]" symbol]]]] + ["[0]" symbol (.open: "[1]#[0]" equivalence)]]]] + ["[0]" \\parser] [\\library - ["[0]" / (.only XML)]]) + ["[0]" / (.open: "[1]#[0]" equivalence)]]) + +(def !expect + (template (_ ) + [(case + + true + + _ + false)])) + +(def !failure + (template (_ ) + [(with_expansions [<> (template.spliced )] + (do [! random.monad] + [expected (random.alphabetic 1)] + (_.coverage [] + (`` (and (~~ (with_template [ ] + [(|> (\\parser.result (list )) + (!expect (^.multi {try.#Failure error} + (exception.match? error))))] + + <>)))))))])) + +(def random_label + (Random Symbol) + (random.and (random.alphabetic 1) + (random.alphabetic 1))) + +(def random_tag ..random_label) +(def random_attribute ..random_label) + +(def \\parser + Test + (<| (_.covering \\parser._) + (_.for [\\parser.Parser]) + (all _.and + (do [! random.monad] + [expected (random.alphabetic 1)] + (_.coverage [\\parser.result \\parser.text] + (|> (\\parser.result \\parser.text (list {/.#Text expected})) + (!expect (^.multi {try.#Success actual} + (text#= expected actual)))))) + (!failure \\parser.unconsumed_inputs + [[(<>#in expected) + {/.#Text expected}]]) + (do [! random.monad] + [expected (at ! each (|>> {/.#Text}) (random.alphabetic 1))] + (_.coverage [\\parser.any] + (|> (\\parser.result \\parser.any (list expected)) + (try#each (/#= expected)) + (try.else false)))) + (do [! random.monad] + [expected ..random_tag] + (_.coverage [\\parser.tag] + (|> (\\parser.result (do <>.monad + [actual \\parser.tag + _ \\parser.any] + (in (symbol#= expected actual))) + (list {/.#Node expected (dictionary.empty symbol.hash) (list)})) + (!expect {try.#Success #1})))) + (do [! random.monad] + [expected ..random_tag] + (_.coverage [\\parser.node] + (|> (\\parser.result (\\parser.node expected (<>#in [])) + (list {/.#Node expected (dictionary.empty symbol.hash) (list)})) + (!expect {try.#Success []})))) + (!failure \\parser.wrong_tag + [[(\\parser.node ["" expected] (<>#in [])) + {/.#Node [expected ""] (dictionary.empty symbol.hash) (list)}]]) + (do [! random.monad] + [expected_tag ..random_tag + expected_attribute ..random_attribute + expected_value (random.alphabetic 1)] + (_.coverage [\\parser.attribute] + (|> (\\parser.result (<| (\\parser.node expected_tag) + (<>.after (\\parser.attribute expected_attribute)) + (<>#in [])) + (list {/.#Node expected_tag + (|> (dictionary.empty symbol.hash) + (dictionary.has expected_attribute expected_value)) + (list)})) + (!expect {try.#Success []})))) + (!failure \\parser.unknown_attribute + [[(\\parser.attribute ["" expected]) + {/.#Node [expected expected] + (|> (dictionary.empty symbol.hash) + (dictionary.has [expected ""] expected)) + (list)}]]) + (!failure \\parser.empty_input + [[(do <>.monad + [_ \\parser.any] + \\parser.any) + {/.#Text expected}] + [(do <>.monad + [_ \\parser.any] + \\parser.text) + {/.#Text expected}] + [(do <>.monad + [_ \\parser.any] + (\\parser.node [expected expected] + (<>#in []))) + {/.#Node [expected expected] + (dictionary.empty symbol.hash) + (list)}] + [(do <>.monad + [_ \\parser.any] + (\\parser.node [expected expected] + (\\parser.attribute [expected expected]))) + {/.#Node [expected expected] + (|> (dictionary.empty symbol.hash) + (dictionary.has [expected expected] expected)) + (list)}]]) + (!failure \\parser.unexpected_input + [[\\parser.text + {/.#Node [expected expected] (dictionary.empty symbol.hash) (list)}] + [(\\parser.node [expected expected] + (<>#in [])) + {/.#Text expected}] + [(\\parser.node [expected expected] + (\\parser.attribute [expected expected])) + {/.#Text expected}]]) + (do [! random.monad] + [.let [node (is (-> /.Tag (List /.XML) /.XML) + (function (_ tag children) + {/.#Node tag (dictionary.empty symbol.hash) children}))] + parent ..random_tag + right ..random_tag + wrong (random.only (|>> (symbol#= right) not) + ..random_tag) + .let [parser (<| (\\parser.node parent) + (do <>.monad + [_ (<| \\parser.somewhere + (\\parser.node right) + (<>#in [])) + _ (<>.some \\parser.any)] + (in [])))] + repetitions (at ! each (n.% 10) random.nat)] + (all _.and + (_.coverage [\\parser.somewhere] + (|> (\\parser.result parser + (list (node parent + (list.together (list (list.repeated repetitions (node wrong (list))) + (list (node right (list))) + (list.repeated repetitions (node wrong (list)))))))) + (!expect {try.#Success []}))) + (_.coverage [\\parser.nowhere] + (|> (\\parser.result parser + (list (node parent + (list.repeated repetitions (node wrong (list)))))) + (!expect (^.multi {try.#Failure error} + (exception.match? \\parser.nowhere error))))) + )) + ))) (def char_range Text @@ -58,7 +214,7 @@ (..text 1 10))) (def .public random - (Random XML) + (Random /.XML) (random.rec (function (_ random) (random.or (..text 1 10) (do random.monad @@ -94,4 +250,6 @@ (_.coverage [/.Attrs /.attributes] (dictionary.empty? /.attributes)) ))) + + ..\\parser ))) -- cgit v1.2.3