diff --git a/apps/rebar/rebar.config b/apps/rebar/rebar.config index 157432570..2d23451c6 100644 --- a/apps/rebar/rebar.config +++ b/apps/rebar/rebar.config @@ -88,3 +88,4 @@ ]} ]}. +{compiler_error_format, rich}. diff --git a/apps/rebar/src/rebar.hrl b/apps/rebar/src/rebar.hrl index 3931620f6..fa6f2bda2 100644 --- a/apps/rebar/src/rebar.hrl +++ b/apps/rebar/src/rebar.hrl @@ -27,6 +27,7 @@ -define(DEFAULT_CDN, "https://repo.hex.pm"). -define(LOCK_FILE, "rebar.lock"). -define(DEFAULT_COMPILER_SOURCE_FORMAT, relative). +-define(DEFAULT_COMPILER_ERROR_FORMAT, minimal). % 'rich' for multiline values -define(PACKAGE_INDEX_VERSION, 6). -define(PACKAGE_TABLE, package_index). -define(INDEX_FILE, "packages.idx"). diff --git a/apps/rebar/src/rebar_base_compiler.erl b/apps/rebar/src/rebar_base_compiler.erl index 0a62d22f9..e3f557990 100644 --- a/apps/rebar/src/rebar_base_compiler.erl +++ b/apps/rebar/src/rebar_base_compiler.erl @@ -33,6 +33,7 @@ run/8, ok_tuple/2, error_tuple/4, + error_tuple/5, report/1, maybe_report/1, format_error_source/2]). @@ -139,8 +140,18 @@ ok_tuple(Source, Ws) -> Err :: string(), Warn :: string(). error_tuple(Source, Es, Ws, Opts) -> - {error, format_errors(Source, Es), - format_warnings(Source, Ws, Opts)}. + {error, format_errors(Source, Es, []), + format_warnings(Source, Ws, dict:new(), Opts)}. + +%% @doc format error and warning strings for a given source file +%% according to user preferences. +-spec error_tuple(file:filename(), [Err], [Warn], rebar_dict(), [{_,_}]) -> + error_tuple() when + Err :: string(), + Warn :: string(). +error_tuple(Source, Es, Ws, Config, Opts) -> + {error, format_errors(Source, Es, Config), + format_warnings(Source, Ws, Config, Opts)}. %% @doc from a given path, and based on the user-provided options, %% format the file path according to the preferences. @@ -208,19 +219,19 @@ compile_each([Source | Rest], Config, CompileFn) -> compile_each(Rest, Config, CompileFn). %% @private Formats and returns errors ready to be output. --spec format_errors(string(), [err_or_warn()]) -> [string()]. -format_errors(Source, Errors) -> - format_errors(Source, "", Errors). +-spec format_errors(string(), [err_or_warn()], rebar_dict() | [{_,_}]) -> [string()]. +format_errors(Source, Errors, Opts) -> + format_errors(Source, "", Errors, Opts). %% @private Formats and returns warning strings ready to be output. -spec format_warnings(string(), [err_or_warn()]) -> [string()]. format_warnings(Source, Warnings) -> - format_warnings(Source, Warnings, []). + format_warnings(Source, Warnings, dict:new(), []). %% @private Formats and returns warnings; chooses the distinct format they %% may have based on whether `warnings_as_errors' option is on. --spec format_warnings(string(), [err_or_warn()], rebar_dict() | [{_,_}]) -> [string()]. -format_warnings(Source, Warnings, Opts) -> +-spec format_warnings(string(), [err_or_warn()], rebar_dict(), rebar_dict() | [{_,_}]) -> [string()]. +format_warnings(Source, Warnings, Config, Opts) -> %% `Opts' can be passed in both as a list or a dictionary depending %% on whether the first call to rebar_erlc_compiler was done with %% the type `rebar_dict()' or `rebar_state:t()'. @@ -231,7 +242,7 @@ format_warnings(Source, Warnings, Opts) -> true -> ""; false -> "Warning: " end, - format_errors(Source, Prefix, Warnings). + format_errors(Source, Prefix, Warnings, Config). %% @private output compiler errors if they're judged to be reportable. -spec maybe_report(Reportable | term()) -> ok when @@ -254,16 +265,16 @@ report(Messages) -> lists:foreach(fun(Msg) -> io:format("~ts~n", [Msg]) end, Messages). %% private format compiler errors into proper outputtable strings --spec format_errors(_, Extra, [err_or_warn()]) -> [string()] when +-spec format_errors(_, Extra, [err_or_warn()], rebar_dict() | [{_,_}]) -> [string()] when Extra :: string(). -format_errors(_MainSource, Extra, Errors) -> - [[format_error(Source, Extra, Desc) || Desc <- Descs] +format_errors(_MainSource, Extra, Errors, Opts) -> + [[format_error(Source, Extra, Desc, Opts) || Desc <- Descs] || {Source, Descs} <- Errors]. %% @private format compiler errors into proper outputtable strings --spec format_error(file:filename(), Extra, err_or_warn()) -> string() when +-spec format_error(file:filename(), Extra, err_or_warn(), rebar_dict() | [{_,_}]) -> string() when Extra :: string(). -format_error(Source, Extra, {Line, Mod=epp, Desc={include,lib,File}}) -> +format_error(Source, Extra, {Line, Mod=epp, Desc={include,lib,File}}, _Opts) -> %% Special case for include file errors, overtaking the default one BaseDesc = Mod:format_error(Desc), Friendly = case filename:split(File) of @@ -275,12 +286,13 @@ format_error(Source, Extra, {Line, Mod=epp, Desc={include,lib,File}}) -> end, FriendlyDesc = BaseDesc ++ Friendly, ?FMT("~ts:~w: ~ts~ts~n", [Source, Line, Extra, FriendlyDesc]); -format_error(Source, Extra, {{Line, Column}, Mod, Desc}) -> +format_error(Source, Extra, {{Line, Column}, Mod, Desc}, Opts) -> ErrorDesc = Mod:format_error(Desc), - ?FMT("~ts:~w:~w: ~ts~ts~n", [Source, Line, Column, Extra, ErrorDesc]); -format_error(Source, Extra, {Line, Mod, Desc}) -> + rebar_compiler_format:format(Source, {Line, Column}, Extra, ErrorDesc, Opts); +format_error(Source, Extra, {Line, Mod, Desc}, _Opts) -> ErrorDesc = Mod:format_error(Desc), ?FMT("~ts:~w: ~ts~ts~n", [Source, Line, Extra, ErrorDesc]); -format_error(Source, Extra, {Mod, Desc}) -> +format_error(Source, Extra, {Mod, Desc}, _Opts) -> ErrorDesc = Mod:format_error(Desc), ?FMT("~ts: ~ts~ts~n", [Source, Extra, ErrorDesc]). + diff --git a/apps/rebar/src/rebar_compiler.erl b/apps/rebar/src/rebar_compiler.erl index 39f1d3354..d4f7e38e2 100644 --- a/apps/rebar/src/rebar_compiler.erl +++ b/apps/rebar/src/rebar_compiler.erl @@ -9,6 +9,7 @@ needs_compile/3, ok_tuple/2, error_tuple/4, + error_tuple/5, maybe_report/1, format_error_source/2, report/1]). @@ -130,6 +131,9 @@ ok_tuple(Source, Ws) -> error_tuple(Source, Es, Ws, Opts) -> rebar_base_compiler:error_tuple(Source, Es, Ws, Opts). +error_tuple(Source, Es, Ws, Config, Opts) -> + rebar_base_compiler:error_tuple(Source, Es, Ws, Config, Opts). + maybe_report(Reportable) -> rebar_base_compiler:maybe_report(Reportable). diff --git a/apps/rebar/src/rebar_compiler_erl.erl b/apps/rebar/src/rebar_compiler_erl.erl index 6b4b52257..57bd685d8 100644 --- a/apps/rebar/src/rebar_compiler_erl.erl +++ b/apps/rebar/src/rebar_compiler_erl.erl @@ -183,7 +183,7 @@ clean(Files, AppInfo) -> error_tuple(Module, Es, Ws, AllOpts, Opts) -> FormattedEs = format_error_sources(Es, AllOpts), FormattedWs = format_error_sources(Ws, AllOpts), - rebar_compiler:error_tuple(Module, FormattedEs, FormattedWs, Opts). + rebar_compiler:error_tuple(Module, FormattedEs, FormattedWs, AllOpts, Opts). format_error_sources(Es, Opts) -> [{rebar_compiler:format_error_source(Src, Opts), Desc} diff --git a/apps/rebar/src/rebar_compiler_format.erl b/apps/rebar/src/rebar_compiler_format.erl new file mode 100644 index 000000000..a8992a67b --- /dev/null +++ b/apps/rebar/src/rebar_compiler_format.erl @@ -0,0 +1,72 @@ +%%% @doc Module handling rich formatting of errors. +-module(rebar_compiler_format). +-export([format/5]). + +-include("rebar.hrl"). + +-spec format(file:filename_all(), {Line, Column}, Extra, Desc, rebar_dict()) -> + string() when + Extra :: iodata(), + Line :: non_neg_integer(), + Column :: non_neg_integer(), + Desc :: iodata(). +format(Source, {Line, Column}, Extra, Desc, Config) -> + CompilerErrFmt = compiler_error_format(Config), + case CompilerErrFmt == rich andalso find_line(Line, Source) of + {ok, LnBin} -> + LnPad = lists:duplicate(length(integer_to_list(Line)), " "), + Arrow = cf:format("~!R~ts~!!",["╰──"]), + ?FMT(" ~ts ┌─ ~ts:~n" + " ~ts │~n" + " ~w │ ~ts~n" + " ~ts │ ~s~ts ~ts~ts~n~n", + [LnPad, Source, + LnPad, + Line, colorize(LnBin, Column), + LnPad, lists:duplicate(max(0, Column-1), " "), Arrow, Extra, Desc]); + _ -> + ?FMT("~ts:~w:~w: ~ts~ts~n", [Source, Line, Column, Extra, Desc]) + end. + +find_line(Nth, Source) -> + try + {ok, Bin} = file:read_file(Source), + Splits = re:split(Bin, "(?:\n|\r\n|\r)", [{newline, anycrlf}]), + {ok, lists:nth(Nth, Splits)} + catch + error:X -> {error, X} + end. + +compiler_error_format(Opts) -> + %% `Opts' can be passed in both as a list or a dictionary depending + %% on whether the first call to rebar_erlc_compiler was done with + %% the type `rebar_dict()' or `rebar_state:t()'. + LookupFn = if is_list(Opts) -> fun(K,L) -> lists:keyfind(K, 1, L) end + ; true -> fun(K,O) -> rebar_opts:get(O, K, false) end + end, + case LookupFn(compiler_error_format, Opts) of + false -> ?DEFAULT_COMPILER_ERROR_FORMAT; + {ok, minimal} -> minimal; + {ok, rich} -> rich; + minimal -> minimal; + rich -> rich + end. + +%% @private try to colorize data based on common ways to end terminators +%% in Erlang-like languages. Any character that isn't one of the following +%% is considered to end a "word" of some type: +%% +%% - letters +%% - numbers +%% - underscore +%% - quotations +%% +%% This will have false positives in some cases and if that becomes annoying +%% we'll need to allow per-compiler module configurations here, but it should +%% generally lead to proper colorization. +colorize(Str, Col) -> + Pre = string:slice(Str, 0, max(0,Col-1)), + At = string:slice(Str, max(0,Col-1)), + [Bad | Tail] = [B || B <- re:split(At, "([^[A-Za-z0-9_#\"]+)", []), + B =/= <<>>], + cf:format("~ts~!R~ts~!!~ts", [Pre,Bad,Tail]). diff --git a/apps/rebar/src/rebar_compiler_xrl.erl b/apps/rebar/src/rebar_compiler_xrl.erl index 35447ed13..3d3390cb1 100644 --- a/apps/rebar/src/rebar_compiler_xrl.erl +++ b/apps/rebar/src/rebar_compiler_xrl.erl @@ -34,14 +34,14 @@ needed_files(_, FoundFiles, Mappings, AppInfo) -> dependencies(_, _, _) -> []. -compile(Source, [{_, _}], _, Opts) -> +compile(Source, [{_, _}], Config, Opts) -> case leex:file(Source, [{return, true} | Opts]) of {ok, _} -> ok; {ok, _Mod, Ws} -> rebar_compiler:ok_tuple(Source, Ws); {error, Es, Ws} -> - rebar_compiler:error_tuple(Source, Es, Ws, Opts) + rebar_compiler:error_tuple(Source, Es, Ws, Config, Opts) end. clean(XrlFiles, _AppInfo) -> diff --git a/apps/rebar/src/rebar_compiler_yrl.erl b/apps/rebar/src/rebar_compiler_yrl.erl index c6392ae23..4692d480f 100644 --- a/apps/rebar/src/rebar_compiler_yrl.erl +++ b/apps/rebar/src/rebar_compiler_yrl.erl @@ -32,7 +32,7 @@ needed_files(_, FoundFiles, Mappings, AppInfo) -> dependencies(_, _, _) -> []. -compile(Source, [{_, OutDir}], _, Opts0) -> +compile(Source, [{_, OutDir}], Config, Opts0) -> Opts = case proplists:get_value(parserfile, Opts0) of undefined -> BaseName = filename:basename(Source, ".yrl"), @@ -48,7 +48,7 @@ compile(Source, [{_, OutDir}], _, Opts0) -> {ok, _Mod, Ws} -> rebar_compiler:ok_tuple(Source, Ws); {error, Es, Ws} -> - rebar_compiler:error_tuple(Source, Es, Ws, AllOpts) + rebar_compiler:error_tuple(Source, Es, Ws, Config, AllOpts) end. clean(YrlFiles, _AppInfo) -> diff --git a/apps/rebar/test/rebar_compiler_format_SUITE.erl b/apps/rebar/test/rebar_compiler_format_SUITE.erl new file mode 100644 index 000000000..e35f5b888 --- /dev/null +++ b/apps/rebar/test/rebar_compiler_format_SUITE.erl @@ -0,0 +1,94 @@ +-module(rebar_compiler_format_SUITE). +-compile([export_all, nowarn_export_all]). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("eunit/include/eunit.hrl"). + +-define(EOL, lists:flatten(io_lib:format("~n",[]))). + +all() -> + [minimal, nocolor]. + +init_per_testcase(minimal, Config) -> + Conf = dict:from_list([{compiler_error_format, minimal}]), + [{conf, Conf} | init_per_testcase(regular, Config)]; +init_per_testcase(_, Config) -> + OriginalTerm = os:getenv("TERM"), + os:putenv("TERM", "dumb"), % disable color + application:set_env(cf, colour_term, cf_term:has_color("dumb")), + FileName = filename:join(?config(priv_dir, Config), "oracle.erl"), + ok = file:write_file(FileName, oracle()), + Conf = dict:from_list([{compiler_error_format, rich}]), + [{conf, Conf}, {file, FileName}, {term, OriginalTerm} | Config]. + +end_per_testcase(_, Config) -> + case ?config(term, Config) of + false -> + os:unsetenv("TERM"), + application:unset_env(cf, colour_term); + Original -> + os:putenv("TERM", Original), + application:set_env(cf, colour_term, cf_term:has_color("Original")) + end, + Config. + +oracle() -> + "-module(noline_end);\n" + ++ lists:duplicate(9, $\n) ++ + "first character on line 11.\n" + ++ lists:duplicate(99, $\n) ++ + "case X of ^whatever % on line 111\n". + +minimal() -> + [{doc, "showing minimal (default) output"}]. +minimal(Config) -> + Path = ?config(file, Config), + Conf = ?config(conf, Config), + ?assertEqual(Path++":1:20: => unexpected token: ;"++?EOL, + rebar_compiler_format:format(Path, {1,20}, "=> ", "unexpected token: ;", Conf)), + ?assertEqual(Path++":11:1: some message"++?EOL, + rebar_compiler_format:format(Path, {11,1}, "", "some message", Conf)), + ?assertEqual(Path++":111:11: the character '^' is not expected here."++?EOL, + rebar_compiler_format:format(Path, {111,11}, "", "the character '^' is not expected here.", Conf)), + ?assertEqual(Path++":-23:-42: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {-23,-42}, "", "invalid ranges.", Conf)), + ?assertEqual(Path++":-23:-42: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {-23,-42}, "", "invalid ranges.", Conf)), + ?assertEqual(Path++":855:1: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {855,1}, "", "invalid ranges.", Conf)), + ?assertEqual("/very/fake/path.oof:1:1: unknown file."++?EOL, + rebar_compiler_format:format("/very/fake/path.oof", {1,1}, "", "unknown file.", Conf)), + ok. + + +nocolor() -> + [{doc, "testing all sorts of planned output"}]. +nocolor(Config) -> + Path = ?config(file, Config), + Conf = ?config(conf, Config), + ?assertEqual(" ┌─ "++Path++":"++?EOL++ + " │"++?EOL++ + " 1 │ -module(noline_end);"++?EOL++ + " │ ╰── => unexpected token: ;"++?EOL++?EOL, + rebar_compiler_format:format(Path, {1,20}, "=> ", "unexpected token: ;", Conf)), + ?assertEqual(" ┌─ "++Path++":"++?EOL++ + " │"++?EOL++ + " 11 │ first character on line 11."++?EOL++ + " │ ╰── some message"++?EOL++?EOL, + rebar_compiler_format:format(Path, {11,1}, "", "some message", Conf)), + ?assertEqual(" ┌─ "++Path++":"++?EOL++ + " │"++?EOL++ + " 111 │ case X of ^whatever % on line 111"++?EOL++ + " │ ╰── the character '^' is not expected here."++?EOL++?EOL, + rebar_compiler_format:format(Path, {111,11}, "", "the character '^' is not expected here.", Conf)), + %% invalid cases fall back to minimal mode + ?assertEqual(Path++":-23:-42: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {-23,-42}, "", "invalid ranges.", Conf)), + ?assertEqual(Path++":-23:-42: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {-23,-42}, "", "invalid ranges.", Conf)), + ?assertEqual(Path++":855:1: invalid ranges."++?EOL, + rebar_compiler_format:format(Path, {855,1}, "", "invalid ranges.", Conf)), + ?assertEqual("/very/fake/path.oof:1:1: unknown file."++?EOL, + rebar_compiler_format:format("/very/fake/path.oof", {1,1}, "", "unknown file.", Conf)), + ok. + diff --git a/rebar.config b/rebar.config index 72235d6a6..96a48b2ce 100644 --- a/rebar.config +++ b/rebar.config @@ -67,4 +67,5 @@ ]} ]}. +{compiler_error_format, rich}. %% The rest of the config is in apps/rebar/ diff --git a/rebar.config.sample b/rebar.config.sample index 77fef3804..c3646de26 100644 --- a/rebar.config.sample +++ b/rebar.config.sample @@ -27,6 +27,9 @@ {minimum_otp_vsn, "21.0"}. +%% Should errors be in a rich format, or a minimal one (tool-friendly) +{compiler_error_format, rich}. + %% MIB Options? {mib_opts, []}. %% SNMP mibs to compile first?