%% The MIT License %% Copyright (c) 2010 Alisdair Sullivan %% Permission is hereby granted, free of charge, to any person obtaining a copy %% of this software and associated documentation files (the "Software"), to deal %% in the Software without restriction, including without limitation the rights %% to use, copy, modify, merge, publish, distribute, sublicense, and/or sell %% copies of the Software, and to permit persons to whom the Software is %% furnished to do so, subject to the following conditions: %% The above copyright notice and this permission notice shall be included in %% all copies or substantial portions of the Software. %% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR %% IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, %% FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE %% AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER %% LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, %% OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN %% THE SOFTWARE. -ifndef(error). -define(error(Args), erlang:error(badarg, Args) ). -endif. -ifndef(incomplete). -define(incomplete(State, T, Stack, Opts), {ok, lists:reverse(T), fun(Stream) when is_list(Stream) -> State(Stream, [], Stack, Opts) end } ). -endif. -ifndef(event). -define(event(Event, State, Rest, T, Stack, Opts), State(Rest, Event ++ T, Stack, Opts) ). -endif. start({string, String}, [], [], Opts) when is_binary(String); is_list(String) -> {ok, [{string, unicode:characters_to_list(json_escape(String, Opts))}, end_json], fun(X) when is_list(X) -> ?error([X, [], [], Opts]) end }; start({float, Float}, [], [], Opts) when is_float(Float) -> {ok, [{float, Float}, end_json], fun(X) when is_list(X) -> ?error([X, [], [], Opts]) end }; start({integer, Int}, [], [], Opts) when is_integer(Int) -> {ok, [{integer, Int}, end_json], fun(X) when is_list(X) -> ?error([X, [], [], Opts]) end }; start({literal, Atom}, [], [], Opts) when Atom == true; Atom == false; Atom == null -> {ok, [{literal, Atom}, end_json], fun(X) when is_list(X) -> ?error([X, [], [], Opts]) end }; %% third parameter is a stack to match end_foos to start_foos start(Forms, [], [], Opts) -> list_or_object(Forms, [], [], Opts). list_or_object([start_object|Forms], T, Stack, Opts) -> ?event([start_object], key, Forms, T, [object] ++ Stack, Opts); list_or_object([start_array|Forms], T, Stack, Opts) -> ?event([start_array], value, Forms, T, [array] ++ Stack, Opts); list_or_object([], T, Stack, Opts) -> ?incomplete(list_or_object, T, Stack, Opts); list_or_object(Forms, T, Stack, Opts) -> ?error([Forms, T, Stack, Opts]). key([{key, Key}|Forms], T, Stack, Opts) when is_binary(Key); is_list(Key) -> ?event([{key, unicode:characters_to_list(json_escape(Key, Opts))}], value, Forms, T, Stack, Opts ); key([end_object|Forms], T, [object|Stack], Opts) -> ?event([end_object], maybe_done, Forms, T, Stack, Opts); key([], T, Stack, Opts) -> ?incomplete(key, T, Stack, Opts); key(Forms, T, Stack, Opts) -> ?error([Forms, T, Stack, Opts]). value([{string, S}|Forms], T, Stack, Opts) when is_binary(S); is_list(S) -> ?event([{string, unicode:characters_to_list(json_escape(S, Opts))}], maybe_done, Forms, T, Stack, Opts ); value([{float, F}|Forms], T, Stack, Opts) when is_float(F) -> ?event([{float, F}], maybe_done, Forms, T, Stack, Opts); value([{integer, I}|Forms], T, Stack, Opts) when is_integer(I) -> ?event([{integer, I}], maybe_done, Forms, T, Stack, Opts); value([{literal, L}|Forms], T, Stack, Opts) when L == true; L == false; L == null -> ?event([{literal, L}], maybe_done, Forms, T, Stack, Opts); value([start_object|Forms], T, Stack, Opts) -> ?event([start_object], key, Forms, T, [object] ++ Stack, Opts); value([start_array|Forms], T, Stack, Opts) -> ?event([start_array], maybe_done, Forms, T, [array] ++ Stack, Opts); value([end_array|Forms], T, [array|Stack], Opts) -> ?event([end_array], maybe_done, Forms, T, Stack, Opts); value([], T, Stack, Opts) -> ?incomplete(value, T, Stack, Opts); value(Forms, T, Stack, Opts) -> ?error([Forms, T, Stack, Opts]). maybe_done([end_json], T, [], Opts) -> ?event([end_json], done, [], T, [], Opts); maybe_done([end_object|Forms], T, [object|Stack], Opts) -> ?event([end_object], maybe_done, Forms, T, Stack, Opts); maybe_done([end_array|Forms], T, [array|Stack], Opts) -> ?event([end_array], maybe_done, Forms, T, Stack, Opts); maybe_done(Forms, T, [object|_] = Stack, Opts) -> key(Forms, T, Stack, Opts); maybe_done(Forms, T, [array|_] = Stack, Opts) -> value(Forms, T, Stack, Opts); maybe_done([], T, Stack, Opts) -> ?incomplete(maybe_done, T, Stack, Opts); maybe_done(Forms, T, Stack, Opts) -> ?error([Forms, T, Stack, Opts]). done([], T, [], Opts) -> {ok, lists:reverse(T), fun(X) when is_list(X) -> done(X, T, [], Opts) end }; done(Forms, T, Stack, Opts) -> ?error([Forms, T, Stack, Opts]). %% json string escaping, for utf8 binaries. escape the json control sequences to %% their json equivalent, escape other control characters to \uXXXX sequences, %% everything else should be a legal json string component json_escape(String, Opts) when is_binary(String) -> json_escape(String, Opts, <<>>); json_escape(String, Opts) when is_list(String) -> json_escape(String, Opts, []). %% double quote json_escape(<<$\", Rest/binary>>, Opts, Acc) -> json_escape(Rest, Opts, <>); json_escape([$\"|Rest], Opts, Acc) -> json_escape(Rest, Opts, [$\", $\\] ++ Acc); %% backslash \ reverse solidus json_escape(<<$\\, Rest/binary>>, Opts, Acc) -> json_escape(Rest, Opts, <>); json_escape([$\\|Rest], Opts, Acc) -> json_escape(Rest, Opts, [$\\, $\\] ++ Acc); %% backspace json_escape(<<$\b, Rest/binary>>, Opts, Acc) -> json_escape(Rest, Opts, <>); json_escape([$\b|Rest], Opts, Acc) -> json_escape(Rest, Opts, [$b, $\\] ++ Acc); %% form feed json_escape(<<$\f, Rest/binary>>, Opts, Acc) -> json_escape(Rest, Opts, <>); json_escape([$\f|Rest], Opts, Acc) -> json_escape(Rest, Opts, [$f, $\\] ++ Acc); %% newline json_escape(<<$\n, Rest/binary>>, Opts, Acc) -> json_escape(Rest, Opts, <>); json_escape([$\n|Rest], Opts, Acc) -> json_escape(Rest, Opts, [$n, $\\] ++ Acc); %% cr json_escape(<<$\r, Rest/binary>>, Opts, Acc) -> json_escape(Rest, Opts, <>); json_escape([$\r|Rest], Opts, Acc) -> json_escape(Rest, Opts, [$r, $\\] ++ Acc); %% tab json_escape(<<$\t, Rest/binary>>, Opts, Acc) -> json_escape(Rest, Opts, <>); json_escape([$\t|Rest], Opts, Acc) -> json_escape(Rest, Opts, [$t, $\\] ++ Acc); %% other control characters json_escape(<>, Opts, Acc) when C >= 0, C < $\s -> json_escape(Rest, Opts, <> ); json_escape([C|Rest], Opts, Acc) when C >= 0, C < $\s -> json_escape(Rest, Opts, lists:reverse(json_escape_sequence(C)) ++ Acc); %% escape forward slashes -- optionally -- to faciliate microsoft's retarded %% date format json_escape(<<$/, Rest/binary>>, Opts=#opts{escape_forward_slash=true}, Acc) -> json_escape(Rest, Opts, <>); json_escape([$/|Rest], Opts=#opts{escape_forward_slash=true}, Acc) -> json_escape(Rest, Opts, [$/, $\\] ++ Acc); %% escape u+2028 and u+2029 to avoid problems with jsonp json_escape(<>, Opts, Acc) when C == 16#2028; C == 16#2029 -> json_escape(Rest, Opts, <> ); json_escape([C|Rest], Opts, Acc) when C =:= 16#2028; C =:= 16#2029 -> json_escape(Rest, Opts, lists:reverse(json_escape_sequence(C)) ++ Acc); %% any other legal codepoint json_escape(<>, Opts, Acc) -> json_escape(Rest, Opts, <>); json_escape([C|Rest], Opts, Acc) -> json_escape(Rest, Opts, [C] ++ Acc); json_escape(<<>>, _Opts, Acc) -> Acc; json_escape([], _Opts, Acc) -> lists:reverse(Acc); json_escape(Rest, Opts, Acc) -> erlang:error(badarg, [Rest, Opts, Acc]). %% convert a codepoint to it's \uXXXX equiv. json_escape_sequence(X) -> <> = <>, [$\\, $u, (to_hex(A)), (to_hex(B)), (to_hex(C)), (to_hex(D))]. to_hex(15) -> $f; to_hex(14) -> $e; to_hex(13) -> $d; to_hex(12) -> $c; to_hex(11) -> $b; to_hex(10) -> $a; to_hex(X) -> X + $0.