diff --git a/lib/stdlib/src/json.erl b/lib/stdlib/src/json.erl index d3437e0c4ad..5654e47a3e4 100644 --- a/lib/stdlib/src/json.erl +++ b/lib/stdlib/src/json.erl @@ -51,7 +51,9 @@ standards. The decoder is tested using [JSONTestSuite](https://github.com/nst/JS -export([ format/1, format/2, format/3, - format_value/3 + format_value/3, + format_key_value_list/3, + format_key_value_list_checked/3 ]). -export_type([formatter/0]). @@ -694,17 +696,67 @@ format_tail([Head|Tail], Enc, State, IndentAll, IndentRow) -> format_tail([], _, _, _, _) -> []. +-doc """ +Format function for lists of key-value pairs as JSON objects. + +Accepts lists with atom, binary, integer, or float keys. +""". +-doc(#{since => <<"OTP 27.2">>}). + +-spec format_key_value_list([{term(), term()}], Encode::formatter(), State::map()) -> iodata(). format_key_value_list(KVList, UserEnc, #{level := Level} = State) -> {_,Indent} = indent(State), NextState = State#{level := Level+1}, {KISize, KeyIndent} = indent(NextState), EncKeyFun = fun(KeyVal, _Fun) -> UserEnc(KeyVal, UserEnc, NextState) end, - Entry = fun(Key, Value) -> - EncKey = key(Key, EncKeyFun), - ValState = NextState#{col := KISize + 2 + erlang:iolist_size(EncKey)}, - [$, , KeyIndent, EncKey, ": " | UserEnc(Value, UserEnc, ValState)] - end, - format_object([Entry(Key,Value) || {Key, Value} <- KVList], Indent). + EntryFun = fun({Key, Value}) -> + EncKey = key(Key, EncKeyFun), + ValState = NextState#{col := KISize + 2 + erlang:iolist_size(EncKey)}, + [$, , KeyIndent, EncKey, ": " | UserEnc(Value, UserEnc, ValState)] + end, + format_object(lists:map(EntryFun, KVList), Indent). + +-doc """ +Format function for lists of key-value pairs as JSON objects. + +Accepts lists with atom, binary, integer, or float keys. +Verifies that no duplicate keys will be produced in the +resulting JSON object. + +## Errors + +Raises `error({duplicate_key, Key})` if there are duplicates. +""". +-doc(#{since => <<"OTP 27.2">>}). + +-spec format_key_value_list_checked([{term(), term()}], Encoder::formatter(), State::map()) -> iodata(). +format_key_value_list_checked(KVList, UserEnc, State) when is_function(UserEnc, 3) -> + {_,Indent} = indent(State), + format_object(do_format_checked(KVList, UserEnc, State), Indent). + +do_format_checked([], _, _) -> + []; + +do_format_checked(KVList, UserEnc, #{level := Level} = State) -> + NextState = State#{level := Level + 1}, + {KISize, KeyIndent} = indent(NextState), + EncKeyFun = fun(KeyVal, _Fun) -> UserEnc(KeyVal, UserEnc, NextState) end, + EncListFun = + fun({Key, Value}, {Acc, Visited0}) -> + EncKey = iolist_to_binary(key(Key, EncKeyFun)), + case is_map_key(EncKey, Visited0) of + true -> + error({duplicate_key, Key}); + false -> + Visited1 = Visited0#{EncKey => true}, + ValState = NextState#{col := KISize + 2 + erlang:iolist_size(EncKey)}, + EncEntry = [$, , KeyIndent, EncKey, ": " + | UserEnc(Value, UserEnc, ValState)], + {[EncEntry | Acc], Visited1} + end + end, + {EncKVList, _} = lists:foldl(EncListFun, {[], #{}}, KVList), + lists:reverse(EncKVList). format_object([], _) -> <<"{}">>; format_object([[_Comma,KeyIndent|Entry]], Indent) -> diff --git a/lib/stdlib/test/json_SUITE.erl b/lib/stdlib/test/json_SUITE.erl index 3ac56f1ed28..70f92848fe1 100644 --- a/lib/stdlib/test/json_SUITE.erl +++ b/lib/stdlib/test/json_SUITE.erl @@ -39,6 +39,7 @@ test_encode_proplist/1, test_encode_escape_all/1, test_format_list/1, + test_format_proplist/1, test_format_map/1, test_format_fun/1, test_decode_atoms/1, @@ -91,6 +92,7 @@ groups() -> ]}, {format, [parallel], [ test_format_list, + test_format_proplist, test_format_map, test_format_fun ]}, @@ -367,6 +369,186 @@ test_format_list(_Config) -> ?assertEqual(ListString, format([~"foo", ~"bar", ~"baz"], #{indent => 3})), ok. +test_format_proplist(_Config) -> + Formatter = fun({kvlist, KVList}, Fun, State) -> + json:format_key_value_list(KVList, Fun, State); + ({kvlist_checked, KVList}, Fun, State) -> + json:format_key_value_list_checked(KVList, Fun, State); + (Other, Fun, State) -> + json:format_value(Other, Fun, State) + end, + + ?assertEqual(~""" + { + "a": 1, + "b": "str" + } + + """, format({kvlist, [{a, 1}, {b, ~"str"}]}, Formatter)), + + ?assertEqual(~""" + { + "a": 1, + "b": "str" + } + + """, format({kvlist_checked, [{a, 1}, {b, ~"str"}]}, Formatter)), + + ?assertEqual(~""" + { + "10": 1.0, + "1.0": 10, + "a": "αβ", + "αβ": "a" + } + + """, format({kvlist, [{10, 1.0}, + {1.0, 10}, + {a, ~"αβ"}, + {~"αβ", a} + ]}, Formatter)), + + ?assertEqual(~""" + { + "10": 1.0, + "1.0": 10, + "a": "αβ", + "αβ": "a" + } + + """, format({kvlist_checked, [{10, 1.0}, + {1.0, 10}, + {a, ~"αβ"}, + {~"αβ", a} + ]}, Formatter)), + + ?assertEqual(~""" + { + "a": 1, + "b": { + "aa": 10, + "bb": 20 + }, + "c": "str" + } + + """, format({kvlist, [{a, 1}, + {b, {kvlist, [{aa, 10}, {bb, 20}]}}, + {c, ~"str"} + ]}, Formatter)), + + ?assertEqual(~""" + [{ + "a1": 1, + "b1": [{ + "a11": 1, + "b11": 2 + },{ + "a12": 3, + "b12": 4 + }], + "c1": "str1" + }, + { + "a2": 2, + "b2": [{ + "a21": 5, + "b21": 6 + },{ + "a22": 7, + "b22": 8 + }], + "c2": "str2" + }] + + """, format([{kvlist, [{a1, 1}, + {b1, [{kvlist, [{a11, 1}, {b11, 2}]}, + {kvlist, [{a12, 3}, {b12, 4}]} + ]}, + {c1, ~"str1"} + ]}, + {kvlist, [{a2, 2}, + {b2, [{kvlist, [{a21, 5}, {b21, 6}]} + ,{kvlist, [{a22, 7}, {b22, 8}]} + ]}, + {c2, ~"str2"} + ]} + ], Formatter)), + + ?assertEqual(~""" + { + "a": 1, + "b": { + "aa": 10, + "bb": 20 + }, + "c": "str" + } + + """, format({kvlist_checked, [{a, 1}, + {b, {kvlist_checked, [{aa, 10}, {bb,20}]}}, + {c, ~"str"} + ]}, Formatter)), + + ?assertEqual(~""" + [{ + "a1": 1, + "b1": [{ + "a11": 1, + "b11": 2 + },{ + "a12": 3, + "b12": 4 + }], + "c1": "str1" + }, + { + "a2": 2, + "b2": [{ + "a21": 5, + "b21": 6 + },{ + "a22": 7, + "b22": 8 + }], + "c2": "str2" + }] + + """, format([{kvlist_checked, + [{a1, 1}, + {b1, [{kvlist_checked, [{a11, 1}, {b11, 2}]}, + {kvlist_checked, [{a12, 3}, {b12, 4}]} + ]}, + {c1, ~"str1"} + ]}, + {kvlist_checked, + [{a2, 2}, + {b2, [{kvlist_checked, [{a21, 5}, {b21, 6}]} + ,{kvlist_checked, [{a22, 7}, {b22, 8}]} + ]}, + {c2, ~"str2"} + ]} + ], Formatter)), + + + ?assertError({duplicate_key, a}, + format({kvlist_checked, [{a, 1}, {b, ~"str"}, {a, 2}]}, Formatter)), + + %% on invalid input exact error is not specified + ?assertError(_, format({kvlist, [{a, 1}, b]}, Formatter)), + + ?assertError(_, format({kvlist, x}, Formatter)), + + ?assertError(_, format({kvlist, [{#{}, 1}]}, Formatter)), + + ?assertError(_, format({kvlist_checked, [{a, 1}, b]}, Formatter)), + + ?assertError(_, format({kvlist_checked, x}, Formatter)), + + ?assertError(_, format({kvlist_checked, [{#{}, 1}]}, Formatter)), + + ok. + test_format_map(_Config) -> ?assertEqual(~'{}\n', format(#{})), ?assertEqual(~'{ "key": "val" }\n', format(#{key => val})),