From 7e2b05378b198fc569a8a7cc4c89fded539ea965 Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Tue, 23 Jan 2024 15:32:45 +0100 Subject: [PATCH 1/9] Initial version of the Manifest plugin. --- apps/rebar/src/rebar.app.src.script | 1 + apps/rebar/src/rebar_prv_manifest.erl | 138 +++++++++++++++++++++++ apps/rebar/test/rebar_manifest_SUITE.erl | 67 +++++++++++ 3 files changed, 206 insertions(+) create mode 100644 apps/rebar/src/rebar_prv_manifest.erl create mode 100644 apps/rebar/test/rebar_manifest_SUITE.erl diff --git a/apps/rebar/src/rebar.app.src.script b/apps/rebar/src/rebar.app.src.script index ec2ee0ca1..76f848fb1 100644 --- a/apps/rebar/src/rebar.app.src.script +++ b/apps/rebar/src/rebar.app.src.script @@ -66,6 +66,7 @@ rebar_prv_local_install, rebar_prv_local_upgrade, rebar_prv_lock, + rebar_prv_manifest, rebar_prv_new, rebar_prv_packages, rebar_prv_path, diff --git a/apps/rebar/src/rebar_prv_manifest.erl b/apps/rebar/src/rebar_prv_manifest.erl new file mode 100644 index 000000000..05b83fd60 --- /dev/null +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -0,0 +1,138 @@ +%% =================================================================== +%% Manifest Provider +%% =================================================================== +-module(rebar_prv_manifest). +-behaviour(provider). +-export([init/1, + do/1, + format_error/1]). + +-include_lib("providers/include/providers.hrl"). + +-define(PROVIDER, manifest). +-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()}. +-type manifest() :: #{ + apps := [app_context()], + deps := [app_context()], + otp_lib_dir := string(), + source_root := string() + }. + +-type format() :: erlang | eetf. + +%% =================================================================== +%% Provider Callbacks +%% =================================================================== +-spec init(rebar_state:t()) -> {ok, rebar_state:t()}. +init(State) -> + + %% By default, the provider outputs the manifest to stdout, so disable logs + %% not to interfere. + ok = rebar_log:init(api, 0), + + State1 = rebar_state:add_provider( + State, + providers:create([ + {name, ?PROVIDER}, + {module, ?MODULE}, + {bare, true}, + {deps, [install_deps]}, + {example, "rebar3 manifest"}, + {short_desc, short_desc()}, + {desc, desc()}, + {opts, options()} + ]) + ), + {ok, State1}. + +-spec do(rebar_state:t()) -> {ok, rebar_state:t()} | {error, string()}. +do(State) -> + + {Opts, _} = rebar_state:command_parsed_args(State), + Format = proplists:get_value(format, Opts), + To = proplists:get_value(to, Opts), + + Manifest = get_manifest(State), + case format(Manifest, Format) of + {ok, Formatted} -> + case output_manifest(Formatted, To) of + ok -> + {ok, State}; + {error, Error} -> + ?PRV_ERROR({output_error, To, Error}) + end; + {error, Error} -> + ?PRV_ERROR(Error) + end. + +-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({output_error, To, Error}) -> + io_lib:format("Could not output manifest to ~p (~p)", [To, Error]); +format_error(Reason) -> + io_lib:format("~p", [Reason]). + +%% =================================================================== +%% Internal Helpers +%% =================================================================== +-spec short_desc() -> string(). +short_desc() -> + "Produce a project manifest". + +-spec desc() -> string(). +desc() -> + short_desc(). + +-spec options() -> [tuple()]. +options() -> + [ + {format, $f, "format", {atom, ?DEFAULT_FORMAT}, + "Format for the manifest. " + "Supported formats are: erlang, eetf (Erlang External Binary Format)"}, + {to, $t, "to", {string, undefined}, + "If specified, write the manifest to file"} + ]. + +-spec get_manifest(rebar_state:t()) -> manifest(). +get_manifest(State) -> + ProjectApps = rebar_state:project_apps(State), + DepApps = rebar_state:all_deps(State), + #{ + apps => [adapt_context(App) || App <- ProjectApps], + deps => [adapt_context(App) || App <- DepApps], + otp_lib_dir => code:lib_dir(), + source_root => rebar_state:dir(State) + }. + +-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). + +-spec output_manifest(binary(), string() | undefined) -> ok | {error, term()}. +output_manifest(Manifest, undefined) -> + rebar_log:log(info, "Writing manifest to stdout:~n", []), + io:fwrite("~s~n", [Manifest]); +output_manifest(Manifest, 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()}}. +format(Manifest, eetf) -> + {ok, term_to_binary(Manifest)}; +format(Manifest, erlang) -> + {ok, unicode:characters_to_binary(io_lib:format("~p.", [Manifest]))}; +format(_Manifest, Format) -> + {error, {format_not_supported, Format}}. diff --git a/apps/rebar/test/rebar_manifest_SUITE.erl b/apps/rebar/test/rebar_manifest_SUITE.erl new file mode 100644 index 000000000..47cbc7e9b --- /dev/null +++ b/apps/rebar/test/rebar_manifest_SUITE.erl @@ -0,0 +1,67 @@ +-module(rebar_manifest_SUITE). + +-export([all/0, + init_per_testcase/2, + end_per_testcase/2, + basic_check/1, + write_to_file_erlang/1, + write_to_file_eetf/1, + non_supported_format/1 + ]). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("stdlib/include/assert.hrl"). + +all() -> [ + basic_check, + write_to_file_erlang, + write_to_file_eetf, + non_supported_format + ]. + +init_per_testcase(Case, Config0) -> + %% Create a project directory in the test run's priv_dir + Config = rebar_test_utils:init_rebar_state(Config0), + %% Create toy applications + AppDir = ?config(apps, Config), + Name = rebar_test_utils:create_random_name("app1_"++atom_to_list(Case)), + Vsn = rebar_test_utils:create_random_vsn(), + rebar_test_utils:create_app(AppDir, Name, Vsn, [kernel, stdlib]), + %% Add the data to the test config + [{name, unicode:characters_to_binary(Name)} | Config]. + +end_per_testcase(_, Config) -> + Config. + +basic_check(Config) -> + rebar_test_utils:run_and_check(Config, [], + ["manifest"], + {ok, []}). + +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, [], + ["manifest", "--to", FilePath], + {ok, []}), + {ok, [Manifest]} = file:consult(FilePath), + ?assertMatch(#{deps := [], apps := [#{name := AppName}]}, Manifest). + +write_to_file_eetf(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, [], + ["manifest", "--to", FilePath, "--format", "eetf"], + {ok, []}), + {ok, Content} = file:read_file(FilePath), + Manifest = binary_to_term(Content), + ?assertMatch(#{deps := [], apps := [#{name := AppName}]}, Manifest). + +non_supported_format(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + FilePath = filename:join([PrivDir, "manifest"]), + rebar_test_utils:run_and_check(Config, [], + ["manifest", "--to", FilePath, "--format", "non-existing"], + {error,{rebar_prv_manifest,{format_not_supported,'non-existing'}}}). From 7de6feda628e299417fa3b6311fbc6d6aaa2e99f Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Fri, 16 Feb 2024 16:59:47 +0100 Subject: [PATCH 2/9] Do not disable logging --- apps/rebar/src/rebar_prv_manifest.erl | 5 ----- 1 file changed, 5 deletions(-) diff --git a/apps/rebar/src/rebar_prv_manifest.erl b/apps/rebar/src/rebar_prv_manifest.erl index 05b83fd60..b70df26b5 100644 --- a/apps/rebar/src/rebar_prv_manifest.erl +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -33,11 +33,6 @@ %% =================================================================== -spec init(rebar_state:t()) -> {ok, rebar_state:t()}. init(State) -> - - %% By default, the provider outputs the manifest to stdout, so disable logs - %% not to interfere. - ok = rebar_log:init(api, 0), - State1 = rebar_state:add_provider( State, providers:create([ From 8d69a06a62a9eda2e69c875448203ea4a7bdb416 Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Fri, 16 Feb 2024 17:07:39 +0100 Subject: [PATCH 3/9] Use 4-space formatting, fix nesting --- apps/rebar/src/rebar_prv_manifest.erl | 141 +++++++++++++------------- 1 file changed, 68 insertions(+), 73 deletions(-) diff --git a/apps/rebar/src/rebar_prv_manifest.erl b/apps/rebar/src/rebar_prv_manifest.erl index b70df26b5..d77b9f47d 100644 --- a/apps/rebar/src/rebar_prv_manifest.erl +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -1,8 +1,11 @@ %% =================================================================== %% Manifest Provider %% =================================================================== + -module(rebar_prv_manifest). + -behaviour(provider). + -export([init/1, do/1, format_error/1]). @@ -13,121 +16,113 @@ -define(DEFAULT_FORMAT, erlang). -type extension() :: string(). --type app_context() :: #{name := binary(), - src_dirs := [file:filename()], +-type app_context() :: #{name := binary(), + src_dirs := [file:filename()], include_dirs := [file:filename()], - src_ext := extension(), - out_mappings := [#{extension := extension(), path := file:filename()}], + src_ext := extension(), + out_mappings := [#{extension := extension(), + path := file:filename()}], dependencies_opts => any()}. --type manifest() :: #{ - apps := [app_context()], - deps := [app_context()], - otp_lib_dir := string(), - source_root := string() - }. +-type manifest() :: #{ apps := [app_context()], + deps := [app_context()], + otp_lib_dir := string(), + source_root := string()}. -type format() :: erlang | eetf. %% =================================================================== -%% Provider Callbacks +%% Public API %% =================================================================== + -spec init(rebar_state:t()) -> {ok, rebar_state:t()}. init(State) -> - State1 = rebar_state:add_provider( - State, - providers:create([ - {name, ?PROVIDER}, - {module, ?MODULE}, - {bare, true}, - {deps, [install_deps]}, - {example, "rebar3 manifest"}, - {short_desc, short_desc()}, - {desc, desc()}, - {opts, options()} - ]) - ), - {ok, State1}. + State1 = rebar_state:add_provider(State, + providers:create([{name, ?PROVIDER}, + {module, ?MODULE}, + {bare, true}, + {deps, [install_deps]}, + {example, "rebar3 manifest"}, + {short_desc, short_desc()}, + {desc, desc()}, + {opts, options()} + ])), + {ok, State1}. -spec do(rebar_state:t()) -> {ok, rebar_state:t()} | {error, string()}. do(State) -> - - {Opts, _} = rebar_state:command_parsed_args(State), - Format = proplists:get_value(format, Opts), - To = proplists:get_value(to, Opts), - - Manifest = get_manifest(State), - case format(Manifest, Format) of - {ok, Formatted} -> - case output_manifest(Formatted, To) of - ok -> - {ok, State}; + {Opts, _} = rebar_state:command_parsed_args(State), + Format = proplists:get_value(format, Opts), + To = proplists:get_value(to, Opts), + + Manifest = get_manifest(State), + case format(Manifest, Format) of + {ok, Formatted} -> + case output_manifest(Formatted, To) of + ok -> + {ok, State}; + {error, Error} -> + ?PRV_ERROR({output_error, To, Error}) + end; {error, Error} -> - ?PRV_ERROR({output_error, To, Error}) - end; - {error, Error} -> - ?PRV_ERROR(Error) - end. + ?PRV_ERROR(Error) + end. -spec format_error(any()) -> iolist(). format_error({format_not_supported, Format}) -> - io_lib:format("Format '~p' is not supported. Try 'erlang' or 'eetf'.", [Format]); + io_lib:format("Format '~p' is not supported. Try 'erlang' or 'eetf'.", [Format]); format_error({output_error, To, Error}) -> - io_lib:format("Could not output manifest to ~p (~p)", [To, Error]); + io_lib:format("Could not output manifest to ~p (~p)", [To, Error]); format_error(Reason) -> - io_lib:format("~p", [Reason]). + io_lib:format("~p", [Reason]). %% =================================================================== %% Internal Helpers %% =================================================================== -spec short_desc() -> string(). short_desc() -> - "Produce a project manifest". + "Produce a project manifest". -spec desc() -> string(). desc() -> - short_desc(). + short_desc(). -spec options() -> [tuple()]. options() -> - [ - {format, $f, "format", {atom, ?DEFAULT_FORMAT}, - "Format for the manifest. " - "Supported formats are: erlang, eetf (Erlang External Binary Format)"}, - {to, $t, "to", {string, undefined}, - "If specified, write the manifest to file"} - ]. + [{format, $f, "format", {atom, ?DEFAULT_FORMAT}, + "Format for the manifest. " + "Supported formats are: erlang, eetf (Erlang External Binary Format)"}, + {to, $t, "to", {string, undefined}, + "If specified, write the manifest to file"}]. -spec get_manifest(rebar_state:t()) -> manifest(). get_manifest(State) -> - ProjectApps = rebar_state:project_apps(State), - DepApps = rebar_state:all_deps(State), - #{ - apps => [adapt_context(App) || App <- ProjectApps], - deps => [adapt_context(App) || App <- DepApps], - otp_lib_dir => code:lib_dir(), - source_root => rebar_state:dir(State) - }. + ProjectApps = rebar_state:project_apps(State), + DepApps = rebar_state:all_deps(State), + #{apps => [adapt_context(App) || App <- ProjectApps], + deps => [adapt_context(App) || App <- DepApps], + otp_lib_dir => code:lib_dir(), + source_root => rebar_state:dir(State)}. -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). + 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). -spec output_manifest(binary(), string() | undefined) -> ok | {error, term()}. output_manifest(Manifest, undefined) -> - rebar_log:log(info, "Writing manifest to stdout:~n", []), - io:fwrite("~s~n", [Manifest]); + rebar_log:log(info, "Writing manifest to stdout:~n", []), + io:fwrite("~s~n", [Manifest]); output_manifest(Manifest, File) -> - rebar_log:log(info, "Build info written to: ~ts~n", [File]), - file:write_file(File, Manifest). + 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()}}. format(Manifest, eetf) -> - {ok, term_to_binary(Manifest)}; + {ok, term_to_binary(Manifest)}; format(Manifest, erlang) -> - {ok, unicode:characters_to_binary(io_lib:format("~p.", [Manifest]))}; + {ok, unicode:characters_to_binary(io_lib:format("~p.", [Manifest]))}; format(_Manifest, Format) -> - {error, {format_not_supported, Format}}. + {error, {format_not_supported, Format}}. From ead2ae2980c15232b0c45d8d779b1d5d2718240c Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Fri, 16 Feb 2024 17:08:40 +0100 Subject: [PATCH 4/9] Fix types for otp_lib_dir and source_root --- apps/rebar/src/rebar_prv_manifest.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/apps/rebar/src/rebar_prv_manifest.erl b/apps/rebar/src/rebar_prv_manifest.erl index d77b9f47d..e3d45338d 100644 --- a/apps/rebar/src/rebar_prv_manifest.erl +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -25,8 +25,8 @@ dependencies_opts => any()}. -type manifest() :: #{ apps := [app_context()], deps := [app_context()], - otp_lib_dir := string(), - source_root := string()}. + otp_lib_dir := file:filename(), + source_root := file:filename()}. -type format() :: erlang | eetf. From a372d029cf5788bafea9f7a560d961af5b4f5cea Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Fri, 16 Feb 2024 17:12:11 +0100 Subject: [PATCH 5/9] Use 4-space formatting, fix nesting (for tests) --- apps/rebar/test/rebar_manifest_SUITE.erl | 59 +++++++++++------------- 1 file changed, 28 insertions(+), 31 deletions(-) diff --git a/apps/rebar/test/rebar_manifest_SUITE.erl b/apps/rebar/test/rebar_manifest_SUITE.erl index 47cbc7e9b..66922d90d 100644 --- a/apps/rebar/test/rebar_manifest_SUITE.erl +++ b/apps/rebar/test/rebar_manifest_SUITE.erl @@ -6,18 +6,15 @@ basic_check/1, write_to_file_erlang/1, write_to_file_eetf/1, - non_supported_format/1 - ]). + non_supported_format/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("stdlib/include/assert.hrl"). -all() -> [ - basic_check, +all() -> [basic_check, write_to_file_erlang, write_to_file_eetf, - non_supported_format - ]. + non_supported_format]. init_per_testcase(Case, Config0) -> %% Create a project directory in the test run's priv_dir @@ -34,34 +31,34 @@ end_per_testcase(_, Config) -> Config. basic_check(Config) -> - rebar_test_utils:run_and_check(Config, [], - ["manifest"], - {ok, []}). + rebar_test_utils:run_and_check(Config, [], + ["manifest"], + {ok, []}). 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, [], - ["manifest", "--to", FilePath], - {ok, []}), - {ok, [Manifest]} = file:consult(FilePath), - ?assertMatch(#{deps := [], apps := [#{name := AppName}]}, Manifest). + 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, [], + ["manifest", "--to", FilePath], + {ok, []}), + {ok, [Manifest]} = file:consult(FilePath), + ?assertMatch(#{deps := [], apps := [#{name := AppName}]}, Manifest). write_to_file_eetf(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, [], - ["manifest", "--to", FilePath, "--format", "eetf"], - {ok, []}), - {ok, Content} = file:read_file(FilePath), - Manifest = binary_to_term(Content), - ?assertMatch(#{deps := [], apps := [#{name := AppName}]}, Manifest). + 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, [], + ["manifest", "--to", FilePath, "--format", "eetf"], + {ok, []}), + {ok, Content} = file:read_file(FilePath), + Manifest = binary_to_term(Content), + ?assertMatch(#{deps := [], apps := [#{name := AppName}]}, Manifest). non_supported_format(Config) -> - PrivDir = proplists:get_value(priv_dir, Config), - FilePath = filename:join([PrivDir, "manifest"]), - rebar_test_utils:run_and_check(Config, [], - ["manifest", "--to", FilePath, "--format", "non-existing"], - {error,{rebar_prv_manifest,{format_not_supported,'non-existing'}}}). + PrivDir = proplists:get_value(priv_dir, Config), + FilePath = filename:join([PrivDir, "manifest"]), + rebar_test_utils:run_and_check(Config, [], + ["manifest", "--to", FilePath, "--format", "non-existing"], + {error,{rebar_prv_manifest,{format_not_supported,'non-existing'}}}). From 8b6c828751838f716a73780281e0784b1e5a2039 Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Fri, 16 Feb 2024 17:17:18 +0100 Subject: [PATCH 6/9] Add Unicode modifier --- 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 e3d45338d..047e50339 100644 --- a/apps/rebar/src/rebar_prv_manifest.erl +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -114,7 +114,7 @@ adapt_context(App) -> -spec output_manifest(binary(), string() | undefined) -> ok | {error, term()}. output_manifest(Manifest, undefined) -> rebar_log:log(info, "Writing manifest to stdout:~n", []), - io:fwrite("~s~n", [Manifest]); + io:fwrite("~ts~n", [Manifest]); output_manifest(Manifest, File) -> rebar_log:log(info, "Build info written to: ~ts~n", [File]), file:write_file(File, Manifest). From 9b0941d9cddd0cc6a29fdd666e83b008657d3102 Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Fri, 16 Feb 2024 17:28:08 +0100 Subject: [PATCH 7/9] Filter away un-supported functions --- apps/rebar/src/rebar_prv_manifest.erl | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/apps/rebar/src/rebar_prv_manifest.erl b/apps/rebar/src/rebar_prv_manifest.erl index 047e50339..a144e69fe 100644 --- a/apps/rebar/src/rebar_prv_manifest.erl +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -98,11 +98,16 @@ options() -> get_manifest(State) -> ProjectApps = rebar_state:project_apps(State), DepApps = rebar_state:all_deps(State), - #{apps => [adapt_context(App) || App <- ProjectApps], - deps => [adapt_context(App) || App <- DepApps], + #{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)}. +-spec is_supported(rebar_app_info:t()) -> boolean(). +is_supported(App) -> + Type = rebar_app_info:project_type(App), + Type =:= rebar3 orelse Type =:= undefined. + -spec adapt_context(rebar_app_info:t()) -> app_context(). adapt_context(App) -> Context0 = rebar_compiler_erl:context(App), From 066471013874e2afc4cc9b91f0502fef67cc7487 Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Tue, 20 Feb 2024 20:44:39 +0100 Subject: [PATCH 8/9] Only use Unicode modifier for erlang format --- apps/rebar/src/rebar_prv_manifest.erl | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/apps/rebar/src/rebar_prv_manifest.erl b/apps/rebar/src/rebar_prv_manifest.erl index a144e69fe..5aa47fb6f 100644 --- a/apps/rebar/src/rebar_prv_manifest.erl +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -57,7 +57,7 @@ do(State) -> Manifest = get_manifest(State), case format(Manifest, Format) of {ok, Formatted} -> - case output_manifest(Formatted, To) of + case output_manifest(Formatted, Format, To) of ok -> {ok, State}; {error, Error} -> @@ -116,11 +116,16 @@ adapt_context(App) -> {Extension, Path} <- maps:get(out_mappings, Context1)], maps:put(out_mappings, OutMappings, Context1). --spec output_manifest(binary(), string() | undefined) -> ok | {error, term()}. -output_manifest(Manifest, undefined) -> +-spec output_manifest(binary(), format(), string() | undefined) -> ok | {error, term()}. +output_manifest(Manifest, Format, undefined) -> rebar_log:log(info, "Writing manifest to stdout:~n", []), - io:fwrite("~ts~n", [Manifest]); -output_manifest(Manifest, File) -> + case Format of + erlang -> + io:fwrite("~ts~n", [Manifest]); + eetf -> + io:fwrite("~s~n", [Manifest]) + end; +output_manifest(Manifest, _Format, File) -> rebar_log:log(info, "Build info written to: ~ts~n", [File]), file:write_file(File, Manifest). From 994e164f6f9a1ee587f6f315770555d5e387b236 Mon Sep 17 00:00:00 2001 From: Roberto Aloi Date: Tue, 20 Feb 2024 20:47:38 +0100 Subject: [PATCH 9/9] Mark plugin as experimental --- apps/rebar/src/rebar_prv_manifest.erl | 4 +++- apps/rebar/test/rebar_manifest_SUITE.erl | 12 +++++++----- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/apps/rebar/src/rebar_prv_manifest.erl b/apps/rebar/src/rebar_prv_manifest.erl index 5aa47fb6f..192ee6da2 100644 --- a/apps/rebar/src/rebar_prv_manifest.erl +++ b/apps/rebar/src/rebar_prv_manifest.erl @@ -13,6 +13,7 @@ -include_lib("providers/include/providers.hrl"). -define(PROVIDER, manifest). +-define(NAMESPACE, experimental). -define(DEFAULT_FORMAT, erlang). -type extension() :: string(). @@ -38,9 +39,10 @@ init(State) -> State1 = rebar_state:add_provider(State, providers:create([{name, ?PROVIDER}, + {namespace, ?NAMESPACE}, {module, ?MODULE}, {bare, true}, - {deps, [install_deps]}, + {deps, [{default, install_deps}]}, {example, "rebar3 manifest"}, {short_desc, short_desc()}, {desc, desc()}, diff --git a/apps/rebar/test/rebar_manifest_SUITE.erl b/apps/rebar/test/rebar_manifest_SUITE.erl index 66922d90d..f9d71b1f7 100644 --- a/apps/rebar/test/rebar_manifest_SUITE.erl +++ b/apps/rebar/test/rebar_manifest_SUITE.erl @@ -11,6 +11,8 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("stdlib/include/assert.hrl"). +-define(NAMESPACE, "experimental"). + all() -> [basic_check, write_to_file_erlang, write_to_file_eetf, @@ -32,7 +34,7 @@ end_per_testcase(_, Config) -> basic_check(Config) -> rebar_test_utils:run_and_check(Config, [], - ["manifest"], + [?NAMESPACE, "manifest"], {ok, []}). write_to_file_erlang(Config) -> @@ -40,7 +42,7 @@ write_to_file_erlang(Config) -> PrivDir = proplists:get_value(priv_dir, Config), FilePath = filename:join([PrivDir, "manifest"]), rebar_test_utils:run_and_check(Config, [], - ["manifest", "--to", FilePath], + [?NAMESPACE, "manifest", "--to", FilePath], {ok, []}), {ok, [Manifest]} = file:consult(FilePath), ?assertMatch(#{deps := [], apps := [#{name := AppName}]}, Manifest). @@ -50,7 +52,7 @@ write_to_file_eetf(Config) -> PrivDir = proplists:get_value(priv_dir, Config), FilePath = filename:join([PrivDir, "manifest"]), rebar_test_utils:run_and_check(Config, [], - ["manifest", "--to", FilePath, "--format", "eetf"], + [?NAMESPACE, "manifest", "--to", FilePath, "--format", "eetf"], {ok, []}), {ok, Content} = file:read_file(FilePath), Manifest = binary_to_term(Content), @@ -60,5 +62,5 @@ non_supported_format(Config) -> PrivDir = proplists:get_value(priv_dir, Config), FilePath = filename:join([PrivDir, "manifest"]), rebar_test_utils:run_and_check(Config, [], - ["manifest", "--to", FilePath, "--format", "non-existing"], - {error,{rebar_prv_manifest,{format_not_supported,'non-existing'}}}). + [?NAMESPACE, "manifest", "--to", FilePath, "--format", "non-existing"], + {error, {rebar_prv_manifest, {format_not_supported, 'non-existing'}}}).