Packages
fast_xml
1.1.27
1.1.60
1.1.59
1.1.58
1.1.57
1.1.56
1.1.55
1.1.53
1.1.52
1.1.51
1.1.49
1.1.48
1.1.47
1.1.46
1.1.45
1.1.43
1.1.41
1.1.40
1.1.39
1.1.38
1.1.37
1.1.36
1.1.35
1.1.34
1.1.32
1.1.31
1.1.30
1.1.29
1.1.28
1.1.27
1.1.26
1.1.24
1.1.23
1.1.22
1.1.20
1.1.19
1.1.18
1.1.15
1.1.14
1.1.13
1.1.12
1.1.11
1.1.10
1.1.9
1.1.8
1.1.7
1.1.6
1.1.5
1.1.4
1.1.3
1.1.2
Fast Expat-based Erlang / Elixir XML parsing library
Current section
Files
Jump to
Current section
Files
src/fxml_gen.erl
%%%----------------------------------------------------------------------
%%% File : xml_gen.erl
%%% Author : Evgeniy Khramtsov <ekhramtsov@process-one.net>
%%% Purpose : XML code generator
%%% Created : 22 Jun 2009 by Evgeniy Khramtsov <ekhramtsov@process-one.net>
%%%
%%%
%%% Copyright (C) 2002-2017 ProcessOne, SARL. All Rights Reserved.
%%%
%%% Licensed under the Apache License, Version 2.0 (the "License");
%%% you may not use this file except in compliance with the License.
%%% You may obtain a copy of the License at
%%%
%%% http://www.apache.org/licenses/LICENSE-2.0
%%%
%%% Unless required by applicable law or agreed to in writing, software
%%% distributed under the License is distributed on an "AS IS" BASIS,
%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%%% See the License for the specific language governing permissions and
%%% limitations under the License.
%%%
%%%----------------------------------------------------------------------
-module(fxml_gen).
-compile(debug_info).
-compile({parse_transform, fxml_gen_pt}).
%% Generator API
-export([compile/1, compile/2]).
%% Runtime API
-export([format_error/1, io_format_error/1, get_attr/3]).
%% Runtime built-in decoders/encoders
-export([dec_int/1, dec_int/3, dec_enum/2, enc_int/1, enc_enum/1, not_empty/1,
enc_xmlns_attrs/2, choose_top_xmlns/3,
register_module/2, unregister_module/2, recompile_resolver/2]).
-include("fxml_gen.hrl").
-include("fxml.hrl").
-define(err(F, Args),
begin
io:format("** fxml_gen error: " ++ F ++ "~n", Args),
erlang:error(badarg)
end).
-define(info(F, Args), io:format("fxml_gen: " ++ F ++ "~n", Args)).
-define(warn(F, Args), io:format("* fxml_gen warning: " ++ F ++ "~n", Args)).
%%====================================================================
%% Compiler API
%%====================================================================
compile(Path) ->
compile(Path, []).
compile(Path, Opts) ->
case catch do_compile(Path, Opts) of
ok ->
ok;
Err ->
io:format("failed to compile ~p: ~p~n", [Path, Err]),
Err
end.
do_compile(Path, Opts) ->
case get_files_from_predefined_dir() of
{ok, Files} ->
case lists:foldr(
fun(_, {error, _} = Err) ->
Err;
(File, {AccTs, AccFs}) ->
case consult(File) of
{ok, Ts, Fs} ->
{Ts ++ AccTs, Fs ++ AccFs};
Err ->
Err
end
end, {[], []}, [Path|Files]) of
{error, Why} ->
{error, Why};
{Terms, Forms} ->
Elems = lists:flatmap(
fun({Tag, Elem}) when is_atom(Tag),
is_record(Elem, elem) ->
[{Tag, Elem}];
(_) ->
[]
end, Terms),
compile(Elems, Forms, Path, Opts)
end;
Err ->
Err
end.
get_files_from_predefined_dir() ->
case os:getenv("FXML_GEN_DIR") of
false ->
{ok, []};
Dir ->
case file:list_dir(Dir) of
{ok, Files} ->
{ok, lists:flatmap(
fun(File) ->
case filename:extension(File) of
".spec" ->
[filename:join(Dir, File)];
_ ->
[]
end
end, Files)};
{error, _} = Err ->
Err
end
end.
%%====================================================================
%% Runtime decoders/encoders
%%====================================================================
-spec dec_int(binary()) -> integer().
dec_int(Val) ->
dec_int(Val, infinity, infinity).
dec_int(Val, Min, Max) ->
case erlang:binary_to_integer(Val) of
Int when Int =< Max, Min == infinity ->
Int;
Int when Int =< Max, Int >= Min ->
Int
end.
-spec enc_int(integer()) -> binary().
enc_int(Int) ->
erlang:integer_to_binary(Int).
-spec dec_enum(binary(), [atom()]) -> atom().
dec_enum(Val, Enums) ->
AtomVal = erlang:binary_to_existing_atom(Val, utf8),
case lists:member(AtomVal, Enums) of
true ->
AtomVal
end.
-spec enc_enum(atom()) -> binary().
enc_enum(Atom) ->
erlang:atom_to_binary(Atom, utf8).
-spec not_empty(binary()) -> binary().
not_empty(<<_, _/binary>> = Val) ->
Val.
%%====================================================================
%% Runtime builtins
%%====================================================================
format_error({bad_attr_value, Attr, Tag, XMLNS}) ->
<<"Bad value of attribute '", Attr/binary,
"' in tag <", Tag/binary, "/> qualified by namespace '",
XMLNS/binary, "'">>;
format_error({bad_cdata_value, <<>>, Tag, XMLNS}) ->
<<"Bad value of cdata in tag <", Tag/binary,
"/> qualified by namespace '", XMLNS/binary, "'">>;
format_error({missing_tag, Tag, XMLNS}) ->
<<"Missing tag <", Tag/binary,
"/> qualified by namespace '", XMLNS/binary, "'">>;
format_error({missing_attr, Attr, Tag, XMLNS}) ->
<<"Missing attribute '", Attr/binary,
"' in tag <", Tag/binary,
"/> qualified by namespace '", XMLNS/binary, "'">>;
format_error({missing_cdata, <<>>, Tag, XMLNS}) ->
<<"Missing cdata in tag <", Tag/binary,
"/> qualified by namespace '", XMLNS/binary, "'">>;
format_error({unknown_tag, Tag, XMLNS}) ->
<<"Unknown tag <", Tag/binary,
"/> qualified by namespace '", XMLNS/binary, "'">>;
format_error({missing_tag_xmlns, Tag}) ->
<<"Missing namespace for tag <", Tag/binary, "/>">>.
io_format_error({bad_attr_value, Attr, Tag, XMLNS}) ->
{<<"Bad value of attribute '~s' in tag <~s/> qualified by namespace '~s'">>,
[Attr, Tag, XMLNS]};
io_format_error({bad_cdata_value, <<>>, Tag, XMLNS}) ->
{<<"Bad value of cdata in tag <~s/> qualified by namespace '~s'">>,
[Tag, XMLNS]};
io_format_error({missing_tag, Tag, XMLNS}) ->
{<<"Missing tag <~s/> qualified by namespace '~s'">>, [Tag, XMLNS]};
io_format_error({missing_attr, Attr, Tag, XMLNS}) ->
{<<"Missing attribute '~s' in tag <~s/> qualified by namespace '~s'">>,
[Attr, Tag, XMLNS]};
io_format_error({missing_cdata, <<>>, Tag, XMLNS}) ->
{<<"Missing cdata in tag <~s/> qualified by namespace '~s'">>,
[Tag, XMLNS]};
io_format_error({unknown_tag, Tag, XMLNS}) ->
{<<"Unknown tag <~s/> qualified by namespace '~s'">>, [Tag, XMLNS]};
io_format_error({missing_tag_xmlns, Tag}) ->
{<<"Missing namespace for tag <~s/>">>, [Tag]}.
get_attr(Attr, Attrs, Default) ->
case lists:keyfind(Attr, 1, Attrs) of
{_, Val} -> Val;
false -> Default
end.
enc_xmlns_attrs(XMLNS, XMLNS) -> [];
enc_xmlns_attrs(XMLNS, _) -> [{<<"xmlns">>, XMLNS}].
choose_top_xmlns(<<>>, NSList, TopXMLNS) ->
case lists:member(TopXMLNS, NSList) of
true -> TopXMLNS;
false -> hd(NSList)
end;
choose_top_xmlns(XMLNS, _, _) ->
XMLNS.
register_module(Mod, ResolverMod) ->
MD5Sum = try Mod:module_info(md5) of
Val -> Val
catch error:badarg ->
%% 'md5' attribute is relatively new,
%% calculate md5sum using beam_lib for
%% older OTP
{ok, {Mod, Val}} = beam_lib:md5(code:which(Mod)),
Val
end,
case orddict:find(Mod, ResolverMod:modules()) of
{ok, MD5Sum} ->
ok;
_ ->
Mods = orddict:store(Mod, MD5Sum, ResolverMod:modules()),
recompile_resolver(Mods, ResolverMod)
end.
unregister_module(Mod, ResolverMod) ->
case orddict:find(Mod, ResolverMod:modules()) of
{ok, _} ->
Mods = orddict:erase(Mod, ResolverMod:modules()),
recompile_resolver(Mods, ResolverMod);
error ->
ok
end.
%% We don't use erl_syntax here in order not to depend
%% on syntax_tools in runtime
recompile_resolver(Mods, ResolverMod) ->
Tags = lists:flatmap(
fun(M) ->
[{Name, XMLNS, M} || {Name, XMLNS} <- M:tags()]
end, orddict:fetch_keys(Mods)),
Records = lists:flatmap(
fun(M) ->
[{RecName, RecSize, M}
|| {RecName, RecSize} <- M:records()]
end, orddict:fetch_keys(Mods)),
Lookup1 = string:join(
lists:map(
fun({RecName, RecSize, M}) ->
io_lib:format(
"lookup({~s}) -> '~s'",
[string:join(
[io_lib:format("'~s'", [RecName]) |
["_" || _ <- lists:seq(1, RecSize)]],
","), M])
end, Records) ++ ["lookup(_) -> undefined."],
";" ++ io_lib:nl()),
Lookup2 = string:join(
lists:map(
fun({Name, XMLNS, M}) ->
io_lib:format("lookup(~w, ~w) -> '~s'",
[Name, XMLNS, M])
end, Tags) ++ ["lookup(_, _) -> undefined."],
";" ++ io_lib:nl()),
Modules = io_lib:format(
"modules() -> [~s].",
[string:join(
[io_lib:format(
"{'~s', ~w}", [M, S])
|| {M, S} <- Mods], ",")]),
Module = io_lib:format("-module(~s).", [ResolverMod]),
Compile = "-compile(export_all).",
Forms = lists:map(
fun(Expr) ->
{ok, Tokens, _} = erl_scan:string(lists:flatten(Expr)),
{ok, Form} = erl_parse:parse_form(Tokens),
Form
end, [Module, Compile, Modules, Lookup1, Lookup2]),
{ok, Code} = case compile:forms(Forms, []) of
{ok, ResolverMod, Bin} ->
{ok, Bin};
{ok, ResolverMod, Bin, _Warnings} ->
{ok, Bin};
Error ->
Error
end,
{module, ResolverMod} = code:load_binary(ResolverMod, "nofile", Code),
ok.
%%====================================================================
%% Internal functions
%%====================================================================
compile(TaggedElems0, Forms, Path, Opts) ->
FileName = filename:basename(Path),
ModName = list_to_atom(filename:rootname(FileName)),
ModNameHrl = filename:rootname(FileName) ++ ".hrl",
DirName = filename:dirname(Path),
ErlDirName = proplists:get_value(erl_dir, Opts, DirName),
HrlDirName = proplists:get_value(hrl_dir, Opts, DirName),
{AttrForms, RestForms} = lists:partition(
fun(Form) ->
erl_syntax:type(Form) == attribute
end, Forms),
FunForms = lists:foldl(
fun(F, Acc) ->
case erl_syntax:type(F) of
function ->
[F|Acc];
_ ->
Acc
end
end, make_builtin_codec_funs(), RestForms),
KnownFuns = [erl_syntax_lib:analyze_function(F) || F <- FunForms],
FunSpecs = lists:foldl(
fun(Form, D) ->
case erl_syntax_lib:analyze_attribute(Form) of
{spec, _} ->
case get_fun_spec(erl_syntax:revert(Form)) of
{Key, Value} ->
dict:store(Key, Value, D);
_ ->
D
end;
_ ->
D
end
end, dict:new(), AttrForms),
TaggedElems = lists:map(
fun({Tag, Elem}) ->
{Tag, prepare_elem(Elem, KnownFuns, FunSpecs,
TaggedElems0, ModName, Opts)}
end, TaggedElems0),
Dups = get_dups([Tag || {Tag, _} <- TaggedElems]),
if Dups /= [] ->
bad_spec({duplicated_elem_specs, Dups});
true ->
ok
end,
Dups1 = get_dups([{Elem#elem.name, Elem#elem.xmlns}
|| {_, Elem} <- TaggedElems]),
if Dups1 /= [] ->
bad_spec({duplicated_elem_names, Dups1});
true ->
ok
end,
Types = get_types(TaggedElems, FunSpecs, Opts),
RawAttributes = lists:flatmap(
fun(Form) ->
case erl_syntax_lib:analyze_attribute(Form) of
{spec, _} ->
[];
_ ->
erl_syntax:get_ann(Form)
end
end, lists:reverse(AttrForms)),
PredefRecords = get_predefined_records(AttrForms),
ASTs = lists:foldl(
fun({Tag, Elem}, Acc) ->
dict:append_list(
Elem#elem.module,
elem_to_AST(Elem, Tag, TaggedElems, Types,
ModName, PredefRecords, Opts),
Acc)
end, dict:from_list([{ModName, []}]), TaggedElems),
Records = make_records(Types, TaggedElems, PredefRecords, FunSpecs, Opts),
TypeSpecs = make_typespecs(ModName, Types, Opts),
Hdr = header(FileName),
FunDeps = build_fun_deps(FunForms),
case write_modules(ASTs, ModName, FunDeps, ErlDirName,
FileName, TaggedElems, PredefRecords) of
ok ->
case write_resolver(TaggedElems, ModName, ErlDirName, FileName) of
ok ->
io:format("Generating ~s~n", [ModNameHrl]),
file:write_file(
filename:join([HrlDirName, ModNameHrl]),
[erl_prettypr:format(Hdr),
RawAttributes,
io_lib:nl(),
string:join(Records, io_lib:nl() ++ io_lib:nl()),
io_lib:nl(),
io_lib:nl(),
TypeSpecs,
io_lib:nl()]);
Err ->
Err
end;
Err ->
Err
end.
write_modules(ASTs, ModName, FunDeps, ErlDirName,
FileName, TaggedElems, PredefRecords) ->
dict:fold(
fun(_, _, {error, _} = Err) ->
Err;
(Mod, AST, ok) ->
write_module(ModName, Mod, AST, FunDeps, ErlDirName,
FileName, TaggedElems, PredefRecords)
end, ok, ASTs).
write_module(ModName, ModName, AST, FunDeps, ErlDirName,
SpecFile, TaggedElems, PredefRecords) ->
ModNameErl = atom_to_list(ModName) ++ ".erl",
io:format("Generating ~s~n", [ModNameErl]),
Module = erl_syntax:attribute(
?AST(module),
[erl_syntax:atom(ModName)]),
TopDecoders = make_top_decoders(TaggedElems, ModName),
TopEncoders = make_top_encoders(TaggedElems, ModName),
Registrar = make_registrar(ModName),
Decoders = make_decoders(TaggedElems, ModName, ModName),
Encoders = make_encoders(TaggedElems, ModName),
Printer = make_printer(TaggedElems, PredefRecords, ModName, ModName),
GettersSetters = make_getters_setters(TaggedElems, PredefRecords, ModName),
Resolver = make_resolver(TaggedElems, ModName),
AuxFuns = make_aux_funs(),
LocalFunForms = make_local_funs(FunDeps, TaggedElems, ModName),
NewAST = TopDecoders ++ TopEncoders ++ Decoders ++ Encoders ++
GettersSetters ++ Registrar ++ AuxFuns ++ LocalFunForms ++ Printer ++ Resolver ++ AST,
Compile = erl_syntax:attribute(?AST(compile), [?AST(export_all)]),
Hdr = header(SpecFile),
ResultAST = erl_syntax:form_list([Hdr, Module, Compile|NewAST]),
file:write_file(
filename:join([ErlDirName, ModNameErl]),
[erl_prettypr:format(ResultAST), io_lib:nl()]);
write_module(ParentMod, ModName, AST, FunDeps, ErlDirName,
SpecFile, TaggedElems, PredefRecords) ->
ModNameErl = atom_to_list(ModName) ++ ".erl",
io:format("Generating ~s~n", [ModNameErl]),
Hdr = header(SpecFile),
Module = erl_syntax:attribute(
?AST(module),
[erl_syntax:atom(ModName)]),
Decoders = make_decoders(TaggedElems, ParentMod, ModName),
Encoders = make_encoders(TaggedElems, ModName),
Printer = make_printer(TaggedElems, PredefRecords, ModName, ParentMod),
GettersSetters = make_getters_setters(TaggedElems, PredefRecords, ModName),
Compile = erl_syntax:attribute(?AST(compile), [?AST(export_all)]),
LocalFunForms = make_local_funs(FunDeps, TaggedElems, ModName),
NewAST = Decoders ++ Encoders ++ GettersSetters ++ Printer ++ LocalFunForms ++ AST,
ResultAST = erl_syntax:form_list([Hdr, Module, Compile|NewAST]),
file:write_file(
filename:join([ErlDirName, ModNameErl]),
[erl_prettypr:format(ResultAST), io_lib:nl()]).
write_resolver(_TaggedElems, ParentMod, ErlDirName, SpecFile) ->
ModName = resolver_mod(ParentMod),
ModNameErl = atom_to_list(ModName) ++ ".erl",
io:format("Generating ~s~n", [ModNameErl]),
Hdr = header(SpecFile),
Module = erl_syntax:attribute(
?AST(module),
[erl_syntax:atom(ModName)]),
Compile = erl_syntax:attribute(?AST(compile), [?AST(export_all)]),
AST = [make_function(modules, [], [?AST([])]),
make_function(lookup, [?AST(_), ?AST(_)], [?AST(undefined)]),
make_function(lookup, [?AST(_)], [?AST(undefined)])],
ResultAST = erl_syntax:form_list([Hdr, Module, Compile|AST]),
file:write_file(
filename:join([ErlDirName, ModNameErl]),
[erl_prettypr:format(ResultAST), io_lib:nl()]).
get_fun_spec({attribute, _, spec, {MFA, Args}}) ->
Spec = case [Range || {type, _, 'fun', [_, Range]} <- Args] of
[] -> {type, 0, any, []};
[T] -> T;
Ts -> {type, 0, union, Ts}
end,
{MFA, Spec}.
get_predefined_records(AttrForms) ->
lists:foldl(
fun(F, Acc) ->
case erl_syntax_lib:analyze_attribute(F) of
{record, {RecName, RecAttrs}} ->
RecAttrs1 = lists:map(
fun({Attr, {Default, _}}) -> {Attr, Default};
({Attr, Default}) -> {Attr, Default}
end, RecAttrs),
dict:store(RecName, RecAttrs1, Acc);
_ ->
Acc
end
end, dict:new(), AttrForms).
make_aux_funs() ->
case get_abstract_code_from_myself() of
{ok, AbsCode} ->
lists:filter(
fun(T) ->
case catch erl_syntax_lib:analyze_function(T) of
{format_error, 1} -> true;
{io_format_error, 1} -> true;
{get_attr, 3} -> true;
{choose_top_xmlns, 3} -> true;
{enc_xmlns_attrs, 2} -> true;
{register_module, 2} -> true;
{unregister_module, 2} -> true;
{recompile_resolver, 2} -> true;
_ -> false
end
end, AbsCode);
error ->
erlang:error({no_abstract_code_found, ?MODULE})
end.
make_builtin_codec_funs() ->
case get_abstract_code_from_myself() of
{ok, AbsCode} ->
lists:filter(
fun(T) ->
case catch erl_syntax_lib:analyze_function(T) of
{dec_int, 3} -> true;
{dec_int, 1} -> true;
{dec_enum, 2} -> true;
{enc_int, 1} -> true;
{enc_enum, 1} -> true;
_ -> false
end
end, AbsCode);
error ->
erlang:error({no_abstract_code_found, ?MODULE})
end.
build_fun_deps(FunForms) ->
G = digraph:new([acyclic]),
lists:foreach(
fun(FunForm) ->
Fun = erl_syntax_lib:analyze_function(FunForm),
digraph:add_vertex(G, Fun, FunForm),
erl_syntax_lib:map(
fun(Form) ->
try erl_syntax_lib:analyze_application(Form) of
{_, Arity} = SubFun when is_integer(Arity) ->
case digraph:vertex(G, SubFun) of
false -> digraph:add_vertex(G, SubFun);
_ -> ok
end,
digraph:add_edge(G, Fun, SubFun);
_ ->
ok
catch _:_ ->
ok
end,
Form
end, FunForm)
end, FunForms),
G.
make_local_funs(FunDeps, TaggedElems, ModName) ->
CodecFuns = lists:flatmap(
fun({_, #elem{attrs = Attrs, cdata = CData, module = M}})
when M == ModName ->
[CData#cdata.enc, CData#cdata.dec|
lists:flatmap(
fun(#attr{enc = Enc, dec = Dec}) ->
[Enc,Dec]
end, Attrs)];
({_, _}) ->
[]
end, TaggedElems),
LocalFuns = lists:usort([{Name, length(Arity)+1} || {Name, Arity} <- CodecFuns]),
AllLocalFuns = lists:flatmap(
fun(LocalFun) ->
digraph_utils:reachable([LocalFun], FunDeps)
end, LocalFuns),
lists:flatmap(
fun(V) ->
case digraph:vertex(FunDeps, V) of
false ->
[];
{V, Form} when is_list(Form) ->
Form;
{V, Form} ->
case erl_syntax:is_form(Form) of
true -> [Form];
false -> []
end
end
end, lists:usort(AllLocalFuns)).
make_records({Tags, TypesDict, RecDict}, TaggedElems, PredefRecords, FunDict, Opts) ->
{Strings, _} =
lists:foldl(
fun(Tag, {Res, Seen}) ->
RefElem = get_elem_by_ref(Tag, TaggedElems),
Result = RefElem#elem.result,
case term_is_record(Result) of
true ->
RecName = element(1, Result),
case dict:is_key(RecName, PredefRecords) of
true ->
{Res, Seen};
false ->
case lists:member(RecName, Seen) of
false ->
{[record_to_string(
RefElem, RecDict,
TypesDict, FunDict, Opts)|Res],
[RecName|Seen]};
true ->
{Res, Seen}
end
end;
false ->
{Res, Seen}
end
end, {[], []}, Tags),
lists:reverse(Strings).
make_typespecs(_ModName, {_Tags, _TypesDict, RecDict}, Opts) ->
case proplists:get_value(add_type_specs, Opts) of
TypeName when is_atom(TypeName), TypeName /= undefined ->
case [[atom_to_string(R), "()"]
|| {record, R} <- dict_keys(RecDict)] of
[] ->
[];
Records ->
Prefix = "-type " ++ atom_to_string(TypeName) ++ "() :: ",
Sep = " |" ++ io_lib:nl()
++ lists:duplicate(length(Prefix), $ ),
[Prefix, string:join(Records, Sep), $.]
end;
_ ->
[]
end.
atom_to_string(Atom) ->
erl_syntax:atom_literal(abstract(Atom)).
-define(is_raw_type(T),
element(1, T) == type orelse
element(1, T) == remote_type).
record_to_string(#elem{result = Result} = Elem, RecDict, RecTypes, FunTypes, Opts) ->
[RecName|RecLabels] = tuple_to_list(Result),
Prefix = "-record(" ++ atom_to_string(RecName) ++ ", {",
Sep = "," ++ io_lib:nl() ++ lists:duplicate(length(Prefix), $ ),
Fs = lists:map(
fun(Label) ->
FName = label_to_record_field(Label),
case get_label_type(Label, Elem, RecTypes, FunTypes, Opts) of
{FType, undefined, true} when ?is_raw_type(FType) ->
[atom_to_string(FName), " :: ",
erl_types:t_form_to_string(FType)];
{FType, undefined, false} when ?is_raw_type(FType) ->
[atom_to_string(FName), " :: ",
"undefined | ", erl_types:t_form_to_string(FType)];
{FType, Default, _} when ?is_raw_type(FType) ->
[atom_to_string(FName), " = ",
io_lib:fwrite("~w", [Default]),
" :: ", erl_types:t_form_to_string(FType)];
{FType, undefined, true} ->
FType1 = erl_types:t_subtract(
FType, erl_types:t_atom(undefined)),
[atom_to_string(FName), " :: ",
erl_types:t_to_string(FType1, RecDict)];
{FType, undefined, false} ->
FType1 = erl_types:t_sup(
FType, erl_types:t_atom(undefined)),
[atom_to_string(FName), " :: ",
erl_types:t_to_string(FType1, RecDict)];
{FType, Default, _} ->
Type = erl_types:t_sup(
[erl_types:t_from_term(Default),
FType]),
[atom_to_string(FName), " = ",
io_lib:fwrite("~w", [Default]),
" :: ",
erl_types:t_to_string(Type, RecDict)]
end
end, RecLabels),
RecordStr = [Prefix, string:join(Fs, Sep), "})."],
case proplists:get_value(add_type_specs, Opts) of
TypeName when is_atom(TypeName), TypeName /= undefined ->
[RecordStr, io_lib:nl(),
"-type ", atom_to_string(RecName), "() :: ",
"#", atom_to_string(RecName), "{}."];
_ ->
RecordStr
end.
header(FileName) ->
erl_syntax:comment(
0,
["% Created automatically by XML generator (fxml_gen.erl)",
"% Source: " ++ FileName]).
make_registrar(ModName) ->
ResolverMod = resolver_mod(ModName),
[make_function(register_module, [?AST(Mod)],
[?AST(register_module(Mod, '?a(ResolverMod)'))]),
make_function(unregister_module, [?AST(Mod)],
[?AST(unregister_module(Mod, '?a(ResolverMod)'))])].
make_resolver(TaggedSpecs, ModName) ->
ResolverMod = resolver_mod(ModName),
TagNSMods = lists:foldl(
fun({_, #elem{xmlns = XMLNS, name = Name, module = Mod}}, Acc)
when is_list(XMLNS) ->
lists:foldl(
fun(NS, D) ->
dict:store({Name, NS}, Mod, D)
end, Acc, XMLNS);
({_, #elem{xmlns = XMLNS, name = Name, module = Mod}}, Acc) ->
dict:store({Name, XMLNS}, Mod, Acc)
end, dict:new(), TaggedSpecs),
RecordMods = lists:foldl(
fun({_, #elem{result = Result, module = Mod}}, Acc) ->
case term_is_record(Result) of
true ->
Key = {element(1, Result), tuple_size(Result)},
dict:append(Key, Mod, Acc);
false ->
Acc
end
end, dict:new(), TaggedSpecs),
NilClause1 = erl_syntax:clause([?AST(Name), ?AST(XMLNS)], none,
[?AST('?a(ResolverMod)':lookup(Name, XMLNS))]),
Clauses1 = dict:fold(
fun({Name, NS}, Mod, Acc) ->
[erl_syntax:clause(
[?AST('?a(Name)'), ?AST('?a(NS)')],
none,
[?AST('?a(Mod)')])|Acc]
end, [NilClause1], TagNSMods),
NilClause2 = erl_syntax:clause([?AST(Record)], none,
[?AST('?a(ResolverMod)':lookup(Record))]),
Clauses2 = dict:fold(
fun({RecName, RecSize}, [Mod|_], Acc) ->
[erl_syntax:clause(
[erl_syntax:tuple(
[erl_syntax:atom(RecName)|
[?AST(_) || _ <- lists:seq(1, RecSize-1)]])],
none,
[erl_syntax:atom(Mod)])|Acc]
end, [NilClause2], RecordMods),
[erl_syntax:function(?AST(get_mod), Clauses1),
erl_syntax:function(?AST(get_mod), Clauses2)].
make_top_decoders(_TaggedSpecs, ModName) ->
C0 = ?AST(XMLNS = get_attr(<<"xmlns">>, Attrs, TopXMLNS)),
C1 = erl_syntax:case_expr(
?AST(get_mod(Name, XMLNS)),
[erl_syntax:clause(
[?AST(undefined)],
?AST(XMLNS == <<>>),
[?AST(erlang:error(
{'?a(ModName)', {missing_tag_xmlns, Name}}))]),
erl_syntax:clause(
[?AST(undefined)],
none,
[?AST(erlang:error(
{'?a(ModName)', {unknown_tag, Name, XMLNS}}))]),
erl_syntax:clause(
[?AST(Mod)],
none,
[?AST(Mod:do_decode(Name, XMLNS, El, Opts))])]),
[make_function("decode", [?AST(El)], [?AST(decode(El, <<>>, []))]),
make_function("decode", [?AST(El), ?AST(Opts)], [?AST(decode(El, <<>>, Opts))]),
make_function(
"decode",
[?AST({xmlel, Name, Attrs, _} = El), ?AST(TopXMLNS), ?AST(Opts)],
[C0, C1])].
make_decoders(TaggedSpecs1, ParentMod, ModName) ->
TaggedSpecs = lists:flatmap(
fun({Tag, #elem{xmlns = XMLNSs, module = Mod} = E})
when Mod == ModName ->
if is_list(XMLNSs) ->
[{Tag, E#elem{xmlns = XMLNS}} || XMLNS <- XMLNSs];
true ->
[{Tag, E}]
end;
(_) ->
[]
end, TaggedSpecs1),
NilClause = [erl_syntax:clause(
[?AST(Name), ?AST(<<>>), ?AST(_), ?AST(_)],
none,
[?AST(erlang:error(
{'?a(ParentMod)', {missing_tag_xmlns, Name}}))]),
erl_syntax:clause(
[?AST(Name), ?AST(XMLNS), ?AST(_), ?AST(_)],
none,
[?AST(erlang:error(
{'?a(ParentMod)', {unknown_tag, Name, XMLNS}}))])],
Clauses = lists:map(
fun({Tag, #elem{xmlns = XMLNS, name = Name}}) ->
erl_syntax:clause(
[?AST('?a(Name)'), ?AST('?a(XMLNS)'), ?AST(El), ?AST(Opts)],
none,
[make_function_call(
make_dec_fun_name([Tag]),
[abstract(XMLNS),
?AST(Opts),
?AST(El)])])
end, TaggedSpecs),
[erl_syntax:function(erl_syntax:atom(do_decode), Clauses ++ NilClause),
make_function(tags, [],
[erl_syntax:list(
lists:map(
fun({_, #elem{name = Name, xmlns = NS}}) ->
?AST({'?a(Name)', '?a(NS)'})
end, TaggedSpecs))])].
make_top_encoders(_TaggedSpecs, _ModName) ->
Clause1 = erl_syntax:clause(
[?AST({xmlel, _, _, _} = El), ?AST(_)],
none,
[?AST(El)]),
GetNameCase = [?AST(Mod = get_mod(El)),
?AST(Mod:do_get_name(El))],
GetNSCase = [?AST(Mod = get_mod(El)),
?AST(Mod:do_get_ns(El))],
KnownTagCase = [?AST(XMLNS = get_attr(<<"xmlns">>, Attrs, TopXMLNS)),
?AST(get_mod(Name, XMLNS) /= undefined)],
Clause2 = erl_syntax:clause(
[?AST(El), ?AST(TopXMLNS)],
none,
[?AST(Mod = get_mod(El)),
?AST(Mod:do_encode(El, TopXMLNS))]),
[make_function(encode, [?AST(El)], [?AST(encode(El, <<>>))]),
erl_syntax:function(?AST(encode), [Clause1, Clause2]),
make_function(get_name, [?AST(El)], GetNameCase),
make_function(get_ns, [?AST(El)], GetNSCase),
make_function(is_known_tag,
[?AST({xmlel, Name, Attrs, _}), ?AST(TopXMLNS)],
KnownTagCase),
make_function(get_els, [?AST(Term)],
[?AST(Mod = get_mod(Term)),
?AST(Mod:get_els(Term))]),
make_function(set_els, [?AST(Term), ?AST(Els)],
[?AST(Mod = get_mod(Term)),
?AST(Mod:set_els(Term, Els))])].
make_encoders(TaggedSpecs, ModName) ->
{RecNames, ResNames} =
lists:foldl(
fun({Tag, #elem{result = Result, module = Mod}}, {RecAcc, ResAcc})
when Mod == ModName ->
try
[H|_]= tuple_to_list(Result),
true = is_atom(H),
false = is_label(H),
{dict:append(H, Tag, RecAcc),
dict:append(H, Result, ResAcc)}
catch _:_ ->
{RecAcc, ResAcc}
end;
(_, Acc) ->
Acc
end, {dict:new(), dict:new()}, TaggedSpecs),
{EncClauses, NSClauses, TagClauses, _} =
lists:foldl(
fun({Tag, #elem{name = Name, xmlns = XMLNS, module = Mod,
result = Result, attrs = Attrs}},
{EncAcc, NSAcc, TagAcc, Seen}) ->
XMLNSLabel = case lists:keyfind(<<"xmlns">>, #attr.name, Attrs) of
#attr{label = L, name = N} ->
prepare_label(L, N);
_ ->
undefined
end,
Var = label_to_var(prepare_label(undefined, Name)),
HasXMLNSAttr = XMLNSLabel /= undefined,
EncodeResult = if HasXMLNSAttr and not is_list(XMLNS) ->
labels_to_underscores(
Result, [], [{XMLNSLabel, XMLNS}]);
true ->
labels_to_underscores(Result)
end,
EncodeResultAux = labels_to_underscores(
Result, [], [{XMLNSLabel, <<>>}]),
NSResult = labels_to_underscores(Result, [XMLNSLabel]),
TagResult = labels_to_underscores(Result),
try
[H|_]= tuple_to_list(Result),
true = is_atom(H),
false = is_label(H),
Tags = dict:fetch(H, RecNames),
OtherResults = dict:fetch(H, ResNames) -- [Result],
true = lists:member(Tag, Tags),
IsDuplicated = lists:member(Result, OtherResults),
AlreadySeen = lists:member(Result, Seen),
{if AlreadySeen ->
EncAcc;
true ->
Call = [make_function_call(
make_enc_fun_name(ModName, Mod, [Tag]),
[Var, ?AST(TopXMLNS)])],
[erl_syntax:clause(
[?AST('?EncodeResult' = '?Var'), ?AST(TopXMLNS)],
none, Call)] ++
if HasXMLNSAttr and not is_list(XMLNS) ->
[erl_syntax:clause(
[?AST('?EncodeResultAux' = '?Var'),
?AST(TopXMLNS = '?a(XMLNS)')],
none, Call)];
true ->
[]
end ++ EncAcc
end,
if IsDuplicated ->
NSAcc;
HasXMLNSAttr ->
[erl_syntax:clause(
[NSResult], none,
[label_to_var(XMLNSLabel)])|NSAcc];
is_list(XMLNS) ->
[erl_syntax:clause(
[NSResult], none,
[abstract(hd(XMLNS))])|NSAcc];
true ->
[erl_syntax:clause(
[NSResult], none,
[abstract(XMLNS)])|NSAcc]
end,
if AlreadySeen ->
TagAcc;
true ->
[erl_syntax:clause(
[TagResult], none,
[abstract(Name)])|TagAcc]
end,
[Result|Seen]}
catch _:_ ->
{EncAcc, NSAcc, TagAcc, Seen}
end
end, {[], [], [], []}, TaggedSpecs),
if EncClauses /= [] ->
[erl_syntax:function(?AST(do_encode), EncClauses)];
true -> []
end ++
if TagClauses /= [] ->
[erl_syntax:function(?AST(do_get_name), lists:usort(TagClauses))];
true -> []
end ++
if NSClauses /= [] ->
[erl_syntax:function(?AST(do_get_ns), lists:usort(NSClauses))];
true -> []
end.
make_printer(TaggedSpecs, PredefRecords, ModName, ParentMod) ->
PassClause1 =
if ModName == ParentMod ->
[erl_syntax:clause(
[?AST(xmlel), ?AST(3)],
none,
[?AST([name, attrs, children])]),
erl_syntax:clause(
[?AST(Name), ?AST(Arity)],
none,
[erl_syntax:case_expr(
?AST(get_mod(
erlang:make_tuple(Arity+1, undefined, [{1, Name}]))),
[erl_syntax:clause(
[?AST(undefined)], none, [?AST(no)]),
erl_syntax:clause(
[?AST(Mod)],
none,
[?AST(Mod:pp(Name, Arity))])])])];
true ->
[erl_syntax:clause([?AST(_), ?AST(_)], none, [?AST(no)])]
end,
%% Exclude tags with duplicated results
RecNames = lists:foldl(
fun({Tag, #elem{result = Result, module = Mod}}, Acc)
when Mod == ModName ->
try
[H|_]= tuple_to_list(Result),
true = is_atom(H),
false = is_label(H),
dict:append(H, Tag, Acc)
catch _:_ ->
Acc
end;
(_, Acc) ->
Acc
end, dict:new(), TaggedSpecs),
{Clauses1, Records} =
lists:foldl(
fun({Tag, #elem{result = Result}}, {Acc1, Acc2}) ->
try
[H|T]= tuple_to_list(Result),
true = is_atom(H),
false = is_label(H),
[Tag|_] = dict:fetch(H, RecNames),
Fields = case dict:find(H, PredefRecords) of
{ok, Fs} ->
[FName || {FName, _} <- Fs];
error ->
[label_to_record_field(F) || F <- T]
end,
{[erl_syntax:clause(
[erl_syntax:atom(H), abstract(length(T))],
none,
[erl_syntax:list(
[erl_syntax:atom(F) || F <- Fields])])
|Acc1],
[{H, length(T)}|Acc2]}
catch _:_ ->
{Acc1, Acc2}
end
end, {[], []}, TaggedSpecs),
[erl_syntax:function(?AST(pp), Clauses1 ++ PassClause1),
make_function(records, [],
[erl_syntax:list(
lists:map(
fun({RecName, RecSize}) ->
?AST({'?a(RecName)', '?a(RecSize)'})
end, Records))])].
make_getters_setters(TaggedSpecs, PredefRecords, ModName) ->
RecNames = lists:foldl(
fun({Tag, #elem{result = Result, module = Mod}}, Acc)
when Mod == ModName ->
try
[H|_]= tuple_to_list(Result),
true = is_atom(H),
false = is_label(H),
dict:append(H, Tag, Acc)
catch _:_ ->
Acc
end;
(_, Acc) ->
Acc
end, dict:new(), TaggedSpecs),
{Getters, Setters} =
lists:foldl(
fun({Tag, #elem{result = Result}}, {Acc1, Acc2}) ->
try
[H|T]= tuple_to_list(Result),
true = is_atom(H),
false = is_label(H),
[Tag|_] = dict:fetch(H, RecNames),
Fields = case dict:find(H, PredefRecords) of
{ok, Fs} ->
[FName || {FName, _} <- Fs];
error ->
[label_to_record_field(F) || F <- T]
end,
case lists:member(sub_els, Fields) of
false ->
{Acc1, Acc2};
true ->
{[erl_syntax:clause(
[record_fields_to_vars(H, Fields)],
none,
[?AST(_sub_els)])|Acc1],
[erl_syntax:clause(
[record_fields_to_vars(H, Fields, [{sub_els, ?AST(_)}]),
?AST(_sub_els)],
none,
[record_fields_to_vars(
H, Fields, [{sub_els, ?AST(_sub_els)}])])|Acc2]}
end
catch _:_ ->
{Acc1, Acc2}
end
end, {[], []}, TaggedSpecs),
case {Getters, Setters} of
{[], []} ->
[];
_ ->
[erl_syntax:function(?AST(get_els), Getters),
erl_syntax:function(?AST(set_els), Setters)]
end.
elem_to_AST(#elem{name = Name, xmlns = XMLNS, cdata = CData,
result = Result, attrs = Attrs, refs = _Refs} = Elem,
Tag, AllElems, Types, ModName, PredefRecords, Opts) ->
AttrAST = lists:flatmap(
fun(#attr{name = AttrName,
required = Required,
dec = AttrDecF,
enc = AttrEncF,
default = AttrDefault}) ->
make_decoding_MFA([AttrName,attr,Tag],
Name, XMLNS, AttrName,
Required, AttrDefault,
AttrDecF, Types, ModName) ++
make_encoding_MFA([AttrName,attr,Tag],
AttrName, Required, AttrDefault,
AttrEncF)
end, Attrs),
#cdata{label = CDataLabl,
required = CDataRequired,
dec = CDataDecF,
enc = CDataEncF,
default = CDataDefault} = CData,
CDataAST =
case have_label(Result, CDataLabl) of
true ->
make_decoding_MFA([cdata,Tag], Name, XMLNS, <<>>,
CDataRequired, CDataDefault,
CDataDecF, Types, ModName) ++
make_encoding_MFA([cdata,Tag], <<>>,
CDataRequired, CDataDefault,
CDataEncF);
false ->
[]
end,
DecAST = make_elem_dec_fun(Elem, Tag, AllElems, Types,
ModName, PredefRecords, Opts),
EncAST = make_elem_enc_fun(Elem, Tag, AllElems, ModName),
DecAST ++ EncAST ++ AttrAST ++ CDataAST.
%% Replace in `Term' every label found in `Labels'
%% with the corresponding value.
subst_labels(Term) ->
subst_labels(Term, undefined).
subst_labels(Term, PredefRecords) ->
case have_label(Term, '$_') of
true when PredefRecords /= undefined ->
try
true = term_is_record(Term),
[H|Elems] = erl_syntax:tuple_elements(abstract(Term)),
RecName = erl_syntax:atom_value(H),
RecFields = dict:fetch(RecName, PredefRecords),
Vars = lists:map(
fun({T, {_, Default}}) ->
AbsDefault = if Default == none ->
?AST(undefined);
true ->
Default
end,
try
Label = erl_syntax:atom_value(T),
true = is_label(Label),
case Label of
'$_' -> AbsDefault;
_ -> label_to_var(Label)
end
catch _:_ ->
T
end
end, lists:zip(Elems, RecFields)),
erl_syntax:tuple([H|Vars])
catch error:{badmatch, false} ->
bad_spec({underscore_label_outside_record_tuple, Term});
_:_ ->
bad_spec({no_predefined_record_found, Term})
end;
_ ->
erl_syntax_lib:map(
fun(T) ->
try
Label = erl_syntax:atom_value(T),
true = is_label(Label),
label_to_var(Label)
catch _:_ ->
T
end
end, abstract(Term))
end.
get_elem_by_ref(RefName, TaggedElems) ->
{_, Elem} = lists:keyfind(RefName, 1, TaggedElems),
Elem.
get_spec_by_label('$_els', _Elem) ->
sub_els;
get_spec_by_label('$_xmls', _Elem) ->
xml_els;
get_spec_by_label('$_', _Elem) ->
'_';
get_spec_by_label(Label, Elem) ->
[Spec|T] = lists:flatmap(
fun(#cdata{label = L} = CData) when Label == L ->
[CData];
(#attr{label = L, name = N} = Attr) ->
case prepare_label(L, N) of
Label ->
[Attr];
_ ->
[]
end;
(#ref{label = L, name = N} = Ref) ->
case prepare_label(L, N) of
Label ->
[Ref];
_ ->
[]
end;
(_) ->
[]
end, [Elem#elem.cdata|Elem#elem.attrs ++ Elem#elem.refs]),
if is_record(Spec, ref) ->
[Spec|T];
true ->
Spec
end.
group_refs(Refs) ->
dict:to_list(
lists:foldl(
fun(#ref{name = Name, label = Label} = Ref, G) ->
L = prepare_label(Label, Name),
dict:append_list(L, [Ref], G)
end, dict:new(), Refs)).
make_elem_dec_fun(#elem{name = Name, result = Result, refs = Refs, module = Mod,
cdata = CData, attrs = Attrs, xmlns = XMLNS},
Tag, AllElems, Types, ModName, PredefRecords, Opts) ->
FunName = make_dec_fun_name([Tag]),
ResultWithVars = subst_labels(Result, PredefRecords),
AttrVars = lists:map(
fun(#attr{name = AttrName, label = AttrLabel}) ->
label_to_var(prepare_label(AttrLabel, AttrName))
end, Attrs),
HaveCData = have_label(Result, CData#cdata.label),
CDataVars = if HaveCData ->
[label_to_var(CData#cdata.label)];
true ->
[]
end,
SubElVars = case have_label(Result, '$_els') of
true ->
[label_to_var('$_els')];
false ->
[]
end,
XmlElVars = case have_label(Result, '$_xmls') of
true ->
[label_to_var('$_xmls')];
false ->
[]
end,
ElemVars = lists:map(
fun({Label, _}) ->
label_to_var(Label)
end, group_refs(Refs)),
AttrMatch =
if AttrVars /= [] ->
AttrPattern = tuple_or_single_var(AttrVars),
AttrCall = make_function_call(
FunName ++ "_attrs",
[?AST(__TopXMLNS),
?AST(_attrs)|
lists:map(
fun(_) ->
?AST(undefined)
end, Attrs)]),
[erl_syntax:match_expr(AttrPattern, AttrCall)];
true ->
[]
end,
ElCDataMatch =
case CDataVars ++ ElemVars ++ SubElVars ++ XmlElVars of
[] ->
[];
_ ->
[erl_syntax:match_expr(
tuple_or_single_var(CDataVars ++ ElemVars ++ SubElVars ++ XmlElVars),
make_function_call(
FunName ++ "_els",
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|
lists:flatmap(
fun({_, [#ref{min = 0, max = 1, default = Def}|_]}) ->
[abstract(Def)];
({_, [#ref{min = 1, max = 1}|_]}) ->
[?AST(error)];
(#cdata{}) when HaveCData ->
[?AST(<<>>)];
(#cdata{}) ->
[];
(_) ->
[?AST([])]
end, [CData|group_refs(Refs)] ++ SubElVars ++ XmlElVars)]))]
end,
[make_function(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST({xmlel, '?a(Name)', _attrs, _els})],
ElCDataMatch ++ AttrMatch ++ [ResultWithVars])]
++ make_els_dec_fun(Mod, FunName ++ "_els", CData, HaveCData, SubElVars,
XmlElVars, Refs, Tag, XMLNS, AllElems,
Result, Types, ModName, Opts)
++ make_attrs_dec_fun(FunName ++ "_attrs", Attrs, Tag).
make_els_dec_clause(ParentMod, ModName, FunName, CDataVars, Refs, _TopXMLNS,
AllElems, Result, {_SortedTags, Types, _RecDict}, _Opts) ->
SubElVars = case have_label(Result, '$_els') of
true ->
[label_to_var('$_els')];
false ->
[]
end,
XmlElVars = case have_label(Result, '$_xmls') of
true ->
[label_to_var('$_xmls')];
false ->
[]
end,
lists:map(
fun(#ref{name = RefName, label = RefLabel}) ->
Label = prepare_label(RefLabel, RefName),
Var = label_to_var(Label),
RefElem = get_elem_by_ref(RefName, AllElems),
RefMod = RefElem#elem.module,
XMLNSs = lists:flatten([RefElem#elem.xmlns]),
ElemVars = lists:map(
fun({Labl, _}) ->
label_to_var(Labl)
end, group_refs(Refs)),
NewElemVars =
fun(NS) ->
lists:map(
fun({L, [#ref{min = Min, max = 1}|_]})
when L == Label ->
Call = make_function_call(
make_dec_fun_name(ModName, RefMod, [RefName]),
[NS,
?AST(__Opts),
?AST(_el)]),
if Min == 0 ->
Call;
Min == 1 ->
?AST({value, '?Call'})
end;
({L, [#ref{default = Def}]}) when L == Label ->
RefType = dict:fetch(RefName, Types),
case is_subtype(Def, RefType) of
true ->
erl_syntax:case_expr(
make_function_call(
make_dec_fun_name(ModName, RefMod, [RefName]),
[NS,
?AST(__Opts),
?AST(_el)]),
[erl_syntax:clause(
[abstract(Def)], none, [Var]),
erl_syntax:clause(
[?AST(_new_el)],
none,
[?AST([_new_el | '?Var'])])]);
false ->
erl_syntax:list(
[make_function_call(
make_dec_fun_name(ModName, RefMod, [RefName]),
[NS,
?AST(__Opts),
?AST(_el)])],
Var)
end;
({L, _}) ->
label_to_var(L)
end, group_refs(Refs))
end,
erl_syntax:clause(
[?AST(__TopXMLNS),
?AST(__Opts),
?AST([{xmlel, '?a(RefElem#elem.name)', _attrs, _} = _el | _els])|
CDataVars ++ ElemVars ++ SubElVars ++ XmlElVars],
none,
[erl_syntax:case_expr(
?AST('?a(ParentMod)':get_attr(<<"xmlns">>, _attrs, __TopXMLNS)),
lists:map(
fun(NS) ->
erl_syntax:clause(
[abstract(NS)],
none,
[make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|CDataVars ++ NewElemVars(abstract(NS))
++ SubElVars ++ XmlElVars])])
end, XMLNSs)
++
[erl_syntax:clause(
[?AST(_)], none,
[make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|CDataVars ++ ElemVars
++ SubElVars ++ XmlElVars])])])])
end, Refs).
make_els_dec_fun(_, _FunName, _CData, false, [], [], [], _Tag,
_TopXMLNS, _AllElems, _Result, _Types, _ModName, _Opts) ->
[];
make_els_dec_fun(Mod, FunName, CData, HaveCData, SubElVars, XmlElVars, Refs, Tag,
TopXMLNS, AllElems, Result, Types, ModName, Opts) ->
CDataVars = if HaveCData ->
[label_to_var(CData#cdata.label)];
true ->
[]
end,
ElemVars = lists:map(
fun({Label, _}) ->
label_to_var(Label)
end, group_refs(Refs)),
ResultCData = if HaveCData ->
[erl_syntax:binary(
[erl_syntax:binary_field(
hd(CDataVars),
[?AST(binary)]),
erl_syntax:binary_field(
?AST(_data),
[?AST(binary)])])];
true ->
[]
end,
CDataClause = if HaveCData ->
[erl_syntax:clause(
[?AST(__TopXMLNS),
?AST(__Opts),
erl_syntax:list(
[?AST({xmlcdata, _data})],
?AST(_els))
|CDataVars ++ ElemVars ++ SubElVars ++ XmlElVars],
none,
[make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|
ResultCData ++ ElemVars ++ SubElVars ++ XmlElVars])])];
true ->
[]
end,
ElemClauses = make_els_dec_clause(ModName, Mod, FunName, CDataVars,
Refs, TopXMLNS, AllElems, Result,
Types, Opts),
ResultElems = lists:map(
fun({L, [#ref{min = 0, max = 1}|_]}) ->
label_to_var(L);
({L, [#ref{min = 1, max = 1, name = RefName}]}) ->
RefElem = get_elem_by_ref(RefName, AllElems),
L1 = list_to_atom(atom_to_list(L) ++ "1"),
erl_syntax:case_expr(
label_to_var(L),
[erl_syntax:clause(
[?AST(error)],
none,
[?AST(erlang:error(
{'?a(ModName)',
{missing_tag,
'?a(RefElem#elem.name)',
__TopXMLNS}}))]),
erl_syntax:clause(
[erl_syntax:tuple(
[?AST(value),
label_to_var(L1)])],
none,
[label_to_var(L1)])]);
({L, [#ref{min = 0, max = infinity}|_]}) ->
make_function_call(
{lists, reverse}, [label_to_var(L)])
end, group_refs(Refs)),
CDataCall = if HaveCData ->
[make_function_call(
make_dec_fun_name([cdata,Tag]),
[?AST(__TopXMLNS)|CDataVars])];
true ->
[]
end,
SubElResult = case have_label(Result, '$_els') of
true ->
[make_function_call(
{lists, reverse},
[label_to_var('$_els')])];
false ->
[]
end,
XmlElResult = case have_label(Result, '$_xmls') of
true ->
[make_function_call(
{lists, reverse},
[label_to_var('$_xmls')])];
false ->
[]
end,
NilClause = erl_syntax:clause(
[?AST(__TopXMLNS),
?AST(__Opts),
?AST([])|
CDataVars ++
lists:map(
fun({L, _}) ->
label_to_var(L)
end, group_refs(Refs)) ++ SubElVars ++ XmlElVars],
none,
[tuple_or_single_var(
CDataCall ++ ResultElems ++ SubElResult ++ XmlElResult)]),
SubElPattern = [?AST(__TopXMLNS),
?AST(__Opts),
erl_syntax:list(
[?AST({xmlel, _name, _attrs, _} = _el)],
?AST(_els))
|CDataVars ++ ElemVars ++ SubElVars ++ XmlElVars],
SubElClause =
case {have_label(Result, '$_els'),
have_label(Result, '$_xmls')} of
{true, false} ->
SubElBody = erl_syntax:case_expr(
?AST(proplists:get_bool(ignore_els, __Opts)),
[erl_syntax:clause(
[?AST(true)],
none,
[make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|CDataVars ++ ElemVars] ++
[erl_syntax:list(
[?AST(_el)],
label_to_var('$_els'))])]),
erl_syntax:clause(
[?AST(false)],
none,
[?AST(__XMLNS = '?a(ModName)':get_attr(
<<"xmlns">>, _attrs, __TopXMLNS)),
erl_syntax:case_expr(
?AST('?a(ModName)':get_mod(_name, __XMLNS)),
[erl_syntax:clause(
[?AST(undefined)],
none,
[make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|CDataVars ++ ElemVars] ++
[label_to_var('$_els')])]),
erl_syntax:clause(
[?AST(Mod)],
none,
[make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|CDataVars ++ ElemVars] ++
[erl_syntax:list(
[?AST(Mod:do_decode(_name, __XMLNS, _el, __Opts))],
label_to_var('$_els'))])])])])]),
[erl_syntax:clause(SubElPattern, none, [SubElBody])];
{false, true} ->
SubElBody = make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|CDataVars ++ ElemVars] ++
[erl_syntax:list(
[?AST(_el)],
label_to_var('$_xmls'))]),
[erl_syntax:clause(SubElPattern, none, [SubElBody])];
{true, true} ->
SubElBody = erl_syntax:case_expr(
?AST(proplists:get_bool(ignore_els, __Opts)),
[erl_syntax:clause(
[?AST(true)],
none,
[make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|CDataVars ++ ElemVars] ++
[label_to_var('$_els')] ++
[erl_syntax:list(
[?AST(_el)],
label_to_var('$_xmls'))])]),
erl_syntax:clause(
[?AST(false)],
none,
[?AST(__XMLNS = '?a(ModName)':get_attr(
<<"xmlns">>, _attrs, __TopXMLNS)),
erl_syntax:case_expr(
?AST('?a(ModName)':get_mod(_name, __XMLNS)),
[erl_syntax:clause(
[?AST(undefined)],
none,
[make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|CDataVars ++ ElemVars] ++
[label_to_var('$_els')] ++
[erl_syntax:list(
[?AST(_el)],
label_to_var('$_xmls'))])]),
erl_syntax:clause(
[?AST(Mod)],
none,
[make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts),
?AST(_els)|CDataVars ++ ElemVars] ++
[erl_syntax:list(
[?AST(Mod:do_decode(_name, __XMLNS, _el, __Opts))],
label_to_var('$_els'))]
++ [label_to_var('$_xmls')])])])])]),
[erl_syntax:clause(SubElPattern, none, [SubElBody])];
{false, false} ->
[]
end,
PassClause = if SubElVars == []; CDataVars == [] ->
[erl_syntax:clause(
[?AST(__TopXMLNS),
?AST(__Opts),
?AST([_ | _els])|
CDataVars ++ ElemVars ++ SubElVars ++ XmlElVars],
none,
[make_function_call(
FunName,
[?AST(__TopXMLNS),
?AST(__Opts), ?AST(_els)
|CDataVars ++ ElemVars ++ SubElVars ++ XmlElVars])])];
true ->
[]
end,
[erl_syntax:function(
erl_syntax:atom(FunName),
[NilClause|CDataClause ++ ElemClauses ++ SubElClause ++ PassClause])].
make_attrs_dec_fun(FunName, Attrs, Tag) ->
AttrVars = lists:map(
fun(#attr{name = AttrName, label = AttrLabel}) ->
label_to_var(prepare_label(AttrLabel, AttrName))
end, Attrs),
Clauses =
lists:map(
fun(#attr{name = Name, label = Label}) ->
Var = label_to_var(prepare_label(Label, Name)),
Pattern = [?AST(__TopXMLNS),
?AST([{'?a(Name)', _val} | _attrs]) |
lists:map(
fun(V) when V == Var ->
VName = erl_syntax:variable_literal(V),
erl_syntax:variable("_" ++ VName);
(V) ->
V
end, AttrVars)],
Body = [make_function_call(
FunName,
[?AST(__TopXMLNS), ?AST(_attrs) |
lists:map(
fun(V) when V == Var ->
?AST(_val);
(V) ->
V
end, AttrVars)])],
erl_syntax:clause(Pattern, none, Body)
end, Attrs),
if Clauses /= [] ->
PassClause = erl_syntax:clause(
[?AST(__TopXMLNS), ?AST([_|_attrs])|AttrVars],
none,
[make_function_call(
FunName,
[?AST(__TopXMLNS), ?AST(_attrs)|AttrVars])]),
Result = lists:map(
fun(#attr{name = Name, label = Label}) ->
Var = label_to_var(prepare_label(Label, Name)),
make_function_call(
make_dec_fun_name([Name,attr,Tag]),
[?AST(__TopXMLNS), Var])
end, Attrs),
NilClause = erl_syntax:clause(
[?AST(__TopXMLNS), ?AST([])|AttrVars],
none,
[tuple_or_single_var(Result)]),
[erl_syntax:function(
erl_syntax:atom(FunName),
Clauses ++ [PassClause, NilClause])];
true ->
[]
end.
make_ref_enc_funs(Elem, Tag, AllElems) ->
ModName = Elem#elem.module,
lists:map(
fun({L, [#ref{min = Min, max = Max, default = Default}|_] = Refs}) ->
DefaultClause = if Min == 0, Max == 1 ->
[erl_syntax:clause(
[abstract(Default), ?AST(__TopXMLNS),
?AST(_acc)],
none, [?AST(_acc)])];
Min == 1, Max == 1 ->
[];
true ->
[erl_syntax:clause(
[?AST([]), ?AST(__TopXMLNS), ?AST(_acc)],
none, [?AST(_acc)])]
end,
Var = label_to_var(L),
Clauses =
lists:map(
fun(#ref{name = RefName, max = 1}) ->
RefElem = get_elem_by_ref(RefName, AllElems),
RefMod = RefElem#elem.module,
Pattern =
if length(Refs) > 1 ->
MatchVar = erl_syntax:match_expr(
labels_to_underscores(
RefElem#elem.result),
Var),
[MatchVar, ?AST(__TopXMLNS), ?AST(_acc)];
true ->
[Var, ?AST(__TopXMLNS), ?AST(_acc)]
end,
erl_syntax:clause(
Pattern,
none,
[erl_syntax:list(
[make_function_call(
make_enc_fun_name(ModName, RefMod, [RefName]),
[Var, ?AST(__TopXMLNS)])],
?AST(_acc))]);
(#ref{name = RefName}) ->
RefElem = get_elem_by_ref(RefName, AllElems),
RefMod = RefElem#elem.module,
Pattern =
if length(Refs) > 1 ->
erl_syntax:match_expr(
labels_to_underscores(
RefElem#elem.result),
Var);
true ->
Var
end,
erl_syntax:clause(
[?AST(['?Pattern' | _els]), ?AST(__TopXMLNS), ?AST(_acc)],
none,
[make_function_call(
make_enc_fun_name([L,Tag]),
[?AST(_els),
?AST(__TopXMLNS),
erl_syntax:list(
[make_function_call(
make_enc_fun_name(ModName, RefMod, [RefName]),
[Var, ?AST(__TopXMLNS)])],
?AST(_acc))])])
end, Refs),
erl_syntax:function(
erl_syntax:atom(make_enc_fun_name([L,Tag])),
DefaultClause ++ Clauses)
end, group_refs(Elem#elem.refs)).
make_elem_enc_fun(#elem{result = Result, attrs = Attrs,
name = ElemName, xmlns = XMLNS,
cdata = CData, refs = Refs} = Elem,
Tag, AllElems, ModName) ->
CDataLabel = CData#cdata.label,
HaveCData = have_label(Result, CDataLabel),
HaveRefs = Refs /= [],
HaveXMLs = have_label(Result, '$_xmls'),
HaveEls = have_label(Result, '$_els'),
NewTopXMLNSCall =
make_function_call(
{ModName, choose_top_xmlns},
case lists:keyfind(<<"xmlns">>, #attr.name, Attrs) of
#attr{label = L, name = N} ->
if is_list(XMLNS) ->
[label_to_var(prepare_label(L, N)),
erl_syntax:list([abstract(NS) || NS <- XMLNS])];
true ->
[label_to_var(prepare_label(L, N)),
erl_syntax:list([abstract(XMLNS)])]
end;
false when is_list(XMLNS) ->
[?AST(<<>>), erl_syntax:list([abstract(NS) || NS <- XMLNS])];
false ->
[abstract(XMLNS), ?AST([])]
end ++ [?AST(__TopXMLNS)]),
SubElGenerator = case have_label(Result, '$_els') of
true ->
erl_syntax:list_comp(
?AST('?a(ModName)':encode(_el, __NewTopXMLNS)),
[erl_syntax:generator(
?AST(_el),
label_to_var('$_els'))]);
false ->
?AST([])
end,
XmlElGenerator = case {have_label(Result, '$_xmls'),
have_label(Result, '$_els')} of
{true, true} ->
erl_syntax:infix_expr(
label_to_var('$_xmls'),
erl_syntax:operator("++"),
SubElGenerator);
{true, false} ->
label_to_var('$_xmls');
{false, true} ->
SubElGenerator;
{false, false} ->
?AST([])
end,
RefsFun = lists:foldr(
fun({Label, _}, Acc) ->
Var = label_to_var(Label),
make_function_call(
make_enc_fun_name([Label,Tag]),
[Var, ?AST(__NewTopXMLNS), Acc])
end, ?AST([]), group_refs(Refs)),
CDataFun = if HaveRefs and HaveCData ->
make_function_call(
{lists, reverse},
[make_function_call(make_enc_fun_name([cdata,Tag]),
[label_to_var(CDataLabel),
RefsFun])]);
HaveRefs and not HaveCData ->
?AST(lists:reverse('?RefsFun'));
HaveCData and not HaveRefs ->
make_function_call(make_enc_fun_name([cdata,Tag]),
[label_to_var(CDataLabel),
?AST([])]);
true ->
?AST([])
end,
ResFun = if (HaveCData or HaveRefs) and (HaveXMLs or HaveEls) ->
?AST('?XmlElGenerator' ++ '?CDataFun');
HaveCData or HaveRefs ->
CDataFun;
HaveXMLs or HaveEls ->
XmlElGenerator;
true ->
?AST([])
end,
AttrFun = lists:foldl(
fun(#attr{name = AttrName, label = AttrLabel}, Acc)
when AttrName /= <<"xmlns">> ->
Var = label_to_var(prepare_label(AttrLabel, AttrName)),
make_function_call(
make_enc_fun_name([AttrName,attr,Tag]),
[Var, Acc]);
(_, Acc) ->
Acc
end, ?AST('?a(ModName)':enc_xmlns_attrs(__NewTopXMLNS, __TopXMLNS)), Attrs),
[erl_syntax:function(
erl_syntax:atom(make_enc_fun_name([Tag])),
[erl_syntax:clause(
[subst_labels(Result), ?AST(__TopXMLNS)],
none,
[?AST(__NewTopXMLNS = '?NewTopXMLNSCall'),
?AST(_els = '?ResFun'),
?AST(_attrs = '?AttrFun'),
?AST({xmlel, '?a(ElemName)', _attrs, _els})
])])] ++ make_ref_enc_funs(Elem, Tag, AllElems).
make_decoding_MFA(Parents, TagName, _TagNS, AttrName,
IsRequired, Default, DecMFA, _Types, ModName) ->
FunName = make_dec_fun_name(Parents),
Type = case AttrName of
<<>> -> "cdata";
_ -> "attr"
end,
Clause1 = erl_syntax:clause(
[?AST(__TopXMLNS),
if Type == "attr" -> ?AST(undefined);
true -> ?AST(<<>>) end],
none,
[if IsRequired ->
MissingType = erl_syntax:atom("missing_" ++ Type),
?AST(erlang:error(
{'?a(ModName)', {'?MissingType', '?a(AttrName)',
'?a(TagName)', __TopXMLNS}}));
true ->
abstract(Default)
end]),
Body = case DecMFA of
{M, F, Args} ->
make_function_call(
{M, F},
[?AST(_val)|
[abstract(Arg) || Arg <- Args]]);
{F, Args} ->
make_function_call(
F,
[?AST(_val)|
[abstract(Arg) || Arg <- Args]]);
undefined ->
?AST(_val)
end,
Catch = case DecMFA of
undefined ->
Body;
_ ->
BadVal = erl_syntax:atom("bad_" ++ Type ++ "_value"),
erl_syntax:case_expr(
erl_syntax:catch_expr(Body),
[erl_syntax:clause(
[?AST({'EXIT', _})],
none,
[?AST(erlang:error(
{'?a(ModName)', {'?BadVal', '?a(AttrName)',
'?a(TagName)', __TopXMLNS}}))]),
erl_syntax:clause([?AST(_res)], none, [?AST(_res)])])
end,
Clause2 = erl_syntax:clause(
[?AST(__TopXMLNS),
?AST(_val)], none, [Catch]),
[erl_syntax:function(erl_syntax:atom(FunName), [Clause1, Clause2])].
make_encoding_MFA(_, <<"xmlns">>, _, _, _) ->
[];
make_encoding_MFA(Parents, AttrName, Required, AttrDefault, EncMFA) ->
Clause1 = if Required ->
[];
true ->
[erl_syntax:clause(
[abstract(AttrDefault),
?AST(_acc)],
none,
[?AST(_acc)])]
end,
Body = case EncMFA of
{M, F, Args} ->
make_function_call(
{M, F},
[?AST(_val)|
[abstract(Arg) || Arg <- Args]]);
{F, Args} ->
make_function_call(
F,
[?AST(_val)|
[abstract(Arg) || Arg <- Args]]);
undefined ->
?AST(_val)
end,
Clause2 = [erl_syntax:clause(
[?AST(_val),
?AST(_acc)],
none,
[erl_syntax:list(
[erl_syntax:tuple(
[if AttrName /= <<>> -> abstract(AttrName);
true -> ?AST(xmlcdata)
end, Body])],
?AST(_acc))])],
[erl_syntax:function(
erl_syntax:atom(make_enc_fun_name(Parents)),
Clause1 ++ Clause2)].
make_dec_fun_name(Vars) ->
make_dec_fun_name(undefined, undefined, Vars).
make_dec_fun_name(ParentMod, Mod, Vars) ->
NewVars = lists:foldl(
fun(Var, Acc) when is_binary(Var) ->
[binary_to_list(Var)|Acc];
(Var, Acc) when is_atom(Var) ->
[atom_to_list(Var)|Acc];
(Var, Acc) ->
[Var|Acc]
end, [], Vars),
Fun = "decode_" ++ string:join(NewVars, "_"),
if Mod == undefined -> Fun;
ParentMod == Mod -> Fun;
true -> {Mod, Fun}
end.
make_enc_fun_name(Vars) ->
make_enc_fun_name(undefined, undefined, Vars).
make_enc_fun_name(ParentMod, Mod, Vars) ->
NewVars = lists:foldl(
fun(Var, Acc) when is_binary(Var) ->
[binary_to_list(Var)|Acc];
(Var, Acc) when is_atom(Var) ->
[atom_to_list(Var)|Acc];
(Var, Acc) ->
[Var|Acc]
end, [], Vars),
Fun = "encode_" ++ string:join(NewVars, "_"),
if Mod == undefined -> Fun;
ParentMod == Mod -> Fun;
true -> {Mod, Fun}
end.
%% Fun(Args) -> Body.
make_function(Fun, Args, Body) ->
erl_syntax:function(
erl_syntax:atom(Fun),
[erl_syntax:clause(Args, none, Body)]).
make_function_call({Mod, Fun}, Args) ->
erl_syntax:application(
erl_syntax:atom(Mod),
erl_syntax:atom(Fun),
Args);
make_function_call(Fun, Args) ->
erl_syntax:application(
none,
erl_syntax:atom(Fun),
Args).
abstract(<<>>) ->
erl_syntax:abstract(<<>>);
abstract(Bin) when is_binary(Bin) ->
erl_syntax:binary(
[erl_syntax:abstract(
binary_to_list(Bin))]);
abstract(Term) ->
erl_syntax:abstract(Term).
a(Term) ->
abstract(Term).
label_to_var(Label) ->
case atom_to_list(Label) of
[$$,$_|[H|T]] ->
erl_syntax:variable(
replace_invalid_chars(
[$_, $_, string:to_upper(H)|T]));
[$$|[H|T]] when H /= $- ->
erl_syntax:variable(
replace_invalid_chars(
[string:to_upper(H)|T]))
end.
replace_invalid_chars([$-|T]) ->
[$_|replace_invalid_chars(T)];
replace_invalid_chars([$:|T]) ->
[$_|replace_invalid_chars(T)];
replace_invalid_chars([$.|T]) ->
[$_|replace_invalid_chars(T)];
replace_invalid_chars([H|T]) ->
[H|replace_invalid_chars(T)];
replace_invalid_chars([]) ->
[].
label_to_record_field(Label) ->
case atom_to_list(Label) of
"$_els" ->
sub_els;
"$_xmls" ->
xml_els;
[$$|T] ->
list_to_atom(T)
end.
record_fields_to_vars(Name, Fields) ->
record_fields_to_vars(Name, Fields, []).
record_fields_to_vars(Name, Fields, Replace) ->
FList = lists:map(
fun(Field) ->
case lists:keyfind(Field, 1, Replace) of
{_, AbstractVal} ->
AbstractVal;
false ->
erl_syntax:variable(
[$_|atom_to_list(Field)])
end
end, Fields),
erl_syntax:tuple([erl_syntax:atom(Name)|FList]).
prepare_label(Label, Name) when is_atom(Name) ->
prepare_label(Label, erlang:atom_to_binary(Name, utf8));
prepare_label(Label, Name) ->
if Label == undefined ->
list_to_atom(string:to_lower([$$|binary_to_list(Name)]));
is_atom(Label) ->
case atom_to_list(Label) of
[$$|_] ->
Label;
_ ->
?err("bad 'label': ~p", [Label])
end;
true ->
?err("bad 'label': ~p", [Label])
end.
tuple_or_single_var([Var]) ->
Var;
tuple_or_single_var([_|_] = Vars) ->
erl_syntax:tuple(Vars).
labels_to_underscores(Term) ->
labels_to_underscores(Term, []).
labels_to_underscores(Term, Except) ->
labels_to_underscores(Term, Except, []).
labels_to_underscores(Term, Except, Replace) ->
erl_syntax_lib:map(
fun(T) ->
try
Label = erl_syntax:atom_value(T),
true = is_label(Label),
case lists:member(Label, Except) of
true ->
label_to_var(Label);
false ->
case lists:keyfind(Label, 1, Replace) of
{_, Value} ->
abstract(Value);
false ->
?AST(_)
end
end
catch _:_ ->
T
end
end, abstract(Term)).
have_label(Term, Label) ->
erl_syntax_lib:fold(
fun(_, true) ->
true;
(T, false) ->
try
L = erl_syntax:atom_value(T),
true = is_label(L),
Label == L
catch _:_ ->
false
end
end, false, abstract(Term)).
get_fun_return_type(Fun, FunSpecs) ->
get_fun_return_type(Fun, FunSpecs, dict:new()).
get_fun_return_type({dec_enum, [Atoms]}, _, _) ->
erl_types:t_atoms(Atoms);
get_fun_return_type({dec_int, [Min, _]}, _, _) ->
if Min > 0 ->
erl_types:t_pos_integer();
Min == 0 ->
erl_types:t_non_neg_integer();
Min < 0 ->
erl_types:t_integer()
end;
get_fun_return_type({dec_int, []}, _, _) ->
erl_types:t_integer();
get_fun_return_type({F, Args}, FunSpecs, _) ->
case dict:find({F, length(Args) + 1}, FunSpecs) of
{ok, Spec} ->
Type = t_from_form(Spec),
case erl_types:t_is_any(Type) of
true -> Spec;
false -> Type
end;
_ ->
erl_types:t_any()
end;
get_fun_return_type({M, F, Args}, FunSpecs, _) ->
case dict:find({M, F, length(Args) + 1}, FunSpecs) of
{ok, Spec} ->
Type = t_from_form(Spec),
case erl_types:t_is_any(Type) of
true -> Spec;
false -> Type
end;
_ ->
erl_types:t_any()
end;
get_fun_return_type(undefined, _, _) ->
erl_types:t_binary().
term_is_record(Term) ->
try
[H|_T]= tuple_to_list(Term),
true = is_atom(H),
false == is_label(H)
catch _:_ ->
false
end.
%% This is a copy-paste from erl_types.erl and probably will
%% be broken from time to time in new OTP releases.
t_identifier(Elem) ->
{c, identifier, ordsets:from_list([Elem]), unknown}.
term_to_t([H|T], LabelTypes) ->
erl_types:t_cons(term_to_t(H, LabelTypes), term_to_t(T, LabelTypes));
term_to_t([], _LabelTypes) ->
erl_types:t_nil();
term_to_t(T, LabelTypes) when is_atom(T) ->
case is_label(T) of
true ->
{_, {Type, Default, IsRequired}} = lists:keyfind(T, 1, LabelTypes),
if IsRequired ->
Type;
?is_raw_type(Type) ->
Type;
true ->
erl_types:t_sup(Type, erl_types:t_from_term(Default))
end;
false ->
erl_types:t_atom(T)
end;
term_to_t(T, _LabelTypes) when is_bitstring(T) ->
erl_types:t_bitstr(0, erlang:bit_size(T));
term_to_t(T, _LabelTypes) when is_float(T) ->
erl_types:t_float();
term_to_t(T, _LabelTypes) when is_function(T) ->
{arity, Arity} = erlang:fun_info(T, arity),
erl_types:t_fun(Arity, erl_types:t_any());
term_to_t(T, _LabelTypes) when is_integer(T) ->
erl_types:t_integer(T);
term_to_t(T, _LabelTypes) when is_pid(T) ->
erl_types:t_pid();
term_to_t(T, _LabelTypes) when is_port(T) ->
erl_types:t_port();
term_to_t(T, _LabelTypes) when is_reference(T) ->
erl_types:t_reference();
term_to_t(T, LabelTypes) when is_tuple(T) ->
case term_is_record(T) of
true ->
RecName = element(1, T),
erl_types:t_tuple([term_to_t(RecName, LabelTypes)]);
false ->
erl_types:t_tuple(
[term_to_t(E, LabelTypes) || E <- tuple_to_list(T)])
end.
is_subtype(_Term, Type) when ?is_raw_type(Type) ->
false;
is_subtype(Term, Type) ->
erl_types:t_is_subtype(erl_types:t_from_term(Term), Type).
get_types(TaggedElems, FunSpecs, Opts) ->
G = build_ref_deps(TaggedElems),
SortedTags = digraph_utils:topsort(G),
TypesDict = lists:foldl(
fun(RefName, Dict) ->
RefElem = get_elem_by_ref(RefName, TaggedElems),
Result = RefElem#elem.result,
Labels = extract_labels_from_term(Result),
LabelTypes =
lists:map(
fun(Label) ->
{Label, get_label_type(Label, RefElem, Dict, FunSpecs, Opts)}
end, Labels),
Type = term_to_t(Result, LabelTypes),
dict:store(RefName, Type, Dict)
end, dict:new(), SortedTags),
RecDict = dict_from_list(
lists:flatmap(
fun({Tag, _T}) ->
RefElem = get_elem_by_ref(Tag, TaggedElems),
case term_is_record(RefElem#elem.result) of
true ->
RecName = element(1, RefElem#elem.result),
[{{record, RecName}, {0, [{0, []}]}}];
false ->
[]
end
end, dict:to_list(TypesDict))),
{digraph_utils:topsort(G), TypesDict, RecDict}.
extract_labels_from_term(Term) ->
erl_syntax_lib:fold(
fun(T, Acc) ->
try
Label = erl_syntax:atom_value(T),
true = is_label(Label),
[Label|Acc]
catch _:_ ->
Acc
end
end, [], abstract(Term)).
get_label_type(Label, Elem, Dict, FunSpecs, Opts) ->
XMLType = t_remote(fxml, xmlel),
case get_spec_by_label(Label, Elem) of
sub_els ->
T = case proplists:get_value(add_type_specs, Opts) of
SpecName when is_atom(SpecName), SpecName /= undefined ->
erl_types:t_sup([XMLType, t_identifier(SpecName)]);
_ ->
erl_types:t_any()
end,
{erl_types:t_list(T), [], false};
xml_els ->
{erl_types:t_list(XMLType), [], false};
'_' ->
{erl_types:t_from_term(undefined), [], false};
#attr{dec = undefined, default = Default, required = IsRequired} ->
{erl_types:t_binary(), Default, IsRequired};
#attr{dec = DecFun, default = Default, required = IsRequired} ->
{get_fun_return_type(DecFun, FunSpecs), Default, IsRequired};
#cdata{dec = undefined, default = Default, required = IsRequired} ->
{erl_types:t_binary(), Default, IsRequired};
#cdata{dec = DecFun, default = Default, required = IsRequired} ->
{get_fun_return_type(DecFun, FunSpecs), Default, IsRequired};
[#ref{min = Min, max = Max, default = Default}|_] = Refs ->
Types = lists:flatmap(
fun(#ref{name = RefTag}) ->
case dict:find(RefTag, Dict) of
{ok, T} -> [T];
error -> []
end
end, Refs),
Type = erl_types:t_sup(Types),
IsRequired = (Min == 1) and (Max == 1),
if Max == 1 ->
{Type, Default, IsRequired};
?is_raw_type(Type) ->
{{type, element(2, Type), list, [Type]}, [], false};
true ->
{erl_types:t_list(
erl_types:t_subtract(
Type, erl_types:t_from_term(Default))),
[], false}
end
end.
build_ref_deps(TaggedElems) ->
G = digraph:new([acyclic]),
lists:foreach(
fun({Tag, Elem}) ->
digraph:add_vertex(G, Tag),
lists:foreach(
fun(#ref{name = RefTag}) ->
digraph:add_vertex(G, RefTag),
digraph:add_edge(G, RefTag, Tag)
end, Elem#elem.refs)
end, TaggedElems),
G.
get_abstract_code_from_myself() ->
{file, File} = code:is_loaded(?MODULE),
case beam_lib:chunks(File, [abstract_code]) of
{ok, {_, List}} ->
case lists:keyfind(abstract_code, 1, List) of
{abstract_code, {raw_abstract_v1, Abstr}} ->
{ok, Abstr};
_ ->
error
end;
_ ->
error
end.
%%====================================================================
%% Auxiliary functions
%%====================================================================
resolver_mod(Mod) ->
list_to_atom(atom_to_list(Mod) ++ "_external").
%% Checks
prepare_elem(#elem{name = Name}, _, _, _, _, _)
when not is_binary(Name) ->
bad_spec({wrong_name, Name});
prepare_elem(#elem{module = Mod}, _, _, _, _, _) when not is_atom(Mod) ->
bad_spec({wrong_module, Mod});
prepare_elem(#elem{name = Name, xmlns = XMLNS}, _, _, _, _, _)
when not is_binary(XMLNS), not is_list(XMLNS) ->
bad_spec({wrong_xmlns, XMLNS, Name});
prepare_elem(#elem{name = Name, refs = Refs}, _, _, _, _, _) when not is_list(Refs) ->
bad_spec({wrong_refs, Refs, Name});
prepare_elem(#elem{name = Name, attrs = Attrs}, _, _, _, _, _) when not is_list(Attrs) ->
bad_spec({wrong_attrs, Attrs, Name});
prepare_elem(#elem{name = Name, attrs = Attrs, xmlns = XMLNS,
cdata = CData, refs = Refs, module = Mod} = Elem,
KnownFunctions, FunSpecs, AllElems, ModName, _Opts) ->
if XMLNS == <<>> ->
bad_spec({empty_xmlns, Name});
true ->
ok
end,
NewAttrs = lists:map(
fun(Attr) ->
prepare_attr(Name, Attr, KnownFunctions, FunSpecs, ModName)
end, Attrs),
NewCData = prepare_cdata(Name, CData, KnownFunctions, FunSpecs, ModName),
NewRefs = lists:map(
fun(Ref) -> prepare_ref(Name, Ref, AllElems) end,
Refs),
check_labels(Elem),
NewMod = if Mod == undefined -> ModName;
true -> Mod
end,
Elem#elem{attrs = NewAttrs, cdata = NewCData, refs = NewRefs, module = NewMod}.
prepare_ref(Name, #ref{name = RefName}, _)
when not is_atom(RefName) ->
bad_spec({wrong_ref_name, RefName, Name});
prepare_ref(Name, #ref{name = RefName, min = Min}, _)
when not (Min == 0 orelse Min == 1) ->
bad_spec({wrong_ref_min, Min, RefName, Name});
prepare_ref(Name, #ref{name = RefName, max = Max}, _)
when not (Max == 1 orelse Max == infinity) ->
bad_spec({wrong_ref_max, Max, RefName, Name});
prepare_ref(Name, #ref{name = RefName, label = Label}, _)
when not is_atom(Label) ->
bad_spec({wrong_ref_label, Label, RefName, Name});
prepare_ref(Name, #ref{name = RefName, label = Label} = Ref, AllElems) ->
case (is_label(Label) or (Label == undefined)) of
false ->
bad_spec({wrong_ref_label_format, Label, RefName, Name});
true ->
case lists:keyfind(RefName, 1, AllElems) of
false ->
bad_spec({unresolved_ref, RefName, Name});
_ ->
Ref
end
end;
prepare_ref(Name, Junk, _) ->
bad_spec({not_ref_spec, Junk, Name}).
prepare_default('$unset', DecFun, _IsRequired, FunSpecs) ->
T = get_fun_return_type(DecFun, FunSpecs),
case erl_types:t_is_binary(T) of
true -> <<"">>;
_ -> undefined
end;
prepare_default(Default, _DecFun, false, _FunSpecs) ->
Default;
prepare_default(Default, _DecFun, true, _FunSpecs) ->
bad_spec({default_must_be_unset, Default}).
prepare_attr(Name, #attr{name = AName}, _, _, _)
when not is_binary(AName) ->
bad_spec({wrong_attr_name, AName, Name});
prepare_attr(Name, #attr{name = AName, label = Label}, _, _, _)
when not is_atom(Label) ->
bad_spec({wrong_attr_label, Label, AName, Name});
prepare_attr(Name, #attr{name = AName, required = Req}, _, _, _)
when not (Req == false orelse Req == true) ->
bad_spec({wrong_attr_required, Req, AName, Name});
prepare_attr(Name, #attr{name = AName, label = Label,
default = Default, required = IsRequired,
dec = DecF, enc = EncF} = Attr,
KnownFunctions, FunSpecs, ModName) ->
NewDefault = prepare_default(Default, DecF, IsRequired, FunSpecs),
NewDecFun = prep_dec_fun(DecF, KnownFunctions, ModName),
NewEncFun = prep_enc_fun(EncF, KnownFunctions, ModName),
case (is_label(Label) or (Label == undefined)) of
false ->
bad_spec({wrong_attr_label_format, Label, AName, Name});
true ->
Attr#attr{dec = NewDecFun, enc = NewEncFun, default = NewDefault}
end;
prepare_attr(Name, Junk, _, _, _) ->
bad_spec({not_attr_spec, Junk, Name}).
prepare_cdata(Name, #cdata{label = Label}, _, _, _)
when not is_atom(Label) ->
bad_spec({wrong_cdata_label, Label, Name});
prepare_cdata(Name, #cdata{required = Req}, _, _, _)
when not (Req == false orelse Req == true) ->
bad_spec({wrong_cdata_required, Req, Name});
prepare_cdata(Name, #cdata{label = Label, dec = DecF, enc = EncF,
default = Default, required = IsRequired} = CData,
KnownFunctions, FunSpecs, ModName) ->
NewDefault = prepare_default(Default, DecF, IsRequired, FunSpecs),
NewDecFun = prep_dec_fun(DecF, KnownFunctions, ModName),
NewEncFun = prep_enc_fun(EncF, KnownFunctions, ModName),
case (is_label(Label) or (Label == undefined)) of
false ->
bad_spec({wrong_cdata_label_format, Label, Name});
true ->
CData#cdata{enc = NewEncFun, dec = NewDecFun, default = NewDefault}
end;
prepare_cdata(Name, Junk, _, _, _) ->
bad_spec({not_cdata_spec, Junk, Name}).
get_dups(L) ->
get_dups(L, []).
get_dups([H|T], Acc) ->
case lists:member(H, T) of
true ->
get_dups(T, [H|Acc]);
false ->
get_dups(T, Acc)
end;
get_dups([], Acc) ->
lists:usort(Acc).
check_labels(#elem{result = Result, attrs = Attrs,
refs = Refs, cdata = CData}) ->
ResultLabels = erl_syntax_lib:fold(
fun(T, Acc) ->
try
Label = erl_syntax:atom_value(T),
true = is_label(Label),
[Label|Acc]
catch _:_ ->
Acc
end
end, [], abstract(Result)),
AttrLabels = lists:map(
fun(#attr{name = Name, label = Label}) ->
prepare_label(Label, Name)
end, Attrs),
CDataLabel = CData#cdata.label,
RefLabels = lists:map(
fun({L, Rs}) ->
check_group(L, Rs),
L
end, group_refs(Refs)),
AllLabels = AttrLabels ++ [CDataLabel] ++ RefLabels,
case get_dups(lists:filter(
fun('$_') -> false;
(_) -> true
end, ResultLabels)) of
Dups1 when Dups1 /= [] ->
bad_spec({duplicated_labels, Dups1});
_ ->
ok
end,
case get_dups(AllLabels) of
Dups2 when Dups2 /= [] ->
bad_spec({duplicated_labels, Dups2});
_ ->
ok
end,
ResultSet = sets:from_list(ResultLabels),
AllSet = sets:from_list(AllLabels),
UnresolvedLabels = sets:to_list(
sets:subtract(ResultSet, AllSet)) -- ['$_els', '$_xmls', '$_'],
UnusedLabels = sets:to_list(sets:subtract(AllSet, ResultSet)) -- ['$cdata'],
if UnresolvedLabels /= [] ->
bad_spec({unresolved_labels, UnresolvedLabels});
UnusedLabels /= []->
bad_spec({unused_labels, UnusedLabels});
true ->
ok
end.
check_group(_Label, [_]) ->
ok;
check_group(Label, Refs) ->
#ref{default = Default} = hd(Refs),
case lists:all(
fun(#ref{default = D}) ->
D == Default
end, Refs) of
true ->
case lists:all(
fun(#ref{min = 0, max = 1}) ->
true;
(_) ->
false
end, Refs) of
true ->
ok;
false ->
case lists:all(
fun(#ref{min = 0, max = infinity}) ->
true;
(_) ->
false
end, Refs) of
true ->
ok;
false ->
bad_spec({wrong_min_max_in_group, Label})
end
end;
false ->
bad_spec({different_defaults_in_group, Label})
end.
prep_dec_fun({Mod, Fun, Args}, _, _)
when is_atom(Mod) andalso is_atom(Fun) andalso is_list(Args) ->
{Mod, Fun, Args};
prep_dec_fun({Fun, Args}, KnownFunctions, _ModName)
when is_atom(Fun) andalso is_list(Args) ->
Arity = length(Args) + 1,
case erlang:function_exported(?MODULE, Fun, Arity) of
true ->
{Fun, Args};
false ->
case lists:member({Fun, Arity}, KnownFunctions) of
true ->
{Fun, Args};
false ->
bad_spec({unknown_dec_fun, {Fun, Args}})
end
end;
prep_dec_fun(undefined, _, _) ->
undefined;
prep_dec_fun(Junk, _, _) ->
bad_spec({invalid_dec_fun, Junk}).
prep_enc_fun({Mod, Fun, Args}, _, _)
when is_atom(Mod) andalso is_atom(Fun) andalso is_list(Args) ->
{Mod, Fun, Args};
prep_enc_fun({Fun, Args}, KnownFunctions, _ModName)
when is_atom(Fun) andalso is_list(Args) ->
Arity = length(Args) + 1,
case erlang:function_exported(?MODULE, Fun, Arity) of
true ->
{Fun, Args};
false ->
case lists:member({Fun, Arity}, KnownFunctions) of
true ->
{Fun, Args};
false ->
bad_spec({unknown_enc_fun, {Fun, Args}})
end
end;
prep_enc_fun(undefined, _, _) ->
undefined;
prep_enc_fun(Junk, _, _) ->
bad_spec({invalid_enc_fun, Junk}).
is_label(Label) when not is_atom(Label) ->
false;
is_label(Label) ->
case atom_to_list(Label) of
"$_els" ->
true;
"$_xmls" ->
true;
"$_" ->
true;
[$$,$_|_] ->
false;
[$$,$-|_] ->
false;
[$$,_|_] ->
true;
_ ->
false
end.
bad_spec(Err) ->
erlang:error({bad_spec, Err}).
%% @hidden
%% @doc Same as file:consult, but expands known records.
consult(Path) ->
case get_forms(Path) of
{ok, Forms} ->
{Terms, OtherForms} =
lists:foldl(
fun([Form], {Trms, Other}) ->
Trm =
erl_syntax_lib:map(
fun(T) ->
case erl_syntax:type(T) of
record_expr ->
record_to_tuple(T);
_ ->
T
end
end, erl_syntax:form_list([Form])),
{[Trm|Trms], Other};
(Form, {Trms, Other}) ->
{Trms, [Form|Other]}
end, {[], []}, Forms),
TmpFile = filename:join([filename:dirname(Path),
filename:basename(Path) ++ "~"]),
Str = lists:map(
fun(Tree) ->
AbsForm = erl_syntax:revert_forms(Tree),
case catch erl_eval:exprs(AbsForm, []) of
{'EXIT', _} ->
[];
{value, Term, _} ->
[io_lib:print(Term), $., io_lib:nl()]
end
end, Terms),
Res = case file:write_file(TmpFile, Str) of
ok ->
case file:consult(TmpFile) of
{ok, R} ->
{ok, R, OtherForms};
Err ->
Err
end;
Err ->
Err
end,
catch file:delete(TmpFile),
Res;
Err ->
Err
end.
record_to_tuple(R) ->
Name = erl_syntax:record_expr_type(R),
AtomName = list_to_atom(erl_syntax:atom_name(Name)),
case lists:member(AtomName, [attr, cdata, elem, ref]) of
true ->
record_to_tuple(R, tag_record(AtomName));
false ->
bad_spec({unknown_record, AtomName})
end.
tag_record(attr) ->
tag_record(#attr{}, record_info(fields, attr));
tag_record(cdata) ->
tag_record(#cdata{}, record_info(fields, cdata));
tag_record(ref) ->
tag_record(#ref{}, record_info(fields, ref));
tag_record(elem) ->
tag_record(#elem{}, record_info(fields, elem)).
tag_record(R, Fs) ->
[_|Vs] = tuple_to_list(R),
lists:zip(Fs, Vs).
record_to_tuple(R, TaggedRecord) ->
Name = erl_syntax:record_expr_type(R),
Fs = erl_syntax:record_expr_fields(R),
KeyVals = lists:map(
fun(F) ->
Key = list_to_atom(
erl_syntax:atom_name(
erl_syntax:record_field_name(F))),
Val = erl_syntax:record_field_value(F),
{Key, Val}
end, Fs),
case get_dups([K || {K, _} <- KeyVals]) of
Dups when Dups /= [] ->
bad_spec({duplicated_record_fields, Dups});
_ ->
ok
end,
case sets:to_list(sets:subtract(
sets:from_list([K || {K, _} <- KeyVals]),
sets:from_list([K || {K, _} <- TaggedRecord]))) of
Undef when Undef /= [] ->
bad_spec({undefined_record_fields, Undef});
_ ->
ok
end,
Vals = lists:map(
fun({K, Default}) ->
case lists:keyfind(K, 1, KeyVals) of
{_, Val} ->
Val;
false ->
erl_syntax:abstract(Default)
end
end, TaggedRecord),
erl_syntax:tuple([Name|Vals]).
get_forms(Path) ->
case file:open(Path, [read]) of
{ok, Fd} ->
parse(Fd, 1, []);
Err ->
Err
end.
parse(Fd, Line, Acc) ->
{ok, Pos} = file:position(Fd, cur),
case epp_dodger:parse_form(Fd, Line) of
{ok, Form, NewLine} ->
case erl_syntax:type(Form) of
attribute ->
{ok, NewPos} = file:position(Fd, cur),
{ok, RawForm} = file:pread(Fd, Pos, NewPos - Pos),
file:position(Fd, {bof, NewPos}),
AnnForm = erl_syntax:set_ann(Form, RawForm),
parse(Fd, NewLine, [AnnForm|Acc]);
_ ->
parse(Fd, NewLine, [Form|Acc])
end;
{eof, _} ->
{ok, lists:reverse(Acc)};
_Err ->
file:position(Fd, {bof, Pos}),
case io:scan_erl_exprs(Fd, "", Line) of
{ok, Toks, NewLine} ->
case transform_spec_to_form(Toks) of
{ok, Form} ->
parse(Fd, NewLine, [Form|Acc]);
not_spec ->
parse(Fd, NewLine, Acc);
Err ->
Err
end;
{eof, _} ->
{ok, lists:reverse(Acc)};
Err ->
Err
end
end.
transform_spec_to_form([{'-', L0}, {atom, _, 'xml'}, {'(', _}|T]) ->
case lists:reverse(T) of
[{dot, L3}, {')', L2}|T1] ->
T2 = lists:reverse([{dot, L3}, {'}', L2}|T1]),
case erl_parse:parse_exprs([{'{', L0}|T2]) of
{ok, Form} ->
{ok, Form};
Err ->
Err
end;
_ ->
not_spec
end;
transform_spec_to_form(_) ->
not_spec.
-ifdef(HAVE_REMOTE_TYPES).
-ifdef(HAVE_FROM_FORM0).
t_from_form(Spec) ->
erl_types:t_from_form(Spec).
-else.
t_from_form(Spec) ->
erl_types:t_from_form(Spec, sets:new(), {spec, foo}, dict:new()).
-endif.
t_remote(Mod, Type) ->
erl_types:t_remote(Mod, Type, []).
-else.
t_from_form(Spec) ->
{T, _} = erl_types:t_from_form(
Spec, sets:new(), {type, {mod, foo, 1}}, dict:new(),
erl_types:var_table__new(), erl_types:cache__new()),
T.
t_remote(Mod, Type) ->
D = dict_from_list([{{opaque, Type, []},
{{Mod, 1, 2, []}, type}}]),
[T] = erl_types:t_opaque_from_records(D),
T.
-endif.
-ifdef(USE_MAPS).
dict_from_list(L) ->
maps:from_list(L).
dict_keys(D) ->
maps:keys(D).
-else.
dict_from_list(L) ->
dict:from_list(L).
dict_keys(D) ->
dict:fetch_keys(D).
-endif.