From a4f162c79c70e57c856a0f924d3cbb27ab70babb Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 19 Apr 2019 19:54:42 -0400 Subject: Moved the JSON parser under "lux/control/parser/". --- stdlib/source/lux/control/parser/json.lux | 201 ++++++++++++++++++++++ stdlib/source/lux/data/format/json.lux | 242 +++------------------------ stdlib/source/lux/macro/poly/json.lux | 45 ++--- stdlib/source/lux/world/net/http/request.lux | 6 +- stdlib/source/test/lux/macro/poly/json.lux | 6 +- 5 files changed, 256 insertions(+), 244 deletions(-) create mode 100644 stdlib/source/lux/control/parser/json.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux/control/parser/json.lux b/stdlib/source/lux/control/parser/json.lux new file mode 100644 index 000000000..cf3d308db --- /dev/null +++ b/stdlib/source/lux/control/parser/json.lux @@ -0,0 +1,201 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." exception (#+ exception:)]] + [data + ["." bit] + ["." error (#+ Error)] + ["." text ("#@." equivalence monoid)] + [number + ["." frac]] + [collection + ["." list ("#@." functor)] + ["." row] + ["." dictionary (#+ Dictionary)]] + [format + ["/" json (#+ JSON)]]] + [macro + ["." code]]] + ["." // ("#@." functor)]) + +(type: #export (Parser a) + {#.doc "JSON parser."} + (//.Parser (List JSON) a)) + +(exception: #export (unconsumed-input {input (List JSON)}) + (exception.report + ["Input" (exception.enumerate /.format input)])) + +(exception: #export empty-input) + +(def: #export (run json parser) + (All [a] (-> JSON (Parser a) (Error a))) + (case (//.run (list json) parser) + (#error.Success [remainder output]) + (case remainder + #.Nil + (#error.Success output) + + _ + (exception.throw unconsumed-input remainder)) + + (#error.Failure error) + (#error.Failure error))) + +(def: #export (fail error) + (All [a] (-> Text (Parser a))) + (function (_ inputs) + (#error.Failure error))) + +(def: #export any + {#.doc "Just returns the JSON input without applying any logic."} + (Parser JSON) + (<| (function (_ inputs)) + (case inputs + #.Nil + (exception.throw empty-input []) + + (#.Cons head tail) + (#error.Success [tail head])))) + +(template [ ] + [(def: #export + {#.doc (code.text ($_ text@compose "Reads a JSON value as " "."))} + (Parser ) + (do //.monad + [head any] + (case head + ( value) + (wrap value) + + _ + (fail ($_ text@compose "JSON value is not " ".")))))] + + [null Any #/.Null "null"] + [boolean Bit #/.Boolean "boolean"] + [number Frac #/.Number "number"] + [string Text #/.String "string"] + ) + +(template [ ] + [(def: #export ( test) + {#.doc (code.text ($_ text@compose "Asks whether a JSON value is a " "."))} + (-> (Parser Bit)) + (do //.monad + [head any] + (case head + ( value) + (wrap (:: = test value)) + + _ + (fail ($_ text@compose "JSON value is not " "."))))) + + (def: #export ( test) + {#.doc (code.text ($_ text@compose "Ensures a JSON value is a " "."))} + (-> (Parser Any)) + (do //.monad + [head any] + (case head + ( value) + (if (:: = test value) + (wrap []) + (fail ($_ text@compose "Value mismatch: " (|> test ) " =/= " (|> value )))) + + _ + (fail ($_ text@compose "JSON value is not a " ".")))))] + + [boolean? boolean! Bit bit.equivalence (<| /.format #/.Boolean) #/.Boolean "boolean"] + [number? number! Frac frac.equivalence (:: frac.decimal encode) #/.Number "number"] + [string? string! Text text.equivalence text.encode #/.String "string"] + ) + +(def: #export (nullable parser) + (All [a] (-> (Parser a) (Parser (Maybe a)))) + (//.or null + parser)) + +(def: #export (array parser) + {#.doc "Parses a JSON array."} + (All [a] (-> (Parser a) (Parser a))) + (do //.monad + [head any] + (case head + (#/.Array values) + (case (//.run (row.to-list values) parser) + (#error.Failure error) + (fail error) + + (#error.Success [remainder output]) + (case remainder + #.Nil + (wrap output) + + _ + (fail (exception.construct unconsumed-input remainder)))) + + _ + (fail (text@compose "JSON value is not an array: " (/.format head)))))) + +(def: #export (object parser) + {#.doc "Parses a JSON object. Use this with the 'field' combinator."} + (All [a] (-> (Parser a) (Parser a))) + (do //.monad + [head any] + (case head + (#/.Object kvs) + (case (//.run (|> kvs + dictionary.entries + (list@map (function (_ [key value]) + (list (#/.String key) value))) + list.concat) + parser) + (#error.Failure error) + (fail error) + + (#error.Success [remainder output]) + (case remainder + #.Nil + (wrap output) + + _ + (fail (exception.construct unconsumed-input remainder)))) + + _ + (fail (text@compose "JSON value is not an object: " (/.format head)))))) + +(def: #export (field field-name parser) + {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."} + (All [a] (-> Text (Parser a) (Parser a))) + (function (recur inputs) + (case inputs + (^ (list& (#/.String key) value inputs')) + (if (text@= key field-name) + (case (//.run (list value) parser) + (#error.Success [#.Nil output]) + (#error.Success [inputs' output]) + + (#error.Success [inputs'' _]) + (exception.throw unconsumed-input inputs'') + + (#error.Failure error) + (#error.Failure error)) + (do error.monad + [[inputs'' output] (recur inputs')] + (wrap [(list& (#/.String key) value inputs'') + output]))) + + #.Nil + (exception.throw empty-input []) + + _ + (exception.throw unconsumed-input inputs)))) + +(def: #export dictionary + {#.doc "Parses a dictionary-like JSON object."} + (All [a] (-> (Parser a) (Parser (Dictionary Text a)))) + (|>> (//.and ..string) + //.some + object + (//@map (dictionary.from-list text.hash)))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 162cf8387..417db04b6 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -2,25 +2,23 @@ "For more information, please see: http://www.json.org/")} [lux #* [abstract - ["." monad (#+ Monad do)] + ["." monad (#+ do)] [equivalence (#+ Equivalence)] codec] [control pipe ["p" parser ("#@." monad) - ["l" text (#+ Parser)]] - ["ex" exception (#+ exception:)]] + ["l" text (#+ Parser)]]] [data ["." bit] ["." maybe] ["." error (#+ Error)] - ["." sum] ["." product] [number ["." frac ("#@." decimal)]] ["." text ("#@." equivalence monoid)] [collection - ["." list ("#@." fold monad)] + ["." list ("#@." fold functor)] ["." row (#+ Row row) ("#@." monad)] ["." dictionary (#+ Dictionary)]]] ["." macro (#+ monad with-gensyms) @@ -51,10 +49,6 @@ [Object (Dictionary String JSON)] ) -(type: #export (Reader a) - {#.doc "JSON reader."} - (p.Parser (List JSON) a)) - (syntax: #export (json token) {#.doc (doc "A simple way to produce JSON literals." (json #1) @@ -194,14 +188,16 @@ ############################################################ ############################################################ -(def: encode-boolean - (-> Bit Text) +(def: (format-null _) (-> Null Text) "null") + +(def: format-boolean + (-> Boolean Text) (|>> (case> #0 "false" #1 "true"))) -(def: encode-number - (-> Frac Text) +(def: format-number + (-> Number Text) (|>> (case> +0.0 "0.0" -0.0 "0.0" @@ -210,231 +206,41 @@ raw (|> raw (text.split 1) maybe.assume product.right)))))) -(def: (show-null _) (-> Null Text) "null") - -(template [ ] - [(def: (-> Text) )] - - [show-boolean Boolean ..encode-boolean] - [show-number Number ..encode-number] - [show-string String text.encode] - ) +(def: format-string (-> String Text) text.encode) -(def: (show-array show-json elems) +(def: (format-array format elems) (-> (-> JSON Text) (-> Array Text)) ($_ text@compose "[" - (|> elems (row@map show-json) row.to-list (text.join-with ",")) + (|> elems (row@map format) row.to-list (text.join-with ",")) "]")) -(def: (show-object show-json object) +(def: (format-object format object) (-> (-> JSON Text) (-> Object Text)) ($_ text@compose "{" (|> object dictionary.entries - (list@map (function (_ [key value]) ($_ text@compose (show-string key) ":" (show-json value)))) + (list@map (function (_ [key value]) ($_ text@compose (format-string key) ":" (format value)))) (text.join-with ",")) "}")) -(def: (show-json json) +(def: #export (format json) (-> JSON Text) (case json - (^template [ ] + (^template [ ] ( value) - ( value)) - ([#Null show-null] - [#Boolean show-boolean] - [#Number show-number] - [#String show-string] - [#Array (show-array show-json)] - [#Object (show-object show-json)]) + ( value)) + ([#Null format-null] + [#Boolean format-boolean] + [#Number format-number] + [#String format-string] + [#Array (format-array format)] + [#Object (format-object format)]) )) ############################################################ ############################################################ ############################################################ -(exception: #export (unconsumed-input {input (List JSON)}) - (|> input - (list@map show-json) - (text.join-with text.new-line))) - -(exception: #export (empty-input) - "") - -(def: #export (run json parser) - (All [a] (-> JSON (Reader a) (Error a))) - (case (p.run (list json) parser) - (#error.Success [remainder output]) - (case remainder - #.Nil - (#error.Success output) - - _ - (ex.throw unconsumed-input remainder)) - - (#error.Failure error) - (#error.Failure error))) - -(def: #export (fail error) - (All [a] (-> Text (Reader a))) - (function (_ inputs) - (#error.Failure error))) - -(def: #export any - {#.doc "Just returns the JSON input without applying any logic."} - (Reader JSON) - (<| (function (_ inputs)) - (case inputs - #.Nil - (ex.throw empty-input []) - - (#.Cons head tail) - (#error.Success [tail head])))) - -(template [ ] - [(def: #export - {#.doc (code.text ($_ text@compose "Reads a JSON value as " "."))} - (Reader ) - (do p.monad - [head any] - (case head - ( value) - (wrap value) - - _ - (fail ($_ text@compose "JSON value is not " ".")))))] - - [null Any #Null "null"] - [boolean Bit #Boolean "boolean"] - [number Frac #Number "number"] - [string Text #String "string"] - ) - -(template [ ] - [(def: #export ( test) - {#.doc (code.text ($_ text@compose "Asks whether a JSON value is a " "."))} - (-> (Reader Bit)) - (do p.monad - [head any] - (case head - ( value) - (wrap (:: = test value)) - - _ - (fail ($_ text@compose "JSON value is not " "."))))) - - (def: #export ( test) - {#.doc (code.text ($_ text@compose "Ensures a JSON value is a " "."))} - (-> (Reader Any)) - (do p.monad - [head any] - (case head - ( value) - (if (:: = test value) - (wrap []) - (fail ($_ text@compose "Value mismatch: " ( test) " =/= " ( value)))) - - _ - (fail ($_ text@compose "JSON value is not a " ".")))))] - - [boolean? boolean! Bit bit.equivalence encode-boolean #Boolean "boolean"] - [number? number! Frac frac.equivalence (:: frac.decimal encode) #Number "number"] - [string? string! Text text.equivalence text.encode #String "string"] - ) - -(def: #export (nullable parser) - (All [a] (-> (Reader a) (Reader (Maybe a)))) - (p.or null - parser)) - -(def: #export (array parser) - {#.doc "Parses a JSON array."} - (All [a] (-> (Reader a) (Reader a))) - (do p.monad - [head any] - (case head - (#Array values) - (case (p.run (row.to-list values) parser) - (#error.Failure error) - (fail error) - - (#error.Success [remainder output]) - (case remainder - #.Nil - (wrap output) - - _ - (fail (ex.construct unconsumed-input remainder)))) - - _ - (fail (text@compose "JSON value is not an array: " (show-json head)))))) - -(def: #export (object parser) - {#.doc "Parses a JSON object. Use this with the 'field' combinator."} - (All [a] (-> (Reader a) (Reader a))) - (do p.monad - [head any] - (case head - (#Object kvs) - (case (p.run (|> kvs - dictionary.entries - (list@map (function (_ [key value]) - (list (#String key) value))) - list.concat) - parser) - (#error.Failure error) - (fail error) - - (#error.Success [remainder output]) - (case remainder - #.Nil - (wrap output) - - _ - (fail (ex.construct unconsumed-input remainder)))) - - _ - (fail (text@compose "JSON value is not an object: " (show-json head)))))) - -(def: #export (field field-name parser) - {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."} - (All [a] (-> Text (Reader a) (Reader a))) - (function (recur inputs) - (case inputs - (^ (list& (#String key) value inputs')) - (if (text@= key field-name) - (case (p.run (list value) parser) - (#error.Success [#.Nil output]) - (#error.Success [inputs' output]) - - (#error.Success [inputs'' _]) - (ex.throw unconsumed-input inputs'') - - (#error.Failure error) - (#error.Failure error)) - (do error.monad - [[inputs'' output] (recur inputs')] - (wrap [(list& (#String key) value inputs'') - output]))) - - #.Nil - (ex.throw empty-input []) - - _ - (ex.throw unconsumed-input inputs)))) - -(def: #export dictionary - {#.doc "Parses a dictionary-like JSON object."} - (All [a] (-> (Reader a) (Reader (Dictionary Text a)))) - (|>> (p.and ..string) - p.some - object - (p@map (dictionary.from-list text.hash)))) - -############################################################ -############################################################ -############################################################ - (def: space~ (Parser Text) (l.some l.space)) @@ -548,5 +354,5 @@ ($_ p.or null~ boolean~ number~ string~ (array~ json~') (object~ json~'))) (structure: #export codec (Codec Text JSON) - (def: encode show-json) + (def: encode ..format) (def: decode (function (_ input) (l.run input (json~' []))))) diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 1253ec328..f30c26437 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -7,6 +7,7 @@ [control ["p" parser ["<.>" type] + ["" json] ["l" text]]] [data ["." bit] @@ -60,11 +61,11 @@ (#/.Array (row (|> high .int int-to-frac #/.Number) (|> low .int int-to-frac #/.Number))))) (def: (decode input) - (<| (/.run input) - /.array + (<| (.run input) + .array (do p.monad - [high /.number - low /.number]) + [high .number + low .number]) (wrap (n/+ (|> high frac-to-int .nat (i64.left-shift 32)) (|> low frac-to-int .nat)))))) @@ -214,17 +215,17 @@ (wrap (` (: (~ (@JSON//decode inputT)) (~! )))))] - [(.exactly Any) /.null] - [(.sub Bit) /.boolean] - [(.sub Nat) (p.codec ..nat-codec /.any)] - [(.sub Int) (p.codec ..int-codec /.any)] - [(.sub Frac) /.number] - [(.sub Text) /.string]) + [(.exactly Any) .null] + [(.sub Bit) .boolean] + [(.sub Nat) (p.codec ..nat-codec .any)] + [(.sub Int) (p.codec ..int-codec .any)] + [(.sub Frac) .number] + [(.sub Text) .string])