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/parser/lux/data/format/json.lux | 199 ++++++++++++++++++++++++++ stdlib/source/parser/lux/data/format/xml.lux | 145 +++++++++++++++++++ 2 files changed, 344 insertions(+) create mode 100644 stdlib/source/parser/lux/data/format/json.lux create mode 100644 stdlib/source/parser/lux/data/format/xml.lux (limited to 'stdlib/source/parser') diff --git a/stdlib/source/parser/lux/data/format/json.lux b/stdlib/source/parser/lux/data/format/json.lux new file mode 100644 index 000000000..2f54560e9 --- /dev/null +++ b/stdlib/source/parser/lux/data/format/json.lux @@ -0,0 +1,199 @@ +(.using + [library + [lux (.except symbol) + [abstract + ["[0]" monad (.only do)]] + [control + ["//" parser (.open: "[1]#[0]" functor)] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception:)]] + [data + ["[0]" bit] + ["[0]" text (.open: "[1]#[0]" equivalence monoid)] + [collection + ["[0]" list (.open: "[1]#[0]" functor)] + ["[0]" sequence] + ["[0]" dictionary (.only Dictionary)]]] + [macro + ["[0]" code]] + [math + [number + ["[0]" frac]]]]] + [\\library + ["[0]" / (.only JSON)]]) + +(type: .public (Parser a) + (//.Parser (List JSON) a)) + +(exception: .public (unconsumed_input [input (List JSON)]) + (exception.report + "Input" (exception.listing /.format input))) + +(exception: .public empty_input) + +(def .public (result parser json) + (All (_ a) (-> (Parser a) JSON (Try a))) + (case (//.result parser (list json)) + {try.#Success [remainder output]} + (case remainder + {.#End} + {try.#Success output} + + _ + (exception.except ..unconsumed_input remainder)) + + {try.#Failure error} + {try.#Failure error})) + +(def .public any + (Parser JSON) + (<| (function (_ inputs)) + (case inputs + {.#End} + (exception.except ..empty_input []) + + {.#Item head tail} + {try.#Success [tail head]}))) + +(exception: .public (unexpected_value [value JSON]) + (exception.report + "Value" (/.format value))) + +(with_template [ ] + [(def .public + (Parser ) + (do //.monad + [head ..any] + (case head + { value} + (in value) + + _ + (//.failure (exception.error ..unexpected_value [head])))))] + + [null /.Null /.#Null] + [boolean /.Boolean /.#Boolean] + [number /.Number /.#Number] + [string /.String /.#String] + ) + +(exception: .public [a] (value_mismatch [reference JSON + sample JSON]) + (exception.report + "Reference" (/.format reference) + "Sample" (/.format sample))) + +(with_template [ ] + [(def .public ( test) + (-> (Parser Bit)) + (do //.monad + [head ..any] + (case head + { value} + (in (at = test value)) + + _ + (//.failure (exception.error ..unexpected_value [head]))))) + + (def .public ( test) + (-> (Parser Any)) + (do //.monad + [head ..any] + (case head + { value} + (if (at = test value) + (in []) + (//.failure (exception.error ..value_mismatch [{ test} { value}]))) + + _ + (//.failure (exception.error ..unexpected_value [head])))))] + + [boolean? this_boolean /.Boolean bit.equivalence /.#Boolean] + [number? this_number /.Number frac.equivalence /.#Number] + [string? this_string /.String text.equivalence /.#String] + ) + +(def .public (nullable parser) + (All (_ a) (-> (Parser a) (Parser (Maybe a)))) + (//.or ..null + parser)) + +(def .public (array parser) + (All (_ a) (-> (Parser a) (Parser a))) + (do //.monad + [head ..any] + (case head + {/.#Array values} + (case (//.result parser (sequence.list values)) + {try.#Failure error} + (//.failure error) + + {try.#Success [remainder output]} + (case remainder + {.#End} + (in output) + + _ + (//.failure (exception.error ..unconsumed_input remainder)))) + + _ + (//.failure (exception.error ..unexpected_value [head]))))) + +(def .public (object parser) + (All (_ a) (-> (Parser a) (Parser a))) + (do //.monad + [head ..any] + (case head + {/.#Object kvs} + (case (|> kvs + dictionary.entries + (list#each (function (_ [key value]) + (list {/.#String key} value))) + list.together + (//.result parser)) + {try.#Failure error} + (//.failure error) + + {try.#Success [remainder output]} + (case remainder + {.#End} + (in output) + + _ + (//.failure (exception.error ..unconsumed_input remainder)))) + + _ + (//.failure (exception.error ..unexpected_value [head]))))) + +(def .public (field field_name parser) + (All (_ a) (-> Text (Parser a) (Parser a))) + (function (again inputs) + (case inputs + (pattern (list.partial {/.#String key} value inputs')) + (if (text#= key field_name) + (case (//.result parser (list value)) + {try.#Success [{.#End} output]} + {try.#Success [inputs' output]} + + {try.#Success [inputs'' _]} + (exception.except ..unconsumed_input inputs'') + + {try.#Failure error} + {try.#Failure error}) + (do try.monad + [[inputs'' output] (again inputs')] + (in [(list.partial {/.#String key} value inputs'') + output]))) + + {.#End} + (exception.except ..empty_input []) + + _ + (exception.except ..unconsumed_input inputs)))) + +(def .public dictionary + (All (_ a) (-> (Parser a) (Parser (Dictionary Text a)))) + (|>> (//.and ..string) + //.some + ..object + (//#each (dictionary.of_list text.hash)))) diff --git a/stdlib/source/parser/lux/data/format/xml.lux b/stdlib/source/parser/lux/data/format/xml.lux new file mode 100644 index 000000000..6b2ddf79c --- /dev/null +++ b/stdlib/source/parser/lux/data/format/xml.lux @@ -0,0 +1,145 @@ +(.using + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["//" parser] + ["[0]" try (.only Try) (.open: "[1]#[0]" functor)] + ["[0]" exception (.only exception:)]] + [data + ["[0]" text + ["%" \\format (.only format)]] + [collection + ["[0]" list] + ["[0]" dictionary]]] + [meta + ["[0]" symbol (.open: "[1]#[0]" equivalence codec)]]]] + [\\library + ["[0]" / (.only Attribute Attrs Tag XML)]]) + +(type: .public (Parser a) + (//.Parser [Attrs (List XML)] a)) + +(exception: .public empty_input) +(exception: .public unexpected_input) + +(exception: .public (wrong_tag [expected Tag + actual Tag]) + (exception.report + "Expected" (%.text (/.tag expected)) + "Actual" (%.text (/.tag actual)))) + +(exception: .public (unknown_attribute [expected Attribute + available (List Attribute)]) + (exception.report + "Expected" (%.text (/.attribute expected)) + "Available" (exception.listing (|>> /.attribute %.text) available))) + +(exception: .public (unconsumed_inputs [inputs (List XML)]) + (exception.report + "Inputs" (exception.listing (at /.codec encoded) inputs))) + +(def (result' parser attrs documents) + (All (_ a) (-> (Parser a) Attrs (List XML) (Try a))) + (case (//.result parser [attrs documents]) + {try.#Success [[attrs' remaining] output]} + (if (list.empty? remaining) + {try.#Success output} + (exception.except ..unconsumed_inputs remaining)) + + {try.#Failure error} + {try.#Failure error})) + +(def .public (result parser documents) + (All (_ a) (-> (Parser a) (List XML) (Try a))) + (..result' parser /.attributes documents)) + +(def .public text + (Parser Text) + (function (_ [attrs documents]) + (case documents + {.#End} + (exception.except ..empty_input []) + + {.#Item head tail} + (case head + {/.#Text value} + {try.#Success [[attrs tail] value]} + + {/.#Node _} + (exception.except ..unexpected_input []))))) + +(def .public tag + (Parser Tag) + (function (_ [attrs documents]) + (case documents + {.#End} + (exception.except ..empty_input []) + + {.#Item head _} + (case head + {/.#Text _} + (exception.except ..unexpected_input []) + + {/.#Node tag _ _} + {try.#Success [[attrs documents] tag]})))) + +(def .public (attribute name) + (-> Attribute (Parser Text)) + (function (_ [attrs documents]) + (case (dictionary.value name attrs) + {.#None} + (exception.except ..unknown_attribute [name (dictionary.keys attrs)]) + + {.#Some value} + {try.#Success [[attrs documents] value]}))) + +(def .public (node expected parser) + (All (_ a) (-> Tag (Parser a) (Parser a))) + (function (_ [attrs documents]) + (case documents + {.#End} + (exception.except ..empty_input []) + + {.#Item head tail} + (case head + {/.#Text _} + (exception.except ..unexpected_input []) + + {/.#Node actual attrs' children} + (if (symbol#= expected actual) + (|> children + (..result' parser attrs') + (try#each (|>> [[attrs tail]]))) + (exception.except ..wrong_tag [expected actual])))))) + +(def .public any + (Parser XML) + (function (_ [attrs documents]) + (case documents + {.#End} + (exception.except ..empty_input []) + + {.#Item head tail} + {try.#Success [[attrs tail] head]}))) + +(exception: .public nowhere) + +(def .public (somewhere parser) + (All (_ a) (-> (Parser a) (Parser a))) + (function (again [attrs input]) + (case (//.result parser [attrs input]) + {try.#Success [[attrs remaining] output]} + {try.#Success [[attrs remaining] output]} + + {try.#Failure error} + (case input + {.#End} + (exception.except ..nowhere []) + + {.#Item head tail} + (do try.monad + [[[attrs tail'] output] (again [attrs tail])] + (in [[attrs {.#Item head tail'}] + output])))))) -- cgit v1.2.3