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.lux242
1 files changed, 24 insertions, 218 deletions
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 162cf8387..417db04b6 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -2,25 +2,23 @@
"For more information, please see: http://www.json.org/")}
[lux #*
[abstract
- ["." monad (#+ Monad do)]
+ ["." monad (#+ do)]
[equivalence (#+ Equivalence)]
codec]
[control
pipe
["p" parser ("#@." monad)
- ["l" text (#+ Parser)]]
- ["ex" exception (#+ exception:)]]
+ ["l" text (#+ Parser)]]]
[data
["." bit]
["." maybe]
["." error (#+ Error)]
- ["." sum]
["." product]
[number
["." frac ("#@." decimal)]]
["." text ("#@." equivalence monoid)]
[collection
- ["." list ("#@." fold monad)]
+ ["." list ("#@." fold functor)]
["." row (#+ Row row) ("#@." monad)]
["." dictionary (#+ Dictionary)]]]
["." macro (#+ monad with-gensyms)
@@ -51,10 +49,6 @@
[Object (Dictionary String JSON)]
)
-(type: #export (Reader a)
- {#.doc "JSON reader."}
- (p.Parser (List JSON) a))
-
(syntax: #export (json token)
{#.doc (doc "A simple way to produce JSON literals."
(json #1)
@@ -194,14 +188,16 @@
############################################################
############################################################
-(def: encode-boolean
- (-> Bit Text)
+(def: (format-null _) (-> Null Text) "null")
+
+(def: format-boolean
+ (-> Boolean Text)
(|>> (case>
#0 "false"
#1 "true")))
-(def: encode-number
- (-> Frac Text)
+(def: format-number
+ (-> Number Text)
(|>> (case>
+0.0 "0.0"
-0.0 "0.0"
@@ -210,231 +206,41 @@
raw
(|> raw (text.split 1) maybe.assume product.right))))))
-(def: (show-null _) (-> Null Text) "null")
-
-(template [<name> <type> <codec>]
- [(def: <name> (-> <type> Text) <codec>)]
-
- [show-boolean Boolean ..encode-boolean]
- [show-number Number ..encode-number]
- [show-string String text.encode]
- )
+(def: format-string (-> String Text) text.encode)
-(def: (show-array show-json elems)
+(def: (format-array format elems)
(-> (-> JSON Text) (-> Array Text))
($_ text@compose "["
- (|> elems (row@map show-json) row.to-list (text.join-with ","))
+ (|> elems (row@map format) row.to-list (text.join-with ","))
"]"))
-(def: (show-object show-json object)
+(def: (format-object format object)
(-> (-> JSON Text) (-> Object Text))
($_ text@compose "{"
(|> object
dictionary.entries
- (list@map (function (_ [key value]) ($_ text@compose (show-string key) ":" (show-json value))))
+ (list@map (function (_ [key value]) ($_ text@compose (format-string key) ":" (format value))))
(text.join-with ","))
"}"))
-(def: (show-json json)
+(def: #export (format json)
(-> JSON Text)
(case json
- (^template [<tag> <show>]
+ (^template [<tag> <format>]
(<tag> value)
- (<show> value))
- ([#Null show-null]
- [#Boolean show-boolean]
- [#Number show-number]
- [#String show-string]
- [#Array (show-array show-json)]
- [#Object (show-object show-json)])
+ (<format> value))
+ ([#Null format-null]
+ [#Boolean format-boolean]
+ [#Number format-number]
+ [#String format-string]
+ [#Array (format-array format)]
+ [#Object (format-object format)])
))
############################################################
############################################################
############################################################
-(exception: #export (unconsumed-input {input (List JSON)})
- (|> input
- (list@map show-json)
- (text.join-with text.new-line)))
-
-(exception: #export (empty-input)
- "")
-
-(def: #export (run json parser)
- (All [a] (-> JSON (Reader a) (Error a)))
- (case (p.run (list json) parser)
- (#error.Success [remainder output])
- (case remainder
- #.Nil
- (#error.Success output)
-
- _
- (ex.throw unconsumed-input remainder))
-
- (#error.Failure error)
- (#error.Failure error)))
-
-(def: #export (fail error)
- (All [a] (-> Text (Reader a)))
- (function (_ inputs)
- (#error.Failure error)))
-
-(def: #export any
- {#.doc "Just returns the JSON input without applying any logic."}
- (Reader JSON)
- (<| (function (_ inputs))
- (case inputs
- #.Nil
- (ex.throw empty-input [])
-
- (#.Cons head tail)
- (#error.Success [tail head]))))
-
-(template [<name> <type> <tag> <desc>]
- [(def: #export <name>
- {#.doc (code.text ($_ text@compose "Reads a JSON value as " <desc> "."))}
- (Reader <type>)
- (do p.monad
- [head any]
- (case head
- (<tag> value)
- (wrap value)
-
- _
- (fail ($_ text@compose "JSON value is not " <desc> ".")))))]
-
- [null Any #Null "null"]
- [boolean Bit #Boolean "boolean"]
- [number Frac #Number "number"]
- [string Text #String "string"]
- )
-
-(template [<test> <check> <type> <eq> <encoder> <tag> <desc>]
- [(def: #export (<test> test)
- {#.doc (code.text ($_ text@compose "Asks whether a JSON value is a " <desc> "."))}
- (-> <type> (Reader Bit))
- (do p.monad
- [head any]
- (case head
- (<tag> value)
- (wrap (:: <eq> = test value))
-
- _
- (fail ($_ text@compose "JSON value is not " <desc> ".")))))
-
- (def: #export (<check> test)
- {#.doc (code.text ($_ text@compose "Ensures a JSON value is a " <desc> "."))}
- (-> <type> (Reader Any))
- (do p.monad
- [head any]
- (case head
- (<tag> value)
- (if (:: <eq> = test value)
- (wrap [])
- (fail ($_ text@compose "Value mismatch: " (<encoder> test) " =/= " (<encoder> value))))
-
- _
- (fail ($_ text@compose "JSON value is not a " <desc> ".")))))]
-
- [boolean? boolean! Bit bit.equivalence encode-boolean #Boolean "boolean"]
- [number? number! Frac frac.equivalence (:: frac.decimal encode) #Number "number"]
- [string? string! Text text.equivalence text.encode #String "string"]
- )
-
-(def: #export (nullable parser)
- (All [a] (-> (Reader a) (Reader (Maybe a))))
- (p.or null
- parser))
-
-(def: #export (array parser)
- {#.doc "Parses a JSON array."}
- (All [a] (-> (Reader a) (Reader a)))
- (do p.monad
- [head any]
- (case head
- (#Array values)
- (case (p.run (row.to-list values) parser)
- (#error.Failure error)
- (fail error)
-
- (#error.Success [remainder output])
- (case remainder
- #.Nil
- (wrap output)
-
- _
- (fail (ex.construct unconsumed-input remainder))))
-
- _
- (fail (text@compose "JSON value is not an array: " (show-json head))))))
-
-(def: #export (object parser)
- {#.doc "Parses a JSON object. Use this with the 'field' combinator."}
- (All [a] (-> (Reader a) (Reader a)))
- (do p.monad
- [head any]
- (case head
- (#Object kvs)
- (case (p.run (|> kvs
- dictionary.entries
- (list@map (function (_ [key value])
- (list (#String key) value)))
- list.concat)
- parser)
- (#error.Failure error)
- (fail error)
-
- (#error.Success [remainder output])
- (case remainder
- #.Nil
- (wrap output)
-
- _
- (fail (ex.construct unconsumed-input remainder))))
-
- _
- (fail (text@compose "JSON value is not an object: " (show-json head))))))
-
-(def: #export (field field-name parser)
- {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."}
- (All [a] (-> Text (Reader a) (Reader a)))
- (function (recur inputs)
- (case inputs
- (^ (list& (#String key) value inputs'))
- (if (text@= key field-name)
- (case (p.run (list value) parser)
- (#error.Success [#.Nil output])
- (#error.Success [inputs' output])
-
- (#error.Success [inputs'' _])
- (ex.throw unconsumed-input inputs'')
-
- (#error.Failure error)
- (#error.Failure error))
- (do error.monad
- [[inputs'' output] (recur inputs')]
- (wrap [(list& (#String key) value inputs'')
- output])))
-
- #.Nil
- (ex.throw empty-input [])
-
- _
- (ex.throw unconsumed-input inputs))))
-
-(def: #export dictionary
- {#.doc "Parses a dictionary-like JSON object."}
- (All [a] (-> (Reader a) (Reader (Dictionary Text a))))
- (|>> (p.and ..string)
- p.some
- object
- (p@map (dictionary.from-list text.hash))))
-
-############################################################
-############################################################
-############################################################
-
(def: space~
(Parser Text)
(l.some l.space))
@@ -548,5 +354,5 @@
($_ p.or null~ boolean~ number~ string~ (array~ json~') (object~ json~')))
(structure: #export codec (Codec Text JSON)
- (def: encode show-json)
+ (def: encode ..format)
(def: decode (function (_ input) (l.run input (json~' [])))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 06:22:34 +0000