From 149515fd173947dcff20558fca077fbd16dc9b6c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 27 Jun 2022 03:26:33 -0400 Subject: New "parser" hierarchy. [Part 5] --- stdlib/source/test/lux/control/parser.lux | 6 +- stdlib/source/test/lux/control/parser/cli.lux | 86 ----------- stdlib/source/test/lux/control/parser/tree.lux | 178 ---------------------- stdlib/source/test/lux/data/collection/tree.lux | 168 +++++++++++++++++++- stdlib/source/test/lux/program.lux | 162 ++++++++++++++------ stdlib/source/test/lux/tool/compiler/meta/cli.lux | 15 +- 6 files changed, 293 insertions(+), 322 deletions(-) delete mode 100644 stdlib/source/test/lux/control/parser/cli.lux delete mode 100644 stdlib/source/test/lux/control/parser/tree.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index e977e9df3..624999201 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -27,9 +27,7 @@ [\\library ["[0]" / (.only Parser)]] ["[0]" / - ["[1][0]" cli] - ["[1][0]" environment] - ["[1][0]" tree]]) + ["[1][0]" environment]]) (def (should_fail expected input) (All (_ a) (-> Text (Try a) Bit)) @@ -377,7 +375,5 @@ ..combinators_1 ..combinators_2 - /cli.test /environment.test - /tree.test )))) diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux deleted file mode 100644 index 46f04712c..000000000 --- a/stdlib/source/test/lux/control/parser/cli.lux +++ /dev/null @@ -1,86 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)]] - [control - ["[0]" try] - ["<>" parser]] - [data - ["[0]" text (.use "[1]#[0]" equivalence)] - [collection - ["[0]" list]]] - [macro - ["^" pattern]] - [math - ["[0]" random] - [number - ["n" nat (.use "[1]#[0]" decimal)]]]]] - [\\library - ["[0]" /]]) - -(def !expect - (template (_ ) - [(case - - true - - _ - false)])) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Parser]) - (do [! random.monad] - [expected (at ! each n#encoded random.nat) - .let [random_dummy (random.only (|>> (text#= expected) not) - (random.unicode 5))] - dummy random_dummy - short (random.unicode 1) - long (random.unicode 2) - pre_ignore (random.list 5 random_dummy) - post_ignore (random.list 5 random_dummy)] - (all _.and - (_.coverage [/.result /.any] - (|> (/.result /.any (list expected)) - (!expect (^.multi {try.#Success actual} - (text#= expected actual))))) - (_.coverage [/.parse] - (|> (/.result (/.parse n#decoded) (list expected)) - (!expect (^.multi {try.#Success actual} - (text#= expected - (n#encoded actual)))))) - (_.coverage [/.this] - (and (|> (/.result (/.this expected) (list expected)) - (!expect {try.#Success _})) - (|> (/.result (/.this expected) (list dummy)) - (!expect {try.#Failure _})))) - (_.coverage [/.somewhere] - (|> (/.result (|> (/.somewhere (/.this expected)) - (<>.before (<>.some /.any))) - (list.together (list pre_ignore (list expected) post_ignore))) - (!expect {try.#Success _}))) - (_.coverage [/.end] - (and (|> (/.result /.end (list)) - (!expect {try.#Success _})) - (|> (/.result (<>.not /.end) (list expected)) - (!expect {try.#Failure _})))) - (_.coverage [/.named] - (|> (/.result (/.named dummy /.any) (list dummy expected)) - (!expect (^.multi {try.#Success actual} - (text#= expected actual))))) - (_.coverage [/.parameter] - (and (|> (/.result (/.parameter [short long] /.any) - (list short expected)) - (!expect (^.multi {try.#Success actual} - (text#= expected actual)))) - (|> (/.result (/.parameter [short long] /.any) - (list long expected)) - (!expect (^.multi {try.#Success actual} - (text#= expected actual)))) - (|> (/.result (/.parameter [short long] /.any) - (list dummy expected)) - (!expect {try.#Failure _})))) - )))) diff --git a/stdlib/source/test/lux/control/parser/tree.lux b/stdlib/source/test/lux/control/parser/tree.lux deleted file mode 100644 index 9ac82705e..000000000 --- a/stdlib/source/test/lux/control/parser/tree.lux +++ /dev/null @@ -1,178 +0,0 @@ -(.require - [library - [lux (.except) - ["_" test (.only Test)] - [abstract - [monad (.only do)]] - [control - ["[0]" try] - ["[0]" exception]] - [data - [collection - ["[0]" tree (.only) - ["[0]" zipper]]]] - [macro - ["^" pattern]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" / (.only) - ["/[1]" //]]]) - -(def !expect - (template (_ ) - [(case - - true - - _ - false)])) - -(def !cover - (template (_ ) - [(do [! random.monad] - [dummy random.nat - expected (|> random.nat (random.only (|>> (n.= dummy) not)))] - (_.coverage - (|> (/.result - ) - (!expect (^.multi {try.#Success actual} - (n.= expected actual))))))])) - -(def !cover/2 - (template (_ ) - [(do [! random.monad] - [dummy random.nat - expected (|> random.nat (random.only (|>> (n.= dummy) not)))] - (_.coverage - (and (|> (/.result ) - (!expect (^.multi {try.#Success actual} - (n.= expected actual)))) - (|> (/.result ) - (!expect (^.multi {try.#Success actual} - (n.= expected actual)))))))])) - -(def .public test - Test - (<| (_.covering /._) - (_.for [/.Parser]) - (all _.and - (!cover [/.result /.value] - /.value - (tree.leaf expected)) - (do [! random.monad] - [expected random.nat] - (_.coverage [/.result'] - (|> (/.result' /.value - (zipper.zipper (tree.leaf expected))) - (!expect (^.multi {try.#Success actual} - (n.= expected actual)))))) - (!cover [/.down] - (do //.monad - [_ /.down] - /.value) - (tree.branch dummy - (list (tree.leaf expected)))) - (!cover [/.up] - (do //.monad - [_ /.down - _ /.up] - /.value) - (tree.branch expected - (list (tree.leaf dummy)))) - (!cover [/.right] - (do //.monad - [_ /.down - _ /.right] - /.value) - (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf expected)))) - (!cover [/.left] - (do //.monad - [_ /.down - _ /.right - _ /.left] - /.value) - (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy)))) - (!cover [/.rightmost] - (do //.monad - [_ /.down - _ /.rightmost] - /.value) - (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf expected)))) - (!cover [/.leftmost] - (do //.monad - [_ /.down - _ /.rightmost - _ /.leftmost] - /.value) - (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy) - (tree.leaf dummy)))) - (!cover/2 [/.next] - (do //.monad - [_ /.next - _ /.next] - /.value) - (tree.branch dummy - (list (tree.branch dummy - (list (tree.leaf expected))))) - (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf expected)))) - (!cover/2 [/.previous] - (do //.monad - [_ /.next - _ /.next - _ /.previous] - /.value) - (tree.branch dummy - (list (tree.branch expected - (list (tree.leaf dummy))))) - (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy)))) - (!cover/2 [/.end] - (do //.monad - [_ /.end] - /.value) - (tree.branch dummy - (list (tree.branch dummy - (list (tree.leaf expected))))) - (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf expected)))) - (!cover/2 [/.start] - (do //.monad - [_ /.end - _ /.start] - /.value) - (tree.branch expected - (list (tree.branch dummy - (list (tree.leaf dummy))))) - (tree.branch expected - (list (tree.leaf dummy) - (tree.leaf dummy)))) - (do [! random.monad] - [dummy random.nat] - (_.coverage [/.cannot_move_further] - (`` (and (~~ (with_template [] - [(|> (/.result - (tree.leaf dummy)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.cannot_move_further error))))] - - [/.down] [/.up] - [/.right] [/.left] - [/.next] [/.previous] - )))))) - ))) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index 6e5c5fde7..f03c2725f 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -8,16 +8,180 @@ ["$[0]" equivalence] ["$[0]" mix] ["$[0]" functor]]] + [control + ["//" parser] + ["[0]" try] + ["[0]" exception]] [data ["[0]" product] [collection ["[0]" list (.use "[1]#[0]" functor mix)]]] + [macro + ["^" pattern]] [math ["[0]" random (.only Random)] [number ["n" nat]]]]] + ["[0]" \\parser] [\\library - ["[0]" / (.only Tree)]]) + ["[0]" / (.only Tree) + ["[0]" zipper]]]) + +(def !expect + (template (_ ) + [(case + + true + + _ + false)])) + +(def !cover + (template (_ ) + [(do [! random.monad] + [dummy random.nat + expected (|> random.nat (random.only (|>> (n.= dummy) not)))] + (_.coverage + (|> (\\parser.result + ) + (!expect (^.multi {try.#Success actual} + (n.= expected actual))))))])) + +(def !cover/2 + (template (_ ) + [(do [! random.monad] + [dummy random.nat + expected (|> random.nat (random.only (|>> (n.= dummy) not)))] + (_.coverage + (and (|> (\\parser.result ) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))) + (|> (\\parser.result ) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))))))])) + +(def \\parser + Test + (<| (_.covering \\parser._) + (_.for [\\parser.Parser]) + (all _.and + (!cover [\\parser.result \\parser.value] + \\parser.value + (/.leaf expected)) + (do [! random.monad] + [expected random.nat] + (_.coverage [\\parser.result'] + (|> (\\parser.result' \\parser.value + (zipper.zipper (/.leaf expected))) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))))) + (!cover [\\parser.down] + (do //.monad + [_ \\parser.down] + \\parser.value) + (/.branch dummy + (list (/.leaf expected)))) + (!cover [\\parser.up] + (do //.monad + [_ \\parser.down + _ \\parser.up] + \\parser.value) + (/.branch expected + (list (/.leaf dummy)))) + (!cover [\\parser.right] + (do //.monad + [_ \\parser.down + _ \\parser.right] + \\parser.value) + (/.branch dummy + (list (/.leaf dummy) + (/.leaf expected)))) + (!cover [\\parser.left] + (do //.monad + [_ \\parser.down + _ \\parser.right + _ \\parser.left] + \\parser.value) + (/.branch dummy + (list (/.leaf expected) + (/.leaf dummy)))) + (!cover [\\parser.rightmost] + (do //.monad + [_ \\parser.down + _ \\parser.rightmost] + \\parser.value) + (/.branch dummy + (list (/.leaf dummy) + (/.leaf dummy) + (/.leaf expected)))) + (!cover [\\parser.leftmost] + (do //.monad + [_ \\parser.down + _ \\parser.rightmost + _ \\parser.leftmost] + \\parser.value) + (/.branch dummy + (list (/.leaf expected) + (/.leaf dummy) + (/.leaf dummy)))) + (!cover/2 [\\parser.next] + (do //.monad + [_ \\parser.next + _ \\parser.next] + \\parser.value) + (/.branch dummy + (list (/.branch dummy + (list (/.leaf expected))))) + (/.branch dummy + (list (/.leaf dummy) + (/.leaf expected)))) + (!cover/2 [\\parser.previous] + (do //.monad + [_ \\parser.next + _ \\parser.next + _ \\parser.previous] + \\parser.value) + (/.branch dummy + (list (/.branch expected + (list (/.leaf dummy))))) + (/.branch dummy + (list (/.leaf expected) + (/.leaf dummy)))) + (!cover/2 [\\parser.end] + (do //.monad + [_ \\parser.end] + \\parser.value) + (/.branch dummy + (list (/.branch dummy + (list (/.leaf expected))))) + (/.branch dummy + (list (/.leaf dummy) + (/.leaf expected)))) + (!cover/2 [\\parser.start] + (do //.monad + [_ \\parser.end + _ \\parser.start] + \\parser.value) + (/.branch expected + (list (/.branch dummy + (list (/.leaf dummy))))) + (/.branch expected + (list (/.leaf dummy) + (/.leaf dummy)))) + (do [! random.monad] + [dummy random.nat] + (_.coverage [\\parser.cannot_move_further] + (`` (and (~~ (with_template [] + [(|> (\\parser.result + (/.leaf dummy)) + (!expect (^.multi {try.#Failure error} + (exception.match? \\parser.cannot_move_further error))))] + + [\\parser.down] [\\parser.up] + [\\parser.right] [\\parser.left] + [\\parser.next] [\\parser.previous] + )))))) + ))) (def .public (tree gen_value) (All (_ a) (-> (Random a) (Random [Nat (Tree a)]))) @@ -88,4 +252,6 @@ expected/2 {expected/3 {} expected/4 {expected/5 {}}}}))) ))) + + ..\\parser ))) diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index 6b462da5e..8d534dd6e 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -5,23 +5,91 @@ [abstract [monad (.only do)]] [control + ["<>" parser] ["[0]" io] - ["[0]" try] - ["<>" parser (.only) - ["<[0]>" cli]]] + ["[0]" try]] [data - ["[0]" text] + ["[0]" text (.use "[1]#[0]" equivalence)] [collection ["[0]" list]]] [macro [syntax (.only syntax)] + ["^" pattern] ["[0]" code ["<[1]>" \\parser]]] [math - ["[0]" random]]]] + ["[0]" random] + [number + ["n" nat (.use "[1]#[0]" decimal)]]]]] + ["[0]" \\parser] [\\library ["[0]" /]]) +(def !expect + (template (_ ) + [(case + + true + + _ + false)])) + +(def \\parser + Test + (<| (_.covering \\parser._) + (_.for [\\parser.Parser]) + (do [! random.monad] + [expected (at ! each n#encoded random.nat) + .let [random_dummy (random.only (|>> (text#= expected) not) + (random.unicode 5))] + dummy random_dummy + short (random.unicode 1) + long (random.unicode 2) + pre_ignore (random.list 5 random_dummy) + post_ignore (random.list 5 random_dummy)] + (all _.and + (_.coverage [\\parser.result \\parser.any] + (|> (\\parser.result \\parser.any (list expected)) + (!expect (^.multi {try.#Success actual} + (text#= expected actual))))) + (_.coverage [\\parser.parse] + (|> (\\parser.result (\\parser.parse n#decoded) (list expected)) + (!expect (^.multi {try.#Success actual} + (text#= expected + (n#encoded actual)))))) + (_.coverage [\\parser.this] + (and (|> (\\parser.result (\\parser.this expected) (list expected)) + (!expect {try.#Success _})) + (|> (\\parser.result (\\parser.this expected) (list dummy)) + (!expect {try.#Failure _})))) + (_.coverage [\\parser.somewhere] + (|> (\\parser.result (|> (\\parser.somewhere (\\parser.this expected)) + (<>.before (<>.some \\parser.any))) + (list.together (list pre_ignore (list expected) post_ignore))) + (!expect {try.#Success _}))) + (_.coverage [\\parser.end] + (and (|> (\\parser.result \\parser.end (list)) + (!expect {try.#Success _})) + (|> (\\parser.result (<>.not \\parser.end) (list expected)) + (!expect {try.#Failure _})))) + (_.coverage [\\parser.named] + (|> (\\parser.result (\\parser.named dummy \\parser.any) (list dummy expected)) + (!expect (^.multi {try.#Success actual} + (text#= expected actual))))) + (_.coverage [\\parser.parameter] + (and (|> (\\parser.result (\\parser.parameter [short long] \\parser.any) + (list short expected)) + (!expect (^.multi {try.#Success actual} + (text#= expected actual)))) + (|> (\\parser.result (\\parser.parameter [short long] \\parser.any) + (list long expected)) + (!expect (^.multi {try.#Success actual} + (text#= expected actual)))) + (|> (\\parser.result (\\parser.parameter [short long] \\parser.any) + (list dummy expected)) + (!expect {try.#Failure _})))) + )))) + (def actual_program (syntax (_ [actual_program (<| .form (<>.after (.this_text "lux def program")) @@ -33,43 +101,47 @@ (<| (_.covering /._) (do random.monad [inputs (random.list 5 (random.upper_case 5))] - (_.coverage [/.program:] - (let [(open "list#[0]") (list.equivalence text.equivalence)] - (and (with_expansions [ (/.program: all_arguments - (io.io all_arguments))] - (let [outcome ((is (-> (List Text) (io.IO Any)) - (..actual_program )) - inputs)] - (same? (is Any inputs) - (io.run! outcome)))) - (with_expansions [ (/.program: [arg/0 .any - arg/1 .any - arg/2 .any - arg/3 .any - arg/4 .any] - (io.io (list arg/4 arg/3 arg/2 arg/1 arg/0)))] - (let [outcome ((is (-> (List Text) (io.IO Any)) - (..actual_program )) - inputs)] - (list#= (list.reversed inputs) - (as (List Text) (io.run! outcome))))) - (with_expansions [ (/.program: [all_arguments (<>.many .any)] - (io.io all_arguments))] - (let [outcome ((is (-> (List Text) (io.IO Any)) - (..actual_program )) - inputs)] - (list#= inputs - (as (List Text) (io.run! outcome))))) - (with_expansions [ (/.program: [arg/0 .any - arg/1 .any - arg/2 .any - arg/3 .any] - (io.io []))] - (case (try ((is (-> (List Text) (io.IO Any)) - (..actual_program )) - inputs)) - {try.#Success _} - false - - {try.#Failure _} - true)))))))) + (all _.and + (_.coverage [/.program:] + (let [(open "list#[0]") (list.equivalence text.equivalence)] + (and (with_expansions [ (/.program: all_arguments + (io.io all_arguments))] + (let [outcome ((is (-> (List Text) (io.IO Any)) + (..actual_program )) + inputs)] + (same? (is Any inputs) + (io.run! outcome)))) + (with_expansions [ (/.program: [arg/0 \\parser.any + arg/1 \\parser.any + arg/2 \\parser.any + arg/3 \\parser.any + arg/4 \\parser.any] + (io.io (list arg/4 arg/3 arg/2 arg/1 arg/0)))] + (let [outcome ((is (-> (List Text) (io.IO Any)) + (..actual_program )) + inputs)] + (list#= (list.reversed inputs) + (as (List Text) (io.run! outcome))))) + (with_expansions [ (/.program: [all_arguments (<>.many \\parser.any)] + (io.io all_arguments))] + (let [outcome ((is (-> (List Text) (io.IO Any)) + (..actual_program )) + inputs)] + (list#= inputs + (as (List Text) (io.run! outcome))))) + (with_expansions [ (/.program: [arg/0 \\parser.any + arg/1 \\parser.any + arg/2 \\parser.any + arg/3 \\parser.any] + (io.io []))] + (case (try ((is (-> (List Text) (io.IO Any)) + (..actual_program )) + inputs)) + {try.#Success _} + false + + {try.#Failure _} + true))))) + + ..\\parser + )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cli.lux b/stdlib/source/test/lux/tool/compiler/meta/cli.lux index fe630e128..dcf28757f 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cli.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cli.lux @@ -5,10 +5,9 @@ [abstract [monad (.only do)]] [control + ["<>" parser] ["[0]" pipe] - ["[0]" try (.use "[1]#[0]" functor)] - ["<>" parser (.only) - ["<[0]>" cli]]] + ["[0]" try (.use "[1]#[0]" functor)]] [data ["[0]" product] ["[0]" text] @@ -20,7 +19,9 @@ ["n" nat]]] [meta ["[0]" configuration (.use "[1]#[0]" equivalence) - ["$[1]" \\test]]]]] + ["$[1]" \\test]]] + ["[0]" program + ["<[1]>" \\parser]]]] [\\library ["[0]" / (.only) ["[1][0]" compiler (.only Compiler)]]] @@ -58,7 +59,7 @@ (~~ (with_template [ ] [(_.coverage [] (|> (list.partial "build" compilation') - (.result /.service) + (.result /.service) (try#each (|>> (pipe.case {/.#Compilation it} (|> it @@ -81,7 +82,7 @@ (_.coverage [/.Interpretation] (`` (and (~~ (with_template [ ] [(|> (list.partial "repl" compilation') - (.result /.service) + (.result /.service) (try#each (|>> (pipe.case {/.#Interpretation it} (|> it @@ -103,7 +104,7 @@ (_.coverage [/.Export] (`` (and (~~ (with_template [ ] [(|> (list.partial "export" export) - (.result /.service) + (.result /.service) (try#each (|>> (pipe.case {/.#Export it} (|> it -- cgit v1.2.3