diff options
Diffstat (limited to 'stdlib/source/lux/data/format/json/reader.lux')
-rw-r--r-- | stdlib/source/lux/data/format/json/reader.lux | 177 |
1 files changed, 0 insertions, 177 deletions
diff --git a/stdlib/source/lux/data/format/json/reader.lux b/stdlib/source/lux/data/format/json/reader.lux deleted file mode 100644 index 1b26d746d..000000000 --- a/stdlib/source/lux/data/format/json/reader.lux +++ /dev/null @@ -1,177 +0,0 @@ -(;module: {#;doc "Functionality for reading values in the JSON format. - - For more information, please see: http://www.json.org/"} - lux - (lux (control [monad #+ do Monad] - [eq #+ Eq] - codec - ["p" parser "p/" Monad<Parser>]) - (data [bool] - [text "text/" Monoid<Text>] - [number "frac/" Codec<Text,Frac> "nat/" Codec<Text,Nat>] - ["R" result] - (coll [list] - [vector] - ["d" dict])) - ) - [.. #+ JSON Reader]) - -(def: unconsumed-input-error Text "Unconsumed JSON.") - -(def: #export (run json parser) - (All [a] (-> JSON (Reader a) (R;Result a))) - (case (p;run (list json) parser) - (#R;Success [remainder output]) - (case remainder - #;Nil - (#R;Success output) - - _ - (#R;Error unconsumed-input-error)) - - (#R;Error error) - (#R;Error error))) - -(def: #export (fail error) - (All [a] (-> Text (Reader a))) - (function [inputs] - (#R;Error error))) - -(def: #export any - {#;doc "Just returns the JSON input without applying any logic."} - (Reader JSON) - (<| (function [inputs]) - (case inputs - #;Nil - (#R;Error "Empty JSON stream.") - - (#;Cons head tail) - (#R;Success [tail head])))) - -(do-template [<name> <type> <tag> <desc>] - [(def: #export <name> - {#;doc (#;TextA ($_ text/append "Reads a JSON value as " <desc> "."))} - (Reader <type>) - (do p;Monad<Parser> - [head any] - (case head - (<tag> value) - (wrap value) - - _ - (fail ($_ text/append "JSON value is not " <desc> ".")))))] - - [null Unit #..;Null "null"] - [boolean Bool #..;Boolean "boolean"] - [number Frac #..;Number "number"] - [string Text #..;String "string"] - ) - -(do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>] - [(def: #export (<test> test) - {#;doc (#;TextA ($_ text/append "Asks whether a JSON value is a " <desc> "."))} - (-> <type> (Reader Bool)) - (do p;Monad<Parser> - [head any] - (case head - (<tag> value) - (wrap (:: <eq> = test (<pre> value))) - - _ - (fail ($_ text/append "JSON value is not " <desc> "."))))) - - (def: #export (<check> test) - {#;doc (#;TextA ($_ text/append "Ensures a JSON value is a " <desc> "."))} - (-> <type> (Reader Unit)) - (do p;Monad<Parser> - [head any] - (case head - (<tag> value) - (let [value (<pre> value)] - (if (:: <eq> = test value) - (wrap []) - (fail ($_ text/append "Value mismatch: " (<encoder> test) "=/=" (<encoder> value))))) - - _ - (fail ($_ text/append "JSON value is not a " <desc> ".")))))] - - [boolean? boolean! Bool bool;Eq<Bool> (:: bool;Codec<Text,Bool> encode) #..;Boolean "boolean" id] - [number? number! Frac number;Eq<Frac> (:: number;Codec<Text,Frac> encode) #..;Number "number" id] - [string? string! Text text;Eq<Text> text;encode #..;String "string" id] - ) - -(def: #export (nullable parser) - (All [a] (-> (Reader a) (Reader (Maybe a)))) - (p;alt null - parser)) - -(def: #export (array parser) - {#;doc "Parses a JSON array, assuming that every element can be parsed the same way."} - (All [a] (-> (Reader a) (Reader a))) - (do p;Monad<Parser> - [head any] - (case head - (#..;Array values) - (case (p;run (vector;to-list values) parser) - (#R;Error error) - (fail error) - - (#R;Success [remainder output]) - (case remainder - #;Nil - (wrap output) - - _ - (fail unconsumed-input-error))) - - _ - (fail "JSON value is not an array.")))) - -(def: #export (object parser) - {#;doc "Parses a JSON object, assuming that every element can be parsed the same way."} - (All [a] (-> (Reader a) (Reader (d;Dict Text a)))) - (do p;Monad<Parser> - [head any] - (case head - (#..;Object object) - (case (do R;Monad<Result> - [] - (|> (d;entries object) - (monad;map @ (function [[key val]] - (do @ - [val (run val parser)] - (wrap [key val])))) - (:: @ map (d;from-list text;Hash<Text>)))) - (#R;Success table) - (wrap table) - - (#R;Error error) - (fail error)) - - _ - (fail "JSON value is not an array.")))) - -(def: #export (field field-name parser) - {#;doc "Parses a field inside a JSON object."} - (All [a] (-> Text (Reader a) (Reader a))) - (do p;Monad<Parser> - [head any] - (case head - (#..;Object object) - (case (d;get field-name object) - (#;Some value) - (case (run value parser) - (#R;Success output) - (function [tail] - (#R;Success [(#;Cons (#..;Object (d;remove field-name object)) - tail) - output])) - - (#R;Error error) - (fail error)) - - _ - (fail ($_ text/append "JSON object does not have field \"" field-name "\"."))) - - _ - (fail "JSON value is not an object.")))) |