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.lux421
1 files changed, 0 insertions, 421 deletions
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
deleted file mode 100644
index a9986822f..000000000
--- a/stdlib/source/lux/data/format/json.lux
+++ /dev/null
@@ -1,421 +0,0 @@
-(.module: {#.doc (.doc "Functionality for reading and writing values in the JSON format."
- "For more information, please see: http://www.json.org/")}
- [lux #*
- ["." meta (#+ monad)]
- [abstract
- [equivalence (#+ Equivalence)]
- [codec (#+ Codec)]
- [predicate (#+ Predicate)]
- ["." monad (#+ do)]]
- [control
- pipe
- ["." try (#+ Try)]
- ["<>" parser ("#\." monad)
- ["<.>" text (#+ Parser)]]]
- [data
- ["." bit]
- ["." maybe]
- ["." product]
- ["." text ("#\." equivalence monoid)]
- [collection
- ["." list ("#\." fold functor)]
- ["." row (#+ Row row) ("#\." monad)]
- ["." dictionary (#+ Dictionary)]]]
- [macro (#+ with_gensyms)
- [syntax (#+ syntax:)]
- ["." code]]
- [math
- [number
- ["n" nat]
- ["f" frac ("#\." decimal)]]]])
-
-(template [<name> <type>]
- [(type: #export <name>
- <type>)]
-
- [Null Any]
- [Boolean Bit]
- [Number Frac]
- [String Text]
- )
-
-(type: #export #rec JSON
- (#Null Null)
- (#Boolean Boolean)
- (#Number Number)
- (#String String)
- (#Array (Row JSON))
- (#Object (Dictionary String JSON)))
-
-(template [<name> <type>]
- [(type: #export <name>
- <type>)]
-
- [Array (Row JSON)]
- [Object (Dictionary String JSON)]
- )
-
-(def: #export null?
- (Predicate JSON)
- (|>> (case> #Null true
- _ false)))
-
-(def: #export object
- (-> (List [String JSON]) JSON)
- (|>> (dictionary.from_list text.hash) #..Object))
-
-(syntax: #export (json token)
- {#.doc (doc "A simple way to produce JSON literals."
- (json #null)
- (json #1)
- (json +123.456)
- (json "this is a string")
- (json ["this" "is" "an" "array"])
- (json {"this" "is"
- "an" "object"}))}
- (let [(^open ".") ..monad
- wrapper (function (_ x) (` (..json (~ x))))]
- (case token
- (^template [<ast_tag> <ctor> <json_tag>]
- [[_ (<ast_tag> value)]
- (wrap (list (` (: JSON (<json_tag> (~ (<ctor> value)))))))])
- ([#.Bit code.bit #..Boolean]
- [#.Frac code.frac #..Number]
- [#.Text code.text #..String])
-
- [_ (#.Tag ["" "null"])]
- (wrap (list (` (: JSON #..Null))))
-
- [_ (#.Tuple members)]
- (wrap (list (` (: JSON (#..Array ((~! row) (~+ (list\map wrapper members))))))))
-
- [_ (#.Record pairs)]
- (do {! ..monad}
- [pairs' (monad.map !
- (function (_ [slot value])
- (case slot
- [_ (#.Text key_name)]
- (wrap (` [(~ (code.text key_name)) (~ (wrapper value))]))
-
- _
- (meta.fail "Wrong syntax for JSON object.")))
- pairs)]
- (wrap (list (` (: JSON (#..Object ((~! dictionary.from_list)
- (~! text.hash)
- (list (~+ pairs')))))))))
-
- _
- (wrap (list token)))))
-
-(def: #export (fields json)
- {#.doc "Get all the fields in a JSON object."}
- (-> JSON (Try (List String)))
- (case json
- (#Object obj)
- (#try.Success (dictionary.keys obj))
-
- _
- (#try.Failure ($_ text\compose "Cannot get the fields of a non-object."))))
-
-(def: #export (get key json)
- {#.doc "A JSON object field getter."}
- (-> String JSON (Try JSON))
- (case json
- (#Object obj)
- (case (dictionary.get key obj)
- (#.Some value)
- (#try.Success value)
-
- #.None
- (#try.Failure ($_ text\compose "Missing field '" key "' on object.")))
-
- _
- (#try.Failure ($_ text\compose "Cannot get field '" key "' on a non-object."))))
-
-(def: #export (set key value json)
- {#.doc "A JSON object field setter."}
- (-> String JSON JSON (Try JSON))
- (case json
- (#Object obj)
- (#try.Success (#Object (dictionary.put key value obj)))
-
- _
- (#try.Failure ($_ text\compose "Cannot set field '" key "' on a non-object."))))
-
-(template [<name> <tag> <type> <desc>]
- [(def: #export (<name> key json)
- {#.doc (code.text ($_ text\compose "A JSON object field getter for " <desc> "."))}
- (-> Text JSON (Try <type>))
- (case (get key json)
- (#try.Success (<tag> value))
- (#try.Success value)
-
- (#try.Success _)
- (#try.Failure ($_ text\compose "Wrong value type at key: " key))
-
- (#try.Failure error)
- (#try.Failure error)))]
-
- [get_boolean #Boolean Boolean "booleans"]
- [get_number #Number Number "numbers"]
- [get_string #String String "strings"]
- [get_array #Array Array "arrays"]
- [get_object #Object Object "objects"]
- )
-
-(implementation: #export equivalence
- (Equivalence JSON)
-
- (def: (= x y)
- (case [x y]
- [#Null #Null]
- #1
-
- (^template [<tag> <struct>]
- [[(<tag> x') (<tag> y')]
- (\ <struct> = x' y')])
- ([#Boolean bit.equivalence]
- [#Number f.equivalence]
- [#String text.equivalence])
-
- [(#Array xs) (#Array ys)]
- (and (n.= (row.size xs) (row.size ys))
- (list\fold (function (_ idx prev)
- (and prev
- (maybe.default #0
- (do maybe.monad
- [x' (row.nth idx xs)
- y' (row.nth idx ys)]
- (wrap (= x' y'))))))
- #1
- (list.indices (row.size xs))))
-
- [(#Object xs) (#Object ys)]
- (and (n.= (dictionary.size xs) (dictionary.size ys))
- (list\fold (function (_ [xk xv] prev)
- (and prev
- (case (dictionary.get xk ys)
- #.None #0
- (#.Some yv) (= xv yv))))
- #1
- (dictionary.entries xs)))
-
- _
- #0)))
-
-############################################################
-############################################################
-############################################################
-
-(def: (format_null _)
- (-> Null Text)
- "null")
-
-(def: format_boolean
- (-> Boolean Text)
- (|>> (case>
- #0 "false"
- #1 "true")))
-
-(def: format_number
- (-> Number Text)
- (|>> (case>
- (^or +0.0 -0.0) "0.0"
- value (let [raw (\ f.decimal encode value)]
- (if (f.< +0.0 value)
- raw
- (|> raw (text.split 1) maybe.assume product.right))))))
-
-(def: escape "\")
-(def: escaped_dq (text\compose ..escape text.double_quote))
-
-(def: format_string
- (-> String Text)
- (|>> (text.replace_all text.double_quote ..escaped_dq)
- (text.enclose [text.double_quote text.double_quote])))
-
-(template [<token> <name>]
- [(def: <name>
- Text
- <token>)]
-
- ["," separator]
- [":" entry_separator]
-
- ["[" open_array]
- ["]" close_array]
-
- ["{" open_object]
- ["}" close_object]
- )
-
-(def: (format_array format)
- (-> (-> JSON Text) (-> Array Text))
- (|>> (row\map format)
- row.to_list
- (text.join_with ..separator)
- (text.enclose [..open_array ..close_array])))
-
-(def: (format_kv format [key value])
- (-> (-> JSON Text) (-> [String JSON] Text))
- ($_ text\compose
- (..format_string key)
- ..entry_separator
- (format value)
- ))
-
-(def: (format_object format)
- (-> (-> JSON Text) (-> Object Text))
- (|>> dictionary.entries
- (list\map (..format_kv format))
- (text.join_with ..separator)
- (text.enclose [..open_object ..close_object])))
-
-(def: #export (format json)
- (-> JSON Text)
- (case json
- (^template [<tag> <format>]
- [(<tag> value)
- (<format> value)])
- ([#Null ..format_null]
- [#Boolean ..format_boolean]
- [#Number ..format_number]
- [#String ..format_string]
- [#Array (..format_array format)]
- [#Object (..format_object format)])
- ))
-
-############################################################
-############################################################
-############################################################
-
-(def: parse_space
- (Parser Text)
- (<text>.some <text>.space))
-
-(def: parse_separator
- (Parser [Text Any Text])
- ($_ <>.and
- ..parse_space
- (<text>.this ..separator)
- ..parse_space))
-
-(def: parse_null
- (Parser Null)
- (do <>.monad
- [_ (<text>.this "null")]
- (wrap [])))
-
-(template [<name> <token> <value>]
- [(def: <name>
- (Parser Boolean)
- (do <>.monad
- [_ (<text>.this <token>)]
- (wrap <value>)))]
-
- [parse_true "true" #1]
- [parse_false "false" #0]
- )
-
-(def: parse_boolean
- (Parser Boolean)
- ($_ <>.either
- ..parse_true
- ..parse_false))
-
-(def: parse_number
- (Parser Number)
- (do {! <>.monad}
- [signed? (<>.parses? (<text>.this "-"))
- digits (<text>.many <text>.decimal)
- decimals (<>.default "0"
- (do !
- [_ (<text>.this ".")]
- (<text>.many <text>.decimal)))
- exp (<>.default ""
- (do !
- [mark (<text>.one_of "eE")
- signed?' (<>.parses? (<text>.this "-"))
- offset (<text>.many <text>.decimal)]
- (wrap ($_ text\compose mark (if signed?' "-" "") offset))))]
- (case (f\decode ($_ text\compose (if signed? "-" "") digits "." decimals exp))
- (#try.Failure message)
- (<>.fail message)
-
- (#try.Success value)
- (wrap value))))
-
-(def: parse_escaped
- (Parser Text)
- ($_ <>.either
- (<>.after (<text>.this "\t")
- (<>\wrap text.tab))
- (<>.after (<text>.this "\b")
- (<>\wrap text.back_space))
- (<>.after (<text>.this "\n")
- (<>\wrap text.new_line))
- (<>.after (<text>.this "\r")
- (<>\wrap text.carriage_return))
- (<>.after (<text>.this "\f")
- (<>\wrap text.form_feed))
- (<>.after (<text>.this (text\compose "\" text.double_quote))
- (<>\wrap text.double_quote))
- (<>.after (<text>.this "\\")
- (<>\wrap "\"))))
-
-(def: parse_string
- (Parser String)
- (<| (<text>.enclosed [text.double_quote text.double_quote])
- (loop [_ []])
- (do {! <>.monad}
- [chars (<text>.some (<text>.none_of (text\compose "\" text.double_quote)))
- stop <text>.peek])
- (if (text\= "\" stop)
- (do !
- [escaped parse_escaped
- next_chars (recur [])]
- (wrap ($_ text\compose chars escaped next_chars)))
- (wrap chars))))
-
-(def: (parse_kv parse_json)
- (-> (Parser JSON) (Parser [String JSON]))
- (do <>.monad
- [key ..parse_string
- _ ..parse_space
- _ (<text>.this ..entry_separator)
- _ ..parse_space
- value parse_json]
- (wrap [key value])))
-
-(template [<name> <type> <open> <close> <elem_parser> <prep>]
- [(def: (<name> parse_json)
- (-> (Parser JSON) (Parser <type>))
- (do <>.monad
- [_ (<text>.this <open>)
- _ parse_space
- elems (<>.separated_by ..parse_separator <elem_parser>)
- _ parse_space
- _ (<text>.this <close>)]
- (wrap (<prep> elems))))]
-
- [parse_array Array ..open_array ..close_array parse_json row.from_list]
- [parse_object Object ..open_object ..close_object (parse_kv parse_json) (dictionary.from_list text.hash)]
- )
-
-(def: parse_json
- (Parser JSON)
- (<>.rec
- (function (_ parse_json)
- ($_ <>.or
- parse_null
- parse_boolean
- parse_number
- parse_string
- (parse_array parse_json)
- (parse_object parse_json)))))
-
-(implementation: #export codec
- (Codec Text JSON)
-
- (def: encode ..format)
- (def: decode (<text>.run parse_json)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 04:57:56 +0000