diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/control/parser/json.lux | 82 |
1 files changed, 43 insertions, 39 deletions
diff --git a/stdlib/source/lux/control/parser/json.lux b/stdlib/source/lux/control/parser/json.lux index ed1620627..48006855b 100644 --- a/stdlib/source/lux/control/parser/json.lux +++ b/stdlib/source/lux/control/parser/json.lux @@ -30,8 +30,8 @@ (exception: #export empty-input) -(def: #export (run json parser) - (All [a] (-> JSON (Parser a) (Try a))) +(def: #export (run parser json) + (All [a] (-> (Parser a) JSON (Try a))) (case (//.run parser (list json)) (#try.Success [remainder output]) (case remainder @@ -39,93 +39,97 @@ (#try.Success output) _ - (exception.throw unconsumed-input remainder)) + (exception.throw ..unconsumed-input remainder)) (#try.Failure error) (#try.Failure error))) -(def: #export (fail error) - (All [a] (-> Text (Parser a))) - (function (_ inputs) - (#try.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 []) + (exception.throw ..empty-input []) (#.Cons head tail) (#try.Success [tail head])))) +(exception: #export (unexpected-value {value JSON}) + (exception.report + ["Value" (/.format value)])) + (template [<name> <type> <tag> <desc>] [(def: #export <name> {#.doc (code.text ($_ text@compose "Reads a JSON value as " <desc> "."))} (Parser <type>) (do //.monad - [head any] + [head ..any] (case head (<tag> value) (wrap value) _ - (fail ($_ text@compose "JSON value is not " <desc> ".")))))] + (//.fail (exception.construct ..unexpected-value [head])))))] - [null Any #/.Null "null"] - [boolean Bit #/.Boolean "boolean"] - [number Frac #/.Number "number"] - [string Text #/.String "string"] + [null /.Null #/.Null "null"] + [boolean /.Boolean #/.Boolean "boolean"] + [number /.Number #/.Number "number"] + [string /.String #/.String "string"] ) -(template [<test> <check> <type> <eq> <encoder> <tag> <desc>] +(exception: #export [a] (value-mismatch {reference JSON} {sample JSON}) + (exception.report + ["Reference" (/.format reference)] + ["Sample" (/.format sample)])) + +(template [<test> <check> <type> <equivalence> <tag> <desc>] [(def: #export (<test> test) {#.doc (code.text ($_ text@compose "Asks whether a JSON value is a " <desc> "."))} (-> <type> (Parser Bit)) (do //.monad - [head any] + [head ..any] (case head (<tag> value) - (wrap (:: <eq> = test value)) + (wrap (:: <equivalence> = test value)) _ - (fail ($_ text@compose "JSON value is not " <desc> "."))))) + (//.fail (exception.construct ..unexpected-value [head]))))) (def: #export (<check> test) {#.doc (code.text ($_ text@compose "Ensures a JSON value is a " <desc> "."))} (-> <type> (Parser Any)) (do //.monad - [head any] + [head ..any] (case head (<tag> value) - (if (:: <eq> = test value) + (if (:: <equivalence> = test value) (wrap []) - (fail ($_ text@compose "Value mismatch: " (|> test <encoder>) " =/= " (|> value <encoder>)))) + (//.fail (exception.construct ..value-mismatch [(<tag> test) (<tag> value)]))) _ - (fail ($_ text@compose "JSON value is not a " <desc> ".")))))] + (//.fail (exception.construct ..unexpected-value [head])))))] - [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"] + [boolean? boolean! /.Boolean bit.equivalence #/.Boolean "boolean"] + [number? number! /.Number frac.equivalence #/.Number "number"] + [string? string! /.String text.equivalence #/.String "string"] ) (def: #export (nullable parser) (All [a] (-> (Parser a) (Parser (Maybe a)))) - (//.or null + (//.or ..null parser)) (def: #export (array parser) {#.doc "Parses a JSON array."} (All [a] (-> (Parser a) (Parser a))) (do //.monad - [head any] + [head ..any] (case head (#/.Array values) (case (//.run parser (row.to-list values)) (#try.Failure error) - (fail error) + (//.fail error) (#try.Success [remainder output]) (case remainder @@ -133,16 +137,16 @@ (wrap output) _ - (fail (exception.construct unconsumed-input remainder)))) + (//.fail (exception.construct ..unconsumed-input remainder)))) _ - (fail (text@compose "JSON value is not an array: " (/.format head)))))) + (//.fail (exception.construct ..unexpected-value [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] + [head ..any] (case head (#/.Object kvs) (case (|> kvs @@ -152,7 +156,7 @@ list.concat (//.run parser)) (#try.Failure error) - (fail error) + (//.fail error) (#try.Success [remainder output]) (case remainder @@ -160,10 +164,10 @@ (wrap output) _ - (fail (exception.construct unconsumed-input remainder)))) + (//.fail (exception.construct ..unconsumed-input remainder)))) _ - (fail (text@compose "JSON value is not an object: " (/.format head)))))) + (//.fail (exception.construct ..unexpected-value [head]))))) (def: #export (field field-name parser) {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."} @@ -177,7 +181,7 @@ (#try.Success [inputs' output]) (#try.Success [inputs'' _]) - (exception.throw unconsumed-input inputs'') + (exception.throw ..unconsumed-input inputs'') (#try.Failure error) (#try.Failure error)) @@ -187,15 +191,15 @@ output]))) #.Nil - (exception.throw empty-input []) + (exception.throw ..empty-input []) _ - (exception.throw unconsumed-input inputs)))) + (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 + ..object (//@map (dictionary.from-list text.hash)))) |