aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/format/json/reader.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/data/format/json/reader.lux')
-rw-r--r--stdlib/source/lux/data/format/json/reader.lux177
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."))))