aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/data/format/json.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/data/format/json.lux')
-rw-r--r--stdlib/source/lux/data/format/json.lux87
1 files changed, 43 insertions, 44 deletions
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 6d7ed16a7..c4951f188 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -9,10 +9,9 @@
codec
["p" parser "p/" Monad<Parser>])
(data [bool]
- [text "Text/" Eq<Text> Monoid<Text>]
- text/format
+ [text "text/" Eq<Text> Monoid<Text>]
(text ["l" lexer])
- [number "Real/" Codec<Text,Real>]
+ [number "real/" Codec<Text,Real> "nat/" Codec<Text,Nat>]
maybe
["R" result]
[sum]
@@ -116,18 +115,18 @@
(def: (show-array show-json elems)
(-> (-> JSON Text) (-> Array Text))
- (format "["
- (|> elems (Vector/map show-json) vector;to-list (text;join-with ","))
- "]"))
+ ($_ text/append "["
+ (|> elems (Vector/map show-json) vector;to-list (text;join-with ","))
+ "]"))
(def: (show-object show-json object)
(-> (-> JSON Text) (-> Object Text))
- (format "{"
- (|> object
- d;entries
- (L/map (function [[key value]] (format (show-string key) ":" (show-json value))))
- (text;join-with ","))
- "}"))
+ ($_ text/append "{"
+ (|> object
+ d;entries
+ (L/map (function [[key value]] ($_ text/append (show-string key) ":" (show-json value))))
+ (text;join-with ","))
+ "}"))
(def: (show-json json)
(-> JSON Text)
@@ -156,7 +155,7 @@
(#R;Success (d;keys obj))
_
- (#R;Error (format "Cannot get the fields of a non-object."))))
+ (#R;Error ($_ text/append "Cannot get the fields of a non-object."))))
(def: #export (get key json)
{#;doc "A JSON object field getter."}
@@ -168,10 +167,10 @@
(#R;Success value)
#;None
- (#R;Error (format "Missing field " (show-string key) " on object.")))
+ (#R;Error ($_ text/append "Missing field " (show-string key) " on object.")))
_
- (#R;Error (format "Cannot get field " (show-string key) " of a non-object."))))
+ (#R;Error ($_ text/append "Cannot get field " (show-string key) " of a non-object."))))
(def: #export (set key value json)
{#;doc "A JSON object field setter."}
@@ -181,18 +180,18 @@
(#R;Success (#Object (d;put key value obj)))
_
- (#R;Error (format "Cannot set field " (show-string key) " of a non-object."))))
+ (#R;Error ($_ text/append "Cannot set field " (show-string key) " of a non-object."))))
(do-template [<name> <tag> <type> <desc>]
[(def: #export (<name> key json)
- {#;doc (#;TextA (format "A JSON object field getter for " <desc> "."))}
+ {#;doc (#;TextA ($_ text/append "A JSON object field getter for " <desc> "."))}
(-> Text JSON (R;Result <type>))
(case (get key json)
(#R;Success (<tag> value))
(#R;Success value)
(#R;Success _)
- (#R;Error (format "Wrong value type at key " (show-string key)))
+ (#R;Error ($_ text/append "Wrong value type at key " (show-string key)))
(#R;Error error)
(#R;Error error)))]
@@ -206,7 +205,7 @@
(do-template [<name> <type> <tag> <desc>]
[(def: #export (<name> value)
- {#;doc (#;TextA (format "A JSON generator for " <desc> "."))}
+ {#;doc (#;TextA ($_ text/append "A JSON generator for " <desc> "."))}
(Gen <type>)
(<tag> value))]
@@ -269,8 +268,8 @@
[mark (l;one-of "eE")
signed?' (l;this? "-")
offset (l;many l;decimal)]
- (wrap (format mark (if signed?' "-" "") offset))))]
- (case (Real/decode (format (if signed? "-" "") digits "." decimals exp))
+ (wrap ($_ text/append mark (if signed?' "-" "") offset))))]
+ (case (real/decode ($_ text/append (if signed? "-" "") digits "." decimals exp))
(#R;Error message)
(p;fail message)
@@ -295,11 +294,11 @@
(do p;Monad<Parser>
[chars (l;some (l;none-of "\\\""))
stop l;peek]
- (if (Text/= "\\" stop)
+ (if (text/= "\\" stop)
(do @
[escaped escaped~
next-chars (recur [])]
- (wrap (format chars escaped next-chars)))
+ (wrap ($_ text/append chars escaped next-chars)))
(wrap chars))))))
(def: (kv~ json~)
@@ -378,14 +377,14 @@
## Syntax
(do-template [<name> <type> <tag> <desc> <pre>]
[(def: #export (<name> json)
- {#;doc (#;TextA (format "Reads a JSON value as " <desc> "."))}
+ {#;doc (#;TextA ($_ text/append "Reads a JSON value as " <desc> "."))}
(Parser <type>)
(case json
(<tag> value)
(#R;Success (<pre> value))
_
- (#R;Error (format "JSON value is not " <desc> ": " (show-json json)))))]
+ (#R;Error ($_ text/append "JSON value is not " <desc> ": " (show-json json)))))]
[unit Unit #Null "unit" id]
[bool Bool #Boolean "bool" id]
@@ -396,28 +395,28 @@
(do-template [<test> <check> <type> <eq> <encoder> <tag> <desc> <pre>]
[(def: #export (<test> test json)
- {#;doc (#;TextA (format "Asks whether a JSON value is a " <desc> "."))}
+ {#;doc (#;TextA ($_ text/append "Asks whether a JSON value is a " <desc> "."))}
(-> <type> (Parser Bool))
(case json
(<tag> value)
(#R;Success (:: <eq> = test (<pre> value)))
_
- (#R;Error (format "JSON value is not a " <desc> ": " (show-json json)))))
+ (#R;Error ($_ text/append "JSON value is not a " <desc> ": " (show-json json)))))
(def: #export (<check> test json)
- {#;doc (#;TextA (format "Ensures a JSON value is a " <desc> "."))}
+ {#;doc (#;TextA ($_ text/append "Ensures a JSON value is a " <desc> "."))}
(-> <type> (Parser Unit))
(case json
(<tag> value)
(let [value (<pre> value)]
(if (:: <eq> = test value)
(#R;Success [])
- (#R;Error (format "Value mismatch: "
- (<encoder> test) "=/=" (<encoder> value)))))
+ (#R;Error ($_ text/append "Value mismatch: "
+ (<encoder> test) "=/=" (<encoder> value)))))
_
- (#R;Error (format "JSON value is not a " <desc> ": " (show-json json)))))]
+ (#R;Error ($_ text/append "JSON value is not a " <desc> ": " (show-json json)))))]
[bool? bool! Bool bool;Eq<Bool> (:: bool;Codec<Text,Bool> encode) #Boolean "boolean" id]
[int? int! Int number;Eq<Int> (:: number;Codec<Text,Int> encode) #Number "number" real-to-int]
@@ -453,7 +452,7 @@
(wrap elems))
_
- (#R;Error (format "JSON value is not an array: " (show-json json))))))
+ (#R;Error ($_ text/append "JSON value is not an array: " (show-json json))))))
(def: #export (object parser)
{#;doc "Parses a JSON object, assuming that every field's value can be parsed the same way."}
@@ -471,7 +470,7 @@
(wrap (d;from-list text;Hash<Text> kvs)))
_
- (#R;Error (format "JSON value is not an object: " (show-json json))))))
+ (#R;Error ($_ text/append "JSON value is not an object: " (show-json json))))))
(def: #export (nth idx parser)
{#;doc "Parses an element inside a JSON array."}
@@ -486,13 +485,13 @@
(#R;Success output)
(#R;Error error)
- (#R;Error (format "JSON array index [" (%n idx) "]: (" error ") @ " (show-json json))))
+ (#R;Error ($_ text/append "JSON array index [" (nat/encode idx) "]: (" error ") @ " (show-json json))))
#;None
- (#R;Error (format "JSON array does not have index " (%n idx) " @ " (show-json json))))
+ (#R;Error ($_ text/append "JSON array does not have index " (nat/encode idx) " @ " (show-json json))))
_
- (#R;Error (format "JSON value is not an array: " (show-json json))))))
+ (#R;Error ($_ text/append "JSON value is not an array: " (show-json json))))))
(def: #export (field field-name parser)
{#;doc "Parses a field inside a JSON object."}
@@ -505,10 +504,10 @@
(#R;Success output)
(#R;Error error)
- (#R;Error (format "Failed to get JSON object field " (show-string field-name) ": (" error ") @ " (show-json json))))
+ (#R;Error ($_ text/append "Failed to get JSON object field " (show-string field-name) ": (" error ") @ " (show-json json))))
(#R;Error _)
- (#R;Error (format "JSON object does not have field " (show-string field-name) " @ " (show-json json))))))
+ (#R;Error ($_ text/append "JSON object does not have field " (show-string field-name) " @ " (show-json json))))))
(def: #export any
{#;doc "Just returns the JSON input without applying any logic."}
@@ -583,10 +582,10 @@
(#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 ($_ text/append "JSON array does no have size " (nat/encode size) " " (show-json json))))
_
- (#R;Error (format "JSON value is not an array: " (show-json json))))))
+ (#R;Error ($_ text/append "JSON value is not an array: " (show-json json))))))
(def: #export (object-fields! wanted-fields)
{#;doc "Ensures that every field in the list of wanted-fields is present in a JSON object."}
@@ -599,10 +598,10 @@
(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 ($_ text/append "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 ($_ text/append "JSON value is not an object: " (show-json json))))))
## [Structures]
(struct: #export _ (Eq JSON)
@@ -876,7 +875,7 @@
## Bound type-vars
(poly;bound env :x:)
## If all else fails...
- (macro;fail (format "Cannot create JSON encoder for: " (%type :x:)))
+ (macro;fail ($_ text/append "Cannot create JSON encoder for: " (type;to-text :x:)))
))))
(def: #hidden (rec-decode non-rec)
@@ -1063,7 +1062,7 @@
[g!bound (poly;bound env :x:)]
(wrap g!bound))
## If all else fails...
- (macro;fail (format "Cannot create JSON decoder for: " (%type :x:)))
+ (macro;fail ($_ text/append "Cannot create JSON decoder for: " (type;to-text :x:)))
))))
(syntax: #export (Codec<JSON,?> :x:)
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-11 12:29:00 +0000