aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/format/json.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/format/json.lux104
1 files changed, 55 insertions, 49 deletions
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 2e31a3924..865e92b8c 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -5,7 +5,7 @@
(lux (control functor
applicative
monad
- eq
+ [eq #+ Eq]
codec
["p" parser "p/" Monad<Parser>])
(data [bool]
@@ -387,11 +387,11 @@
_
(#R;Error (format "JSON value is not " <desc> ": " (show-json json)))))]
- [unit Unit #Null "unit" id]
+ [unit Unit #Null "unit" id]
[bool Bool #Boolean "bool" id]
[int Int #Number "int" real-to-int]
- [real Real #Number "real" id]
- [text Text #String "text" id]
+ [real Real #Number "real" id]
+ [text Text #String "text" id]
)
(do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>]
@@ -524,79 +524,85 @@
=b pb]
(wrap [=a =b])))
-(def: #export (alt pa pb json)
+(def: #export (alt pa pb)
{#;doc "Heterogeneous alternative combinator."}
(All [a b] (-> (Parser a) (Parser b) (Parser (| a b))))
- (case (pa json)
- (#R;Success a)
- (sum;right (sum;left a))
+ (function [json]
+ (case (pa json)
+ (#R;Success a)
+ (sum;right (sum;left a))
- (#R;Error message0)
- (case (pb json)
- (#R;Success b)
- (sum;right (sum;right b))
+ (#R;Error message0)
+ (case (pb json)
+ (#R;Success b)
+ (sum;right (sum;right b))
- (#R;Error message1)
- (#R;Error message0))))
+ (#R;Error message1)
+ (#R;Error message0)))))
-(def: #export (either pl pr json)
+(def: #export (either pl pr)
{#;doc "Homogeneous alternative combinator."}
(All [a] (-> (Parser a) (Parser a) (Parser a)))
- (case (pl json)
- (#R;Success x)
- (#R;Success x)
+ (function [json]
+ (case (pl json)
+ (#R;Success x)
+ (#R;Success x)
- _
- (pr json)))
+ _
+ (pr json))))
-(def: #export (opt p json)
+(def: #export (opt p)
{#;doc "Optionality combinator."}
(All [a]
(-> (Parser a) (Parser (Maybe a))))
- (case (p json)
- (#R;Error _) (#R;Success #;None)
- (#R;Success x) (#R;Success (#;Some x))))
+ (function [json]
+ (case (p json)
+ (#R;Error _) (#R;Success #;None)
+ (#R;Success x) (#R;Success (#;Some x)))))
(def: #export (run json parser)
(All [a] (-> JSON (Parser a) (R;Result a)))
(parser json))
-(def: #export (ensure test parser json)
+(def: #export (ensure test parser)
{#;doc "Only parses a JSON if it passes a test (which is also a parser)."}
(All [a] (-> (Parser Unit) (Parser a) (Parser a)))
- (case (test json)
- (#R;Success _)
- (parser json)
+ (function [json]
+ (case (test json)
+ (#R;Success _)
+ (parser json)
- (#R;Error error)
- (#R;Error error)))
+ (#R;Error error)
+ (#R;Error error))))
-(def: #export (array-size! size json)
+(def: #export (array-size! size)
{#;doc "Ensures a JSON array has the specified size."}
(-> Nat (Parser Unit))
- (case json
- (#Array parts)
- (if (n.= size (vector;size parts))
- (#R;Success [])
- (#R;Error (format "JSON array does no have size " (%n size) " " (show-json json))))
+ (function [json]
+ (case json
+ (#Array parts)
+ (if (n.= size (vector;size parts))
+ (#R;Success [])
+ (#R;Error (format "JSON array does no have size " (%n size) " " (show-json json))))
- _
- (#R;Error (format "JSON value is not an array: " (show-json json)))))
+ _
+ (#R;Error (format "JSON value is not an array: " (show-json json))))))
-(def: #export (object-fields! wanted-fields json)
+(def: #export (object-fields! wanted-fields)
{#;doc "Ensures that every field in the list of wanted-fields is present in a JSON object."}
(-> (List String) (Parser Unit))
- (case json
- (#Object kvs)
- (let [actual-fields (d;keys kvs)]
- (if (and (n.= (list;size wanted-fields) (list;size actual-fields))
- (list;every? (list;member? text;Eq<Text> wanted-fields)
- actual-fields))
- (#R;Success [])
- (#R;Error (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]"))))
+ (function [json]
+ (case json
+ (#Object kvs)
+ (let [actual-fields (d;keys kvs)]
+ (if (and (n.= (list;size wanted-fields) (list;size actual-fields))
+ (list;every? (list;member? text;Eq<Text> wanted-fields)
+ actual-fields))
+ (#R;Success [])
+ (#R;Error (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]"))))
- _
- (#R;Error (format "JSON value is not an object: " (show-json json)))))
+ _
+ (#R;Error (format "JSON value is not an object: " (show-json json))))))
## [Structures]
(struct: #export _ (Eq JSON)