From 053b12e97f7ac6260f0d74d1134c139d4452a0ad Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Wed, 7 Aug 2024 18:22:15 +0200 Subject: [PATCH 1/3] Tweak manifest plugin to return ELP compatible information. --- apps/rebar/src/rebar_prv_manifest.erl | 51 ++++++++++++++++++--------- 1 file changed, 35 insertions(+), 16 deletions(-) diff --git a/apps/rebar/src/rebar_prv_manifest.erl b/apps/rebar/src/rebar_prv_manifest.erl index 192ee6da2..3432daf15 100644 --- a/apps/rebar/src/rebar_prv_manifest.erl +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -16,18 +16,19 @@ -define(NAMESPACE, experimental). -define(DEFAULT_FORMAT, erlang). --type extension() :: string(). -type app_context() :: #{name := binary(), - src_dirs := [file:filename()], - include_dirs := [file:filename()], - src_ext := extension(), - out_mappings := [#{extension := extension(), - path := file:filename()}], - dependencies_opts => any()}. + dir => file:filename_all(), + ebin => file:filename_all(), + src_dirs := [file:filename_all()], + extra_src_dirs := [file:filename_all()], + include_dirs := [file:filename_all()], + macros => [macro()], + parse_transforms => [any()]}. +-type macro() :: atom() | {atom(), any()}. -type manifest() :: #{ apps := [app_context()], deps := [app_context()], - otp_lib_dir := file:filename(), - source_root := file:filename()}. + otp_lib_dir := file:filename_all(), + source_root := file:filename_all()}. -type format() :: erlang | eetf. @@ -102,8 +103,8 @@ get_manifest(State) -> DepApps = rebar_state:all_deps(State), #{apps => [adapt_context(App) || App <- ProjectApps, is_supported(App)], deps => [adapt_context(App) || App <- DepApps, is_supported(App)], - otp_lib_dir => code:lib_dir(), - source_root => rebar_state:dir(State)}. + otp_lib_dir => to_binary(code:lib_dir()), + source_root => to_binary(rebar_state:dir(State))}. -spec is_supported(rebar_app_info:t()) -> boolean(). is_supported(App) -> @@ -112,11 +113,25 @@ is_supported(App) -> -spec adapt_context(rebar_app_info:t()) -> app_context(). adapt_context(App) -> - Context0 = rebar_compiler_erl:context(App), - Context1 = maps:put(name, rebar_app_info:name(App), Context0), - OutMappings = [#{extension => Extension, path => Path} || - {Extension, Path} <- maps:get(out_mappings, Context1)], - maps:put(out_mappings, OutMappings, Context1). + Context = rebar_compiler_erl:context(App), + #{src_dirs := SrcDirs, + include_dirs := IncludeDirs, + dependencies_opts := DependenciesOpts} = Context, + Name = rebar_app_info:name(App), + Dir = rebar_app_info:dir(App), + EbinDir = rebar_app_info:ebin_dir(App), + RebarOpts = rebar_app_info:opts(App), + ExtraSrcDirs = rebar_dir:extra_src_dirs(RebarOpts), + Macros = proplists:get_value(macros, DependenciesOpts), + ParseTransforms = proplists:get_value(parse_transforms, DependenciesOpts), + #{name => Name, + dir => to_binary(Dir), + ebin => to_binary(EbinDir), + src_dirs => [to_binary(D) || D <- SrcDirs], + extra_src_dirs => [to_binary(D) || D <- ExtraSrcDirs], + include_dirs => [to_binary(D) || D <- IncludeDirs], + macros => Macros, + parse_transforms => ParseTransforms}. -spec output_manifest(binary(), format(), string() | undefined) -> ok | {error, term()}. output_manifest(Manifest, Format, undefined) -> @@ -138,3 +153,7 @@ format(Manifest, erlang) -> {ok, unicode:characters_to_binary(io_lib:format("~p.", [Manifest]))}; format(_Manifest, Format) -> {error, {format_not_supported, Format}}. + +-spec to_binary(file:filename()) -> file:filename_all(). +to_binary(Path) -> + unicode:characters_to_binary(Path). From 9353ecbc61077ac711dd3bed86410b199e73a438 Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Thu, 8 Aug 2024 15:07:00 +0200 Subject: [PATCH 2/3] Introduce JSON output (requires OTP 27) and make it default --- apps/rebar/src/rebar_prv_manifest.erl | 49 ++++++++++++++++++------ apps/rebar/test/rebar_manifest_SUITE.erl | 35 +++++++++++++++-- 2 files changed, 69 insertions(+), 15 deletions(-) diff --git a/apps/rebar/src/rebar_prv_manifest.erl b/apps/rebar/src/rebar_prv_manifest.erl index 3432daf15..7ccc93b5b 100644 --- a/apps/rebar/src/rebar_prv_manifest.erl +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -8,13 +8,14 @@ -export([init/1, do/1, - format_error/1]). + format_error/1, + is_json_available/0]). -include_lib("providers/include/providers.hrl"). -define(PROVIDER, manifest). -define(NAMESPACE, experimental). --define(DEFAULT_FORMAT, erlang). +-define(DEFAULT_FORMAT, json). -type app_context() :: #{name := binary(), dir => file:filename_all(), @@ -24,13 +25,13 @@ include_dirs := [file:filename_all()], macros => [macro()], parse_transforms => [any()]}. --type macro() :: atom() | {atom(), any()}. +-type macro() :: #{key := atom(), value => any()}. -type manifest() :: #{ apps := [app_context()], deps := [app_context()], otp_lib_dir := file:filename_all(), source_root := file:filename_all()}. --type format() :: erlang | eetf. +-type format() :: erlang | eetf | json. %% =================================================================== %% Public API @@ -73,6 +74,8 @@ do(State) -> -spec format_error(any()) -> iolist(). format_error({format_not_supported, Format}) -> io_lib:format("Format '~p' is not supported. Try 'erlang' or 'eetf'.", [Format]); +format_error(no_json_module) -> + io_lib:format("The 'json' module is not available. Either upgrade to OTP 27 or use a different format.", []); format_error({output_error, To, Error}) -> io_lib:format("Could not output manifest to ~p (~p)", [To, Error]); format_error(Reason) -> @@ -93,7 +96,7 @@ desc() -> options() -> [{format, $f, "format", {atom, ?DEFAULT_FORMAT}, "Format for the manifest. " - "Supported formats are: erlang, eetf (Erlang External Binary Format)"}, + "Supported formats are: erlang, eetf (Erlang External Binary Format), json"}, {to, $t, "to", {string, undefined}, "If specified, write the manifest to file"}]. @@ -130,30 +133,54 @@ adapt_context(App) -> src_dirs => [to_binary(D) || D <- SrcDirs], extra_src_dirs => [to_binary(D) || D <- ExtraSrcDirs], include_dirs => [to_binary(D) || D <- IncludeDirs], - macros => Macros, + macros => [to_macro(M) || M <- Macros], parse_transforms => ParseTransforms}. -spec output_manifest(binary(), format(), string() | undefined) -> ok | {error, term()}. output_manifest(Manifest, Format, undefined) -> rebar_log:log(info, "Writing manifest to stdout:~n", []), case Format of - erlang -> - io:fwrite("~ts~n", [Manifest]); - eetf -> - io:fwrite("~s~n", [Manifest]) + eetf -> + io:fwrite("~s~n", [Manifest]); + _ -> + io:fwrite("~ts~n", [Manifest]) end; output_manifest(Manifest, _Format, File) -> rebar_log:log(info, "Build info written to: ~ts~n", [File]), file:write_file(File, Manifest). --spec format(manifest(), format()) -> {ok, binary()} | {error, {format_not_supported, term()}}. +-spec format(manifest(), format()) -> {ok, binary()} | {error, {format_not_supported, term()} | no_json_module}. format(Manifest, eetf) -> {ok, term_to_binary(Manifest)}; format(Manifest, erlang) -> {ok, unicode:characters_to_binary(io_lib:format("~p.", [Manifest]))}; +format(Manifest, json) -> + case is_json_available() of + true -> + Encoded = erlang:apply(json, encode, [Manifest]), + {ok, Encoded}; + false -> + {error, no_json_module} + end; format(_Manifest, Format) -> {error, {format_not_supported, Format}}. -spec to_binary(file:filename()) -> file:filename_all(). to_binary(Path) -> unicode:characters_to_binary(Path). + +-spec to_macro(atom() | {atom() | any()}) -> macro(). +to_macro({Key, Value}) when is_atom(Key) -> + #{key => Key, value => Value}; +to_macro(Key) when is_atom(Key) -> + #{key => Key, value => true}. + +-spec is_json_available() -> boolean(). +is_json_available() -> + % Requires OTP 27 + case code:ensure_loaded(json) of + {module, _} -> + true; + {error, _} -> + false + end. diff --git a/apps/rebar/test/rebar_manifest_SUITE.erl b/apps/rebar/test/rebar_manifest_SUITE.erl index f9d71b1f7..f74be2b13 100644 --- a/apps/rebar/test/rebar_manifest_SUITE.erl +++ b/apps/rebar/test/rebar_manifest_SUITE.erl @@ -6,6 +6,7 @@ basic_check/1, write_to_file_erlang/1, write_to_file_eetf/1, + write_to_file_json/1, non_supported_format/1]). -include_lib("common_test/include/ct.hrl"). @@ -16,6 +17,7 @@ all() -> [basic_check, write_to_file_erlang, write_to_file_eetf, + write_to_file_json, non_supported_format]. init_per_testcase(Case, Config0) -> @@ -33,16 +35,23 @@ end_per_testcase(_, Config) -> Config. basic_check(Config) -> - rebar_test_utils:run_and_check(Config, [], - [?NAMESPACE, "manifest"], - {ok, []}). + case rebar_prv_manifest:is_json_available() of + true -> + rebar_test_utils:run_and_check(Config, [], + [?NAMESPACE, "manifest"], + {ok, []}); + false -> + rebar_test_utils:run_and_check(Config, [], + [?NAMESPACE, "manifest"], + {error, {rebar_prv_manifest, no_json_module}}) + end. write_to_file_erlang(Config) -> AppName = proplists:get_value(name, Config), PrivDir = proplists:get_value(priv_dir, Config), FilePath = filename:join([PrivDir, "manifest"]), rebar_test_utils:run_and_check(Config, [], - [?NAMESPACE, "manifest", "--to", FilePath], + [?NAMESPACE, "manifest", "--to", FilePath, "--format", "erlang"], {ok, []}), {ok, [Manifest]} = file:consult(FilePath), ?assertMatch(#{deps := [], apps := [#{name := AppName}]}, Manifest). @@ -58,6 +67,24 @@ write_to_file_eetf(Config) -> Manifest = binary_to_term(Content), ?assertMatch(#{deps := [], apps := [#{name := AppName}]}, Manifest). +write_to_file_json(Config) -> + AppName = proplists:get_value(name, Config), + PrivDir = proplists:get_value(priv_dir, Config), + FilePath = filename:join([PrivDir, "manifest"]), + case rebar_prv_manifest:is_json_available() of + true -> + rebar_test_utils:run_and_check(Config, [], + [?NAMESPACE, "manifest", "--to", FilePath], + {ok, []}), + {ok, Content} = file:read_file(FilePath), + Manifest = erlang:apply(json, decode, [Content]), + ?assertMatch(#{<<"deps">> := [], <<"apps">> := [#{<<"name">> := AppName}]}, Manifest); + false -> + rebar_test_utils:run_and_check(Config, [], + [?NAMESPACE, "manifest", "--to", FilePath, "--format", "json"], + {error, {rebar_prv_manifest, no_json_module}}) + end. + non_supported_format(Config) -> PrivDir = proplists:get_value(priv_dir, Config), FilePath = filename:join([PrivDir, "manifest"]), From f1afc05ec51a2401290c60d65cacfa9f6f393b86 Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Fri, 9 Aug 2024 15:41:14 +0200 Subject: [PATCH 3/3] Fix spelling for error message in case of missing json module --- apps/rebar/src/rebar_prv_manifest.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/apps/rebar/src/rebar_prv_manifest.erl b/apps/rebar/src/rebar_prv_manifest.erl index 7ccc93b5b..f87421ae7 100644 --- a/apps/rebar/src/rebar_prv_manifest.erl +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -75,7 +75,7 @@ do(State) -> format_error({format_not_supported, Format}) -> io_lib:format("Format '~p' is not supported. Try 'erlang' or 'eetf'.", [Format]); format_error(no_json_module) -> - io_lib:format("The 'json' module is not available. Either upgrade to OTP 27 or use a different format.", []); + io_lib:format("The 'json' module is not available. Either upgrade to OTP 27 or newer, or select a different output format.", []); format_error({output_error, To, Error}) -> io_lib:format("Could not output manifest to ~p (~p)", [To, Error]); format_error(Reason) ->