cuttlefish

%% -------------------------------------------------------------------
%%
%% cuttlefish_schema: slurps schema files
%%
%% Copyright (c) 2013 Basho Technologies, Inc.  All Rights Reserved.
%%
%% This file is provided to you 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(cuttlefish_schema).

-include_lib("kernel/include/logger.hrl").

-ifdef(TEST).
-include_lib("eunit/include/eunit.hrl").
-export([file/1]).
-endif.

-export([files/1, strings/1, list_schemas/1]).

%% Exported for unit testing in other projects
-export([merger/1, string_fun_factory/0]).

%% Refuse schema files above 8 MiB.
-define(MAX_SCHEMA_BYTES, 8388608).


-type schema() :: {
              [cuttlefish_translation:translation()],
              [cuttlefish_mapping:mapping()],
              [cuttlefish_validator:validator()]}.
-export_type([schema/0]).

-spec files([string()]) -> schema() | cuttlefish_error:errorlist().
files(ListOfSchemaFiles) ->
    merger(fun file/2, ListOfSchemaFiles).

-spec strings([string()]) -> schema() | cuttlefish_error:errorlist().
strings(ListOfStrings) ->
    merger(fun string/2, ListOfStrings).

-spec merger(fun((string(), schema()) -> schema() | cuttlefish_error:errorlist()), [string()]) ->
                    schema() | cuttlefish_error:errorlist().
merger(Fun, ListOfInputs) ->
    merger([ {Fun, Input} || Input <- ListOfInputs ]).

-spec merger([{fun((string(), schema()) -> schema() | cuttlefish_error:errorlist()), string()}]) ->
                    schema() | cuttlefish_error:errorlist().
merger(ListOfFunInputPairs) ->
    Schema = lists:foldr(
        fun
            %% Propagate an errorlist accumulator instead of
            %% crashing in the next iteration's 3-tuple match.
            (_, {errorlist, _} = Errs) ->
                Errs;
            ({Fun, Input}, {TranslationAcc, MappingAcc, ValidatorAcc}) ->
                case Fun(Input, {TranslationAcc, MappingAcc, ValidatorAcc}) of
                    {errorlist, Errors} ->
                        {errorlist, Errors};
                    {Translations, Mappings, Validators} ->
                        NewMappings = lists:foldr(
                            fun cuttlefish_mapping:replace/2,
                            MappingAcc,
                            Mappings),

                        NewTranslations = lists:foldr(
                            fun cuttlefish_translation:replace/2,
                            TranslationAcc,
                            Translations),

                        NewValidators = lists:foldr(
                            fun cuttlefish_validator:replace/2,
                            ValidatorAcc,
                            Validators),

                        {NewTranslations, NewMappings, NewValidators}
                end
        end,
        {[], [], []},
        ListOfFunInputPairs),
    filter(Schema).

%% @doc Sorted `*.schema' paths in `Dir', dotfiles excluded.
-spec list_schemas(file:filename_all()) -> [file:filename_all()].
list_schemas(Dir) ->
    case file:list_dir(Dir) of
        {ok, Files} ->
            [filename:join(Dir, F) ||
                F <- lists:sort(Files),
                lists:suffix(".schema", F),
                not lists:prefix(".", F)];
        {error, _} ->
            []
    end.

%% This filter is *ONLY* for the case of multiple mappings to a single
%% erlang app setting, *AND* there's no corresponding translation for
%% that app setting
-spec filter(schema() | cuttlefish_error:errorlist()) -> schema() | cuttlefish_error:errorlist().
filter({errorlist, Errorlist}) ->
    {errorlist, Errorlist};
filter({Translations, Mappings, Validators}) ->
    Counts = count_mappings(Mappings),
    {MappingsToCheck, _} = lists:unzip(Counts),
    NewMappings = lists:foldl(
        fun(MappingName, Acc) ->
            case lists:any(
                fun(T) -> cuttlefish_translation:mapping(T) =:= MappingName end,
                Translations) of
                false ->
                    cuttlefish_mapping:remove_all_but_first(MappingName, Acc);
                _ -> Acc
            end
        end,
        Mappings, MappingsToCheck),

    case validate_aliases(NewMappings) of
        ok ->
            case validate_validator_refs(NewMappings, Validators) of
                ok -> {Translations, NewMappings, Validators};
                {errorlist, _} = Errors -> Errors
            end;
        {errorlist, _} = Errors ->
            Errors
    end.

%% @doc Checks that every validator name referenced by a mapping's
%% `{validators, [...]}` opt resolves to a defined validator.
%% Without this, a typo or missing dependency only surfaces at
%% validation phase as `validator_not_found', far from the actual
%% cause.
-spec validate_validator_refs([cuttlefish_mapping:mapping()],
                              [cuttlefish_validator:validator()]) ->
    ok | cuttlefish_error:errorlist().
validate_validator_refs(Mappings, Validators) ->
    Defined = sets:from_list(
        [cuttlefish_validator:name(V) || V <- Validators]),
    Missing = lists:flatmap(
        fun(M) ->
            Var = cuttlefish_variable:format(cuttlefish_mapping:variable(M)),
            [{Var, N} || N <- cuttlefish_mapping:validators(M),
                         not sets:is_element(N, Defined)]
        end, Mappings),
    case Missing of
        [] -> ok;
        _ ->
            {errorlist,
             [{error, {validator_not_defined, Var, N}}
              || {Var, N} <- Missing]}
    end.

%% @doc Validates that aliases don't collide with other mappings' canonical
%% variables or with aliases from other mappings.
-spec validate_aliases([cuttlefish_mapping:mapping()]) ->
    ok | cuttlefish_error:errorlist().
validate_aliases(Mappings) ->
    CanonicalVarSet = sets:from_list(
        [cuttlefish_mapping:variable(M) || M <- Mappings]),
    AliasIndex = lists:flatmap(fun(M) ->
        Variable = cuttlefish_mapping:variable(M),
        [{Alias, Variable} || Alias <- cuttlefish_mapping:aliases(M)]
    end, Mappings),
    collect_alias_collision_errors(AliasIndex, CanonicalVarSet, []).

collect_alias_collision_errors([], _CanonicalVarSet, []) ->
    ok;
collect_alias_collision_errors([], _CanonicalVarSet, Errors) ->
    {errorlist, lists:reverse(Errors)};
collect_alias_collision_errors([{Alias, OwnerVar} | Rest], CanonicalVarSet, Errors) ->
    AliasStr = cuttlefish_variable:format(Alias),
    OwnerStr = cuttlefish_variable:format(OwnerVar),
    NewErrors = case sets:is_element(Alias, CanonicalVarSet) of
        true ->
            [{error, {alias_shadows_canonical, {AliasStr, OwnerStr}}} | Errors];
        false ->
            OtherMappingAliases = [{A, V} || {A, V} <- Rest, V =/= OwnerVar],
            case lists:keyfind(Alias, 1, OtherMappingAliases) of
                {Alias, OtherOwnerVar} ->
                    OtherStr = cuttlefish_variable:format(OtherOwnerVar),
                    [{error, {alias_claimed_by_multiple_mappings, {AliasStr, OwnerStr, OtherStr}}} | Errors];
                false ->
                    Errors
            end
    end,
    collect_alias_collision_errors(Rest, CanonicalVarSet, NewErrors).

count_mappings(Mappings) ->
    lists:foldl(
        fun(M, Acc) ->
            orddict:update_counter(cuttlefish_mapping:mapping(M), 1, Acc)
        end,
        orddict:new(),
        Mappings).

-spec file(string(), schema()) -> schema() | cuttlefish_error:errorlist().
file(Filename, Schema) ->
    case is_schema_filename(Filename) of
        false ->
            wrap_errors(Filename, [{error, {not_a_schema_file, Filename}}]);
        true ->
            load_and_parse_schema_file(Filename, Schema)
    end.

%% Catches `.swp', `.DS_Store', crash dumps, and similar junk.
-spec is_schema_filename(file:filename_all()) -> boolean().
is_schema_filename(Filename) ->
    filename:extension(Filename) =:= ".schema".

load_and_parse_schema_file(Filename, Schema) ->
    Abs = filename:absname(Filename),
    case erl_prim_loader:get_file(Abs) of
        {ok, B, _} ->
            check_size_and_parse(Filename, B, Schema);
        error ->
            wrap_errors(Filename,
                        [{error, {schema_file_read_error, {Filename, not_readable}}}])
    end.

check_size_and_parse(Filename, B, Schema) ->
    case byte_size(B) of
        Size when Size > ?MAX_SCHEMA_BYTES ->
            wrap_errors(
              Filename,
              [{error, {schema_file_too_large,
                        {Filename, Size, ?MAX_SCHEMA_BYTES}}}]);
        _ ->
            decode_and_parse(Filename, B, Schema)
    end.

decode_and_parse(Filename, B, Schema) ->
    case unicode:characters_to_list(B) of
        {incomplete, _, _} ->
            wrap_errors(Filename,
                        [{error, {schema_file_invalid_unicode, Filename}}]);
        {error, _, _} ->
            wrap_errors(Filename,
                        [{error, {schema_file_invalid_unicode, Filename}}]);
        Chardata when is_list(Chardata) ->
            sanity_check_and_parse(Filename, Chardata, Schema)
    end.

sanity_check_and_parse(Filename, Chardata, Schema) ->
    case looks_like_schema(Chardata) of
        false ->
            wrap_errors(Filename,
                        [{error, {schema_file_unrecognized_content, Filename}}]);
        true ->
            case string(Chardata, Schema) of
                {errorlist, Errors} ->
                    cuttlefish_error:print("Error parsing schema: ~ts", [Filename]),
                    wrap_errors(Filename, Errors);
                NewSchema ->
                    NewSchema
            end
    end.

%% True if the first top-level term tag is `mapping', `translation',
%% or `validator'. Whitespace-and-comments-only files also pass.
-spec looks_like_schema(string()) -> boolean().
looks_like_schema(Chardata) ->
    case skip_whitespace_and_comments(Chardata) of
        "" ->
            true;
        "{" ++ Rest ->
            has_schema_tag(skip_whitespace_and_comments(Rest));
        _ ->
            false
    end.

has_schema_tag("mapping"         ++ _) -> true;
has_schema_tag("translation"     ++ _) -> true;
has_schema_tag("validator"       ++ _) -> true;
has_schema_tag("include_partial" ++ _) -> true;
has_schema_tag(_) -> false.

skip_whitespace_and_comments([C | T]) when C =:= $\s; C =:= $\t;
                                           C =:= $\n; C =:= $\r ->
    skip_whitespace_and_comments(T);
skip_whitespace_and_comments([$% | T]) ->
    skip_whitespace_and_comments(skip_to_newline(T));
skip_whitespace_and_comments(Other) ->
    Other.

skip_to_newline([])        -> [];
skip_to_newline([$\n | T]) -> T;
skip_to_newline([_ | T])   -> skip_to_newline(T).

%% Tag every error with its filename so callers can report which
%% file failed without relying on a logger.
-spec wrap_errors(file:filename_all(), [cuttlefish_error:error()]) ->
    cuttlefish_error:errorlist().
wrap_errors(Filename, Errors) ->
    {errorlist, [wrap_error(Filename, E) || E <- Errors]}.

wrap_error(Filename, {error, _} = Inner) ->
    {error, {schema_file, Filename, Inner}}.

%% @doc this exists so that we can create the fun using non exported
%% functions for unit testing
-spec string_fun_factory() -> fun((string(), schema()) ->
                                         schema() | cuttlefish_error:errorlist()).
string_fun_factory() ->
     fun string/2.

-spec string(string(), schema()) -> schema() | cuttlefish_error:errorlist().
string(S, {T, M, V}) ->
    case erl_scan:string(S) of
        {ok, Tokens, _} ->
            CommentTokens = erl_comment_scan:string(S),
            {Translations, Mappings, Validators, Errors} = parse_schema(Tokens, CommentTokens, {T, M, V, []}),

            case length(Errors) of
                0 ->
                    {Translations, Mappings, Validators};
                _ ->
                    lists:foreach(fun({error, _Term}=E) ->
                                          cuttlefish_error:print(E) end,
                                  Errors),
                    {errorlist, Errors}
            end;
        {error, {Line, erl_scan, _}, _} ->
            Error = {erl_scan, Line},
            ErrStr = cuttlefish_error:xlate(Error),
            _ = ?LOG_ERROR(lists:flatten(ErrStr)),
            {errorlist, [{error, Error}]}
    end.

-spec parse_schema(
    [any()],
    [any()],
    {[cuttlefish_translation:translation()],
     [cuttlefish_mapping:mapping()],
     [cuttlefish_validator:validator()],
     [cuttlefish_error:error()]}
    ) ->
        {[cuttlefish_translation:translation()],
         [cuttlefish_mapping:mapping()],
         [cuttlefish_validator:validator()],
         [cuttlefish_error:error()]}.
%% We're done! We don't care about any comments after the last schema item
parse_schema([], _LeftoverComments, {TAcc, MAcc, VAcc, EAcc}) ->
    {lists:reverse(TAcc), lists:reverse(MAcc), lists:reverse(VAcc), lists:reverse(EAcc)};
parse_schema(ScannedTokens, CommentTokens, {TAcc, MAcc, VAcc, EAcc}) ->
    {LineNo, Tokens, TailTokens } = parse_schema_tokens(ScannedTokens),
    {Comments, TailComments} = lists:foldr(
        fun(X={CommentLineNo, _, _, Comment}, {C, TC}) ->
            case CommentLineNo < LineNo of
                true -> {Comment ++ C, TC};
                _ -> {C, [X|TC]}
            end
        end,
        {[], []},
        CommentTokens),

    NewAcc = case parse(Tokens) of
        {error, {erl_parse, Reason}} ->
            {TAcc, MAcc, VAcc, [{error, {erl_parse, {Reason, LineNo}}} | EAcc]};
        {mapping, {mapping, Variable, Mapping, Proplist}} ->
            Attributes = comment_parser(Comments),
            Doc = proplists:get_value(doc, Attributes, []),
            See = get_see(Attributes),
            MappingSource = {mapping, Variable, Mapping, [{see, See},{doc, Doc}|Proplist]},
            {TAcc, cuttlefish_mapping:parse_and_merge(MappingSource, MAcc), VAcc, EAcc};
        {translation, Return} ->
            {cuttlefish_translation:parse_and_merge(Return, TAcc), MAcc, VAcc, EAcc};
        {validator, Return} ->
            {TAcc, MAcc, cuttlefish_validator:parse_and_merge(Return, VAcc), EAcc};
        {include_partial, {include_partial, {App, Name}, IncludeOpts}}
                when is_atom(App), is_list(Name), is_list(IncludeOpts) ->
            apply_partial(App, Name, IncludeOpts, {TAcc, MAcc, VAcc, EAcc});
        {include_partial, BadDirective} ->
            {TAcc, MAcc, VAcc,
             [{error, {partial_bad_directive, BadDirective}} | EAcc]};
        Other ->
            {TAcc, MAcc, VAcc, [{error, {parse_schema, Other}} | EAcc]}
    end,
    parse_schema(TailTokens, TailComments, NewAcc).

%% Load a partial and fold each rewritten term into the schema
%% accumulators. Errors from the loader propagate as standard
%% schema errors and don't abort the rest of the file.
apply_partial(App, Name, IncludeOpts, Acc) ->
    case cuttlefish_partial:load(App, Name, IncludeOpts) of
        {ok, Terms} ->
            Annotated = [annotate_partial_source(T, App, Name) || T <- Terms],
            lists:foldl(fun apply_partial_term/2, Acc, Annotated);
        {error, Reason} ->
            {T, M, V, E} = Acc,
            {T, M, V, [{error, Reason} | E]}
    end.

%% Prepend a provenance line to each partial-emitted mapping's doc
%% so `cuttlefish describe' shows where it came from. Translations
%% and validators have no doc field; pass them through.
annotate_partial_source({mapping, Var, Map, Opts}, App, Name) ->
    Provenance = lists:flatten(
        io_lib:format("(from partial ~ts:~ts)", [App, Name])),
    OldDoc = proplists:get_value(doc, Opts, []),
    NewOpts = lists:keystore(doc, 1, Opts, {doc, [Provenance | OldDoc]}),
    {mapping, Var, Map, NewOpts};
annotate_partial_source(Other, _App, _Name) ->
    Other.

apply_partial_term({mapping, _, _, _} = Raw, {T, M, V, E}) ->
    {T, cuttlefish_mapping:parse_and_merge(Raw, M), V, E};
apply_partial_term({validator, _, _, _} = Raw, {T, M, V, E}) ->
    {T, M, cuttlefish_validator:parse_and_merge(Raw, V), E};
apply_partial_term({translation, _, _} = Raw, {T, M, V, E}) ->
    {cuttlefish_translation:parse_and_merge(Raw, T), M, V, E}.

parse_schema_tokens(Scanned) ->
    parse_schema_tokens(Scanned, []).

parse_schema_tokens([], Acc=[Last|_]) ->
    %% When you've reached the end of file without encountering a dot,
    %% return the result anyway and let erl_parse produce the error.
    {element(2, Last), lists:reverse(Acc), []};
parse_schema_tokens(Scanned, Acc=[{dot, LineNo}|_]) ->
    {LineNo, lists:reverse(Acc), Scanned};
parse_schema_tokens([H|Scanned], Acc) ->
    parse_schema_tokens(Scanned, [H|Acc]).

-spec parse(list()) ->
    {mapping | translation | validator | include_partial, tuple()}
  | cuttlefish_error:error().
parse(Scanned) ->
    case erl_parse:parse_exprs(Scanned) of
        {ok, Parsed} ->
            {value, X, _} = erl_eval:exprs(Parsed,[]),
            {element(1, X), X};
        {error, {_Line, erl_parse, [H|_T]=Strings}} when is_list(H) ->
            {error, {erl_parse, lists:flatten(Strings)}};
        {error, {_Line, erl_parse, Term}} ->
            {error, {erl_parse, io_lib:format("~tp", [Term])}};
        E ->
            {error, {erl_parse_unexpected, E}}
    end.

-spec get_see([proplists:property()]) -> [cuttlefish_variable:variable()].
get_see(Proplist) ->
    [ cuttlefish_variable:tokenize(Line)
      || [Line] <- proplists:get_all_values(see, Proplist)].


comment_parser(Comments) ->
    StrippedComments =
        lists:filter(fun(X) -> X =/= [] end,
            [percent_stripper(C) || C <- Comments]),
    %% now, let's go annotation hunting

    AttrList = lists:foldl(
        fun(Line, Acc) ->
                case {Line, Acc} of
                    {[ $@ | T], _} ->
                        Annotation = hd(string:tokens(T, [$\s])),
                        [{list_to_atom(Annotation), [percent_stripper(T -- Annotation)] }|Acc];
                    { _, []} -> [];
                    {String, _} ->
                        [{Annotation, Strings}|T] = Acc,
                        [{Annotation, [String|Strings]}|T]
                end
            end, [], StrippedComments),
    SortedList = lists:reverse([ {Attr, lists:reverse(Value)} || {Attr, Value} <- AttrList]),
    CorrectedList = attribute_formatter(SortedList),
    CorrectedList.

%% Just handles the @doc business
attribute_formatter([Other | T]) ->
    [ Other | attribute_formatter(T)];
attribute_formatter([]) -> [].

percent_stripper(Line) ->
    percent_stripper_r(percent_stripper_l(Line)).

percent_stripper_l([$%|T]) -> percent_stripper_l(T);
percent_stripper_l([$\s|T]) -> percent_stripper_l(T);
percent_stripper_l(Line) -> Line.

percent_stripper_r(Line) ->
    lists:reverse(
        percent_stripper_l(
            lists:reverse(Line))).

-ifdef(TEST).

-define(XLATE(X), lists:flatten(cuttlefish_error:xlate(X))).

%% Test helpers
-spec file(string()) -> schema() | cuttlefish_error:errorlist().
file(Filename) ->
    file(Filename, {[], [], []}).
-spec string(string()) -> schema() | cuttlefish_error:errorlist().
string(S) ->
    string(S, {[], [], []}).

percent_stripper_test() ->
    ?assertEqual("hi!", percent_stripper("%%% hi!")),
    ?assertEqual("hi!", percent_stripper("%% hi!")),
    ?assertEqual("hi!", percent_stripper("% hi!")),
    ?assertEqual("hi!", percent_stripper(" hi!")),
    ?assertEqual("hi!", percent_stripper(" % % hi!")),
    ?assertEqual("hi!", percent_stripper("% % % hi!")),
    ?assertEqual("hi!", percent_stripper("% % % hi! % % %")),
    ok.

comment_parser_test() ->
    Comments = [
        " ",
        "%% @doc this is a sample doc",
        "%% it spans multiple lines %%",
        "",
        "%% there can be line breaks",
        "%% @datatype enum on, off",
        "%% @advanced",
        "%% @include_default name_substitution",
        "%% @mapping riak_kv.anti_entropy",
        "%% @see mapping.a",
        "%% @see mapping.b"
    ],
    ParsedComments = comment_parser(Comments),
    ?assertEqual(["this is a sample doc",
                  "it spans multiple lines",
                  "there can be line breaks"],
                  proplists:get_value(doc, ParsedComments)),
    ?assertEqual([["mapping.a"], ["mapping.b"]],
                 proplists:get_all_values(see, ParsedComments)),
    ok.

bad_file_test() ->
    %% The inner `erl_scan' error is preserved and wrapped with
    %% the filename for caller-side reporting.
    _ = cuttlefish_test_logging:set_up(),
    _ = cuttlefish_test_logging:bounce(),
    {errorlist, ErrorList} = file("test/bad_erlang.schema"),

    Logs = cuttlefish_test_logging:get_logs(),
    [L1|Tail] = Logs,
    [L2|[]] = Tail,
    ?assertMatch({match, _}, re:run(L1, "Error scanning erlang near line 10")),
    ?assertMatch({match, _}, re:run(L2, "Error parsing schema: test/bad_erlang.schema")),

    ?assertEqual(
       [{error, {schema_file, "test/bad_erlang.schema",
                 {error, {erl_scan, 10}}}}],
       ErrorList),
    ok.

parse_invalid_erlang_test() ->
    _ = cuttlefish_test_logging:set_up(),
    _ = cuttlefish_test_logging:bounce(),
    SchemaString = lists:flatten([
            "%% @doc some doc\n",
            "%% the doc continues!\n",
            "{mapping, \"ring_size\", \"riak_core.ring_creation_size\", [\n",
            "  {datatype, penguin}"
            "}.\n"
        ]),
    Parsed = string(SchemaString),

    [Log] = cuttlefish_test_logging:get_logs(),
    ?assertMatch({match, _}, re:run(Log, "Schema parse error near line number 4")),
    ?assertMatch({match, _}, re:run(Log, "syntax error before: ")),
    ?assertMatch({match, _}, re:run(Log, "'}'")),

   ?assertEqual({errorlist, [{error, {erl_parse, {"syntax error before: '}'", 4}}}]},
                Parsed).


parse_bad_datatype_test() ->
    _ = cuttlefish_test_logging:set_up(),
    _ = cuttlefish_test_logging:bounce(),

    SchemaString = lists:flatten([
            "%% @doc some doc\n",
            "%% the doc continues!\n",
            "{mapping, \"ring_size\", \"riak_core.ring_creation_size\", [\n",
            "  {default, \"blue\"}, ",
            "  {datatype, penguin}"
            "]}.\n"
        ]),
    _Parsed = string(SchemaString),
    ?assertEqual([], cuttlefish_test_logging:get_logs()).

files_test() ->
    %% files/1 takes a list of schemas in priority order.
    %% Loads them in reverse order, as things are overridden
    {Translations, Mappings, Validators} = files(
        [
            "test/multi1.schema",
            "test/multi2.schema",
            "test/multi3.schema"
        ]),

    ?assertEqual(6, length(Mappings)),
    [M1, M2, M3, M4, M5, M6] = Mappings,

    %% Check mappings in correct order
    io:format("~tp", [Mappings]),
    ?assertEqual(["top_level", "var1"], cuttlefish_mapping:variable(M1)),
    ?assertEqual(["a", "some", "var1"], cuttlefish_mapping:variable(M2)),
    ?assertEqual(["a", "some", "var2"], cuttlefish_mapping:variable(M3)),
    ?assertEqual(["a", "some", "var3"], cuttlefish_mapping:variable(M4)),
    ?assertEqual(["b", "some", "var1"], cuttlefish_mapping:variable(M5)),
    ?assertEqual(["b", "some", "var2"], cuttlefish_mapping:variable(M6)),


    %% Check correct mapping overrides
    ?assertEqual("app_a.big_var", cuttlefish_mapping:mapping(M1)),
    ?assertEqual("app_a.some_var1", cuttlefish_mapping:mapping(M2)),
    ?assertEqual("app_a.some_var", cuttlefish_mapping:mapping(M3)),
    ?assertEqual("app_a.some_var3", cuttlefish_mapping:mapping(M4)),
    ?assertEqual("app_b.some_var3", cuttlefish_mapping:mapping(M5)),
    ?assertEqual("app_b.some_var2", cuttlefish_mapping:mapping(M6)),

    ?assertEqual(6, length(Translations)),
    [T1, T2, T3, T4, T5, T6] = Translations,

    %% Check translation overrides
    AssertTran = fun(Mapping, Translation, Expected) ->

        %% Check Order
        ?assertEqual(Mapping, cuttlefish_translation:mapping(Translation)),
        %% Check Override
        F1 = cuttlefish_translation:func(Translation),
        ?assertEqual(Expected, F1(x))
    end,

    AssertTran("app_a.big_var",   T1, "tippedy top"),
    AssertTran("app_a.some_var1", T2, "a1"),
    AssertTran("app_a.some_var2", T3, "a2"),
    AssertTran("app_a.some_var3", T4, "toplevel"),
    AssertTran("app_b.some_var1", T5, "b3"),
    AssertTran("app_b.some_var2", T6, "b2"),

    %% One more time, for validators!
    ?assertEqual(5, length(Validators)),
    [V1, V2, V3, V4, V5] = Validators,

    %% Now check overrides
    AssertVal = fun(Name, Validator, Expected) ->
        %% Check Order
        ?assertEqual(Name, cuttlefish_validator:name(Validator)),
        %% Check Override
        F1 = cuttlefish_validator:func(Validator),
        ?assertEqual(Expected, F1(x))
    end,

    AssertVal("top.val", V1, false),
    AssertVal("a.validator1", V2, true),
    AssertVal("a.validator2", V3, false),
    AssertVal("b.validator1", V4, false),
    AssertVal("b.validator2", V5, true),

    ok.

get_see_test() ->
    Proplist = [
                {doc, ["line1", "line2", "line3"]},
                {see, ["a.b"]},
                {see, ["a.c"]}
               ],
    ?assertEqual([["a","b"],["a","c"]], get_see(Proplist)),
    ok.

see_test() ->
    String = "{mapping, \"a.b\", \"e.k\", []}.\n"
        ++ "%% @see a.b\n"
        ++ "{mapping, \"a.c\", \"e.j\", []}.\n",
    {_, Mappings, _} = strings([String]),
    ?assertEqual(2, length(Mappings)),
    [M1, M2] = Mappings,
    ?assertEqual([], cuttlefish_mapping:see(M1)),
    ?assertEqual([["a", "b"]], cuttlefish_mapping:see(M2)),
    ok.

strings_filtration_test() ->

    String = "{mapping, \"a.b\", \"e.k\", []}.\n"
          ++ "{mapping, \"a.c\", \"e.k\", []}.\n"
          ++ "{mapping, \"a.d\", \"e.j\", []}.\n"
          ++ "{mapping, \"a.e\", \"e.j\", []}.\n"
          ++ "{translation, \"e.j\", fun(X) -> \"1\" end}.\n"
          ++ "{mapping, \"b.a\", \"e.i\", []}.\n"
          ++ "{mapping, \"b.b\", \"e.i\", []}.\n"
          ++ "{mapping, \"b.c\", \"e.i\", []}.\n"
          ++ "{translation, \"e.i\", fun(X) -> \"1\" end}.\n",
    {Translations, Mappings, _} = strings([String]),
    ?assertEqual(2, length(Translations)),
    ?assertEqual(6, length(Mappings)),
    ?assertEqual(["a", "b"], cuttlefish_mapping:variable(hd(Mappings))),
    ?assertEqual(["b", "b"], cuttlefish_mapping:variable(lists:nth(5, Mappings))),
    ok.

error_test() ->
    {ErrorAtom, Errors} = strings(["tyktorp"]),
    io:format("~tp", [Errors]),
    ?assertEqual(errorlist, ErrorAtom),

    {errorlist, [{error, Error}]} = strings(["{mapping, \"a\", [{datatype, unsupported_datatype}]}."]),
    ?assertEqual(
        "Unknown parse return: {mapping,\n                          {mapping,\"a\",[{datatype,unsupported_datatype}]}}",
        ?XLATE(Error)),
    ok.

merge_across_multiple_schemas_test() ->
    StringSchema1 = "{mapping, \"a.b\", \"erlang.key\", [merge, {default, on}]}.",
    StringSchema2 = "%%@doc hi\n{mapping, \"a.b\", \"erlang.key\", [{default, off}, {datatype, flag}]}.",

    {_, Mappings, _} = strings([StringSchema1, StringSchema2]),
    ?assertEqual(1, length(Mappings)),
    [Mapping] = Mappings,
    ?assertEqual([flag], cuttlefish_mapping:datatype(Mapping)),
    ?assertEqual(on, cuttlefish_mapping:default(Mapping)),
    ?assertEqual(["hi"], cuttlefish_mapping:doc(Mapping)),
    ok.

%% Alias collision tests

alias_shadows_canonical_test() ->
    String = "{mapping, \"a.b\", \"e.k\", [{aliases, [\"c.d\"]}]}.\n"
          ++ "{mapping, \"c.d\", \"e.j\", []}.\n",
    Result = strings([String]),
    ?assertMatch({errorlist, [{error, {alias_shadows_canonical, {"c.d", "a.b"}}}]}, Result).

alias_claimed_by_multiple_mappings_test() ->
    String = "{mapping, \"a.b\", \"e.k\", [{aliases, [\"old.key\"]}]}.\n"
          ++ "{mapping, \"c.d\", \"e.j\", [{aliases, [\"old.key\"]}]}.\n",
    Result = strings([String]),
    ?assertMatch({errorlist,
        [{error, {alias_claimed_by_multiple_mappings, {"old.key", "a.b", "c.d"}}}]}, Result).

alias_multiple_collisions_reported_test() ->
    %% Two independent shadow collisions: both should be reported
    String = "{mapping, \"a.b\", \"e.k\", [{aliases, [\"old.x\"]}]}.\n"
          ++ "{mapping, \"c.d\", \"e.j\", [{aliases, [\"old.y\"]}]}.\n"
          ++ "{mapping, \"old.x\", \"e.m\", []}.\n"
          ++ "{mapping, \"old.y\", \"e.n\", []}.\n",
    {errorlist, Errors} = strings([String]),
    ?assertEqual(2, length(Errors)),
    ?assert(lists:any(fun({error, {alias_shadows_canonical, {"old.x", _}}}) -> true;
                         (_) -> false end, Errors)),
    ?assert(lists:any(fun({error, {alias_shadows_canonical, {"old.y", _}}}) -> true;
                         (_) -> false end, Errors)).

alias_no_collision_test() ->
    %% Different aliases, no collision
    String = "{mapping, \"a.b\", \"e.k\", [{aliases, [\"old.ab\"]}]}.\n"
          ++ "{mapping, \"c.d\", \"e.j\", [{aliases, [\"old.cd\"]}]}.\n",
    {_, Mappings, _} = strings([String]),
    ?assertEqual(2, length(Mappings)).

alias_no_collision_same_mapping_test() ->
    %% Multiple aliases on same mapping is fine
    String = "{mapping, \"a.b\", \"e.k\", [{aliases, [\"old.ab\", \"older.ab\"]}]}.\n",
    {_, Mappings, _} = strings([String]),
    ?assertEqual(1, length(Mappings)),
    [M] = Mappings,
    ?assertEqual([["old", "ab"], ["older", "ab"]], cuttlefish_mapping:aliases(M)).

alias_singular_from_schema_string_test() ->
    String = "{mapping, \"new.key\", \"app.setting\", [{alias, \"old.key\"}]}.\n",
    {_, [M], _} = strings([String]),
    ?assertEqual([["old", "key"]], cuttlefish_mapping:aliases(M)).

alias_shadows_canonical_across_schema_strings_test() ->
    Schema1 = "{mapping, \"a.b\", \"e.k\", [{aliases, [\"old.key\"]}]}.\n",
    Schema2 = "{mapping, \"old.key\", \"e.j\", []}.\n",
    Result = strings([Schema1, Schema2]),
    ?assertMatch({errorlist, [{error, {alias_shadows_canonical, {"old.key", "a.b"}}}]}, Result).

%% --- Tests for non-schema-file guards (Recommendations 1-3, 5). ---

merger_does_not_crash_on_first_file_failure_test() ->
    %% Previously this crashed with `function_clause' on the
    %% iteration after the first errorlist accumulator.
    BadFun = fun(_, _) -> {errorlist, [{error, {boom, "first"}}]} end,
    OkFun = fun(_, {T, M, V}) -> {T, M, V} end,
    Pairs = [{BadFun, "bad1"}, {OkFun, "good"}, {BadFun, "bad2"}],
    Result = merger(Pairs),
    ?assertMatch({errorlist, [_|_]}, Result),
    {errorlist, Errors} = Result,
    ?assert(lists:any(
              fun({error, {boom, _}}) -> true; (_) -> false end,
              Errors)).

merger_preserves_original_error_after_short_circuit_test() ->
    BadFun = fun(_, _) -> {errorlist, [{error, {original, sentinel}}]} end,
    OkFun = fun(_, {T, M, V}) -> {T, M, V} end,
    Pairs = [{OkFun, "first_good"}, {BadFun, "the_bad_one"}, {OkFun, "last_good"}],
    {errorlist, Errors} = merger(Pairs),
    ?assertEqual([{error, {original, sentinel}}], Errors).

merger_with_all_good_inputs_returns_schema_test() ->
    OkFun = fun(_, {T, M, V}) -> {T, M, V} end,
    ?assertEqual({[], [], []},
                 merger([{OkFun, "a"}, {OkFun, "b"}])).

not_a_schema_filename_is_refused_test() ->
    Result = file("test/binary.schema.bad", {[], [], []}),
    ?assertMatch({errorlist,
                  [{error, {schema_file, "test/binary.schema.bad",
                            {error, {not_a_schema_file, _}}}}]},
                 Result).

not_a_schema_filename_xlate_is_descriptive_test() ->
    {errorlist, [{error, Wrapped}]} =
        file("priv/schema/erl_crash.dump", {[], [], []}),
    Msg = lists:flatten(cuttlefish_error:xlate(Wrapped)),
    ?assert(string:find(Msg, "erl_crash.dump") =/= nomatch),
    ?assert(string:find(Msg, "not a schema file") =/= nomatch),
    ok.

missing_schema_file_returns_descriptive_error_test() ->
    Path = unique_tmp_path("missing-", ".schema"),
    Result = file(Path, {[], [], []}),
    ?assertMatch({errorlist,
                  [{error, {schema_file, _,
                            {error, {schema_file_read_error, {_, not_readable}}}}}]},
                 Result).

oversized_schema_file_is_refused_test() ->
    Path = unique_tmp_path("oversize-", ".schema"),
    Big = binary:copy(<<"x">>, 8388609),
    ok = file:write_file(Path, Big),
    try
        Result = file(Path, {[], [], []}),
        ?assertMatch(
           {errorlist,
            [{error, {schema_file, _,
                      {error, {schema_file_too_large, {_, 8388609, 8388608}}}}}]},
           Result)
    after
        file:delete(Path)
    end.

unrecognized_content_is_refused_test() ->
    Path = unique_tmp_path("garbage-", ".schema"),
    ok = file:write_file(Path, <<"=erl_crash_dump:0.5\nSomething: not schema\n">>),
    try
        Result = file(Path, {[], [], []}),
        ?assertMatch(
           {errorlist,
            [{error, {schema_file, _,
                      {error, {schema_file_unrecognized_content, _}}}}]},
           Result)
    after
        file:delete(Path)
    end.

recognises_comments_before_first_tuple_test() ->
    %% Schemas typically start with copyright comments.
    Path = unique_tmp_path("commented-", ".schema"),
    Bytes = <<"%% copyright header\n"
              "%% more comments\n"
              "{mapping, \"a.b\", \"app.k\", []}.\n">>,
    ok = file:write_file(Path, Bytes),
    try
        ?assertMatch({_, [_], _}, file(Path, {[], [], []}))
    after
        file:delete(Path)
    end.

recognises_whitespace_between_brace_and_tag_test() ->
    %% `test/riak.schema' uses `{ translation, ...}' (space after
    %% the brace).
    Path = unique_tmp_path("spaced-", ".schema"),
    Bytes = <<"{\n  \tmapping, \"a.b\", \"app.k\", []}.\n">>,
    ok = file:write_file(Path, Bytes),
    try
        ?assertMatch({_, [_], _}, file(Path, {[], [], []}))
    after
        file:delete(Path)
    end.

content_guard_rejects_non_schema_tuple_test() ->
    %% A well-formed Erlang tuple with a non-schema tag is still
    %% refused before reaching `erl_parse'.
    Path = unique_tmp_path("wrong-tag-", ".schema"),
    ok = file:write_file(Path, <<"{config, \"value\"}.\n">>),
    try
        ?assertMatch({errorlist,
                      [{error, {schema_file, _,
                                {error, {schema_file_unrecognized_content, _}}}}]},
                     file(Path, {[], [], []}))
    after
        file:delete(Path)
    end.

empty_schema_file_is_accepted_test() ->
    Path = unique_tmp_path("empty-", ".schema"),
    ok = file:write_file(Path, <<"\n  %% just a comment\n\n">>),
    try
        ?assertEqual({[], [], []}, file(Path, {[], [], []}))
    after
        file:delete(Path)
    end.

invalid_unicode_in_schema_file_is_reported_test() ->
    Path = unique_tmp_path("bad-unicode-", ".schema"),
    %% Valid schema tuple followed by `0xFF' (never legal in UTF-8).
    ok = file:write_file(Path, <<"{mapping, \"a\", \"b\", []}.", 16#FF>>),
    try
        Result = file(Path, {[], [], []}),
        ?assertMatch({errorlist,
                      [{error, {schema_file, _,
                                {error, {schema_file_invalid_unicode, _}}}}]},
                     Result)
    after
        file:delete(Path)
    end.

mixed_files_in_files_1_propagate_bad_filename_test() ->
    Path = unique_tmp_path("bogus-", ".schema"),
    ok = file:write_file(Path, <<"this is definitely not a schema file\n">>),
    try
        {errorlist, Errors} =
            files(["test/multi1.schema", Path]),
        ?assert(lists:any(
                  fun({error, {schema_file, F, _}}) -> F =:= Path;
                     (_) -> false
                  end, Errors))
    after
        file:delete(Path)
    end.

list_schemas_returns_sorted_schema_files_only_test() ->
    Dir = unique_tmp_dir("list-schemas-"),
    ok = file:write_file(filename:join(Dir, "b.schema"), <<>>),
    ok = file:write_file(filename:join(Dir, "a.schema"), <<>>),
    ok = file:write_file(filename:join(Dir, "c.schema"), <<>>),
    ok = file:write_file(filename:join(Dir, "README.md"), <<>>),
    ok = file:write_file(filename:join(Dir, "erl_crash.dump"), <<>>),
    ok = file:write_file(filename:join(Dir, ".hidden.schema"), <<>>),
    ok = file:write_file(filename:join(Dir, "backup.schema~"), <<>>),
    try
        ?assertEqual([filename:join(Dir, "a.schema"),
                      filename:join(Dir, "b.schema"),
                      filename:join(Dir, "c.schema")],
                     list_schemas(Dir))
    after
        cleanup_dir(Dir)
    end.

list_schemas_missing_dir_returns_empty_test() ->
    Dir = unique_tmp_path("nonexistent-", ""),
    ?assertEqual([], list_schemas(Dir)).

list_schemas_empty_dir_returns_empty_test() ->
    Dir = unique_tmp_dir("empty-list-"),
    try
        ?assertEqual([], list_schemas(Dir))
    after
        cleanup_dir(Dir)
    end.

list_schemas_ignores_editor_junk_test() ->
    Dir = unique_tmp_dir("editor-junk-"),
    ok = file:write_file(filename:join(Dir, "real.schema"), <<>>),
    ok = file:write_file(filename:join(Dir, ".DS_Store"), <<>>),
    ok = file:write_file(filename:join(Dir, ".real.schema.swp"), <<>>),
    try
        ?assertEqual([filename:join(Dir, "real.schema")], list_schemas(Dir))
    after
        cleanup_dir(Dir)
    end.

%% Unique temporary paths for the filesystem-touching guard tests.
unique_tmp_dir(Prefix) ->
    Path = unique_tmp_path(Prefix, ""),
    ok = file:make_dir(Path),
    Path.

unique_tmp_path(Prefix, Suffix) ->
    Unique = integer_to_list(erlang:unique_integer([positive])),
    filename:join(cuttlefish_paths:tmp_base(), Prefix ++ Unique ++ Suffix).

cleanup_dir(Dir) ->
    case file:list_dir(Dir) of
        {ok, Files} ->
            lists:foreach(
              fun(F) -> file:delete(filename:join(Dir, F)) end,
              Files);
        _ -> ok
    end,
    file:del_dir(Dir).

-endif.