gmconfig/src/gmconfig_schema_utils.erl

%% -*- mode: erlang; erlang-indent-level: 4; indent-tabs-mode: nil -*-
-module(gmconfig_schema_utils).
-vsn("0.2.0").


-export([get_config/0,
         set_config/1,
         get_schema/0,
         get_schema/1,   %% (Default)
         set_schema/1,
         use_schema/1,
         use_schema/2,
         schema/1,       %% (Path)
         schema/2,       %% (Path, Schema)
         schema/3,       %% (Path, Schema, Opts)
         clear/0,
         expand_ref/2,
         expand_schema/1,    %% (Schema)                 %% expand whole schema
         expand_schema/2]).  %% (SubSchema, RootSchema)

-export([ update_config/1  %% (Map) -> ok
        , merge/2          %% (Item1, Item2) -> Item3
        , merge/3          %% (Item1, Item2, Schema) -> Item3
        , valid/1          %% (Item) -> Item | error()
        , valid/2          %% (Item, Schema) -> Item | error()
        , validate/3       %% (Item, Schema, Opts) -> Item | error().
        ]).
-export([in_properties/2]).

-export([normalize/0,
         normalize/1]).

-type json_string() :: binary().
-type json_int() :: integer().
-type json_num() :: number().
-type json_null() :: 'null'.
-type json_bool() :: boolean().
-type json_simple() :: json_null() | json_string() | json_int() | json_num()
                     | json_bool().
-type json_object() :: #{json_string() => json()}.
-type json_array() :: [json()].
-type json() :: json_simple() | json_array() | json_object().

-type json_type() :: null | boolean | string | number | integer
                   | object | array.

-type schema() :: json().

-type ext_fun() :: fun( (json(), schema()) -> any() | no_return() ).
-type extensions() :: #{ binary() => ext_fun() }.
-type options() :: #{coerce => boolean(),
                     enum_to_atom => boolean(),
                     extensions => extensions() }.

-record(st, { s :: schema()  %% schema
            , r :: schema()  %% root schema
            , p = []
            , a = []         %% annotations
            , v :: json() | undefined  %% value
            , d = undefined :: list() | 'undefined'  %% dynamic eval
            , opts = #{} :: options()
            }).

-type st() :: #st{}.

-export_type([ schema/0, json/0 ]).

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

-spec set_schema(schema()) -> ok.
set_schema(Schema) ->
    persistent_term:put({?MODULE, '$schema'}, Schema).

-spec get_config() -> json().
get_config() ->
    persistent_term:get({?MODULE, '$config'}, #{}).

-spec set_config(schema()) -> ok.
set_config(Config) ->
    persistent_term:put({?MODULE, '$config'}, Config).

-spec get_schema() -> schema().
get_schema() ->
    persistent_term:get({?MODULE, '$schema'}).

-spec get_schema(Default) -> schema() | Default.
get_schema(Default) ->
    persistent_term:get({?MODULE, '$schema'}, Default).

-spec use_schema(schema() | st()) -> st().
use_schema(#st{} = St) -> St;
use_schema(S)          -> #st{s = S, r = S}.

use_schema(Schema, RootSchema) ->
    #st{s = Schema, r = RootSchema}.

normalize() ->
    normalize(get_schema()).

normalize(Schema) ->
    Schema1 = normalize_map_keys(Schema),
    normalize_values(Schema1).

normalize_map_keys(S) when is_map(S) ->
    #{bin_key(K) => normalize_map_keys(V) || K := V <- S};
normalize_map_keys(L) when is_list(L) ->
    [normalize_map_keys(S) || S <- L];
normalize_map_keys(S) ->
    S.

normalize_values(S) when is_map(S) ->
    #{K => normalize_value(K, V) || K := V <- S};
normalize_values(L) when is_list(L) ->
    [normalize_values(S) || S <- L];
normalize_values(S) ->
    S.

normalize_value(<<"type">>, [C|_] = T) when is_integer(C) ->
    bin_key(T);
normalize_value(K, L) when is_list(L) ->
    %% In some cases, the spec tells us what to do
    if K == <<"allOf">>;                         %% 10.2.1.1
       K == <<"anyOf">>;                         %% 10.2.1.2
       K == <<"oneOf">>;                         %% 10.2.1.3
       K == <<"prefixItems">> ->                 %% 10.3.1.1
            %% These MUST refer to arrays
            [normalize_values(S) || S <- L];
       K == <<"contains">> ->
            %% 10.3.1.3 Value MUST be a valid schema
            normalize_values(L);
       true ->
            try unicode:characters_to_binary(L)
            catch
                error:_ ->
                    [normalize_values(S) || S <- L]
            end
    end;
normalize_value(_, V) when is_atom(V) ->
    atom_to_binary(V, utf8);
normalize_value(_, V) when is_list(V) ->
    try unicode:characters_to_binary(V)
    catch
        error:_ ->
            [normalize_values(S) || S <- V]
    end;
normalize_value(_, V) ->
    V.

bin_key(A) when is_atom(A)   -> atom_to_binary(A, utf8);
bin_key(L) when is_list(L)   -> unicode:characters_to_binary(L);
bin_key(B) when is_binary(B) -> B.

clear() ->
    persistent_term:erase({?MODULE,'$schema'}),
    persistent_term:erase({?MODULE,'$config'}),
    ok.

-spec update_config(json()) -> json().
update_config(Cfg) ->
    OldCfg = get_config(),
    Schema = get_schema(),
    Res = merge(Cfg, OldCfg, #st{s = Schema,
                                 r = Schema }),
    set_config(Res),
    Res.

-spec merge(json(), json()) -> json().
merge(A, B) ->
    merge(A, B, get_schema()).

-spec merge(json(), json(), schema() | st()) -> json().
merge(A, B, #st{} = St) ->
    merge_(A, B, St);
merge(A, B, Schema) ->
    merge_(A, B, #st{s = Schema, r = Schema}).

%% Neither the JSON spec or the JSON-Schema spec are very helpful
%% regarding what takes precedence if dynamically evaluated parts
%% conflict with the base schema. The jsonschemavalidator.net version
%% is actually non-deterministic in this regard. So let's just pick one
%% approach that seems sensible.
%%
-spec schema_prop(Prop, State, SubSchemas, Default) -> json()
        when Prop       :: json_string()
           , State      :: st()
           , SubSchemas :: [st()]
           , Default    :: json().
schema_prop(P, Schema, Ss, Default) ->
    case any_schema_prop(P, Schema, Ss) of
        {ok, V} ->
            V;
        error ->
            Default
    end.

any_schema_prop(P, S0, [S|Ss]) ->
    case schema_prop_find(P, S) of
        {ok, _} = Ok -> Ok;
        error ->
            any_schema_prop(P, S0, Ss)
    end;
any_schema_prop(P, S, []) ->
    schema_prop_find(P, S).

schema_prop_find(P, #st{s = S} = St) when is_map(S) ->
    case maps:find(P, S) of
        {ok, #{<<"$ref">> := Sub} = M} when map_size(M) == 1 ->
            D = expand_ref(Sub, St),
            {ok, D};
        Other -> Other
    end;
%% schema_find(P, #st{s = S}) when is_map(S) ->
%%     maps:find(P, S);
schema_prop_find(_, _) ->
    error.

schema_get(P, #st{s = S}, Default) when is_map(S) ->
    maps:get(P, S, Default);
schema_get(_, _, Default) ->
    Default.

%% let us pattern-match on a schema map
%% all schemas that are not a map are converted to the empty map.
schema_map(Map, _) when is_map(Map) -> Map;
schema_map(_, _) -> #{}.

-spec merge_(json(), json(), st()) -> json().
merge_(A, B, #st{} = St0) ->
    {Ss, St} = schemas_from_dynamic_eval(A, St0#st{d = undefined}),
    case schema_prop(<<"readOnly">>, St, Ss, false) of
        true when B == null ->
            valid(A, St);
        true ->
            fail(read_only, St);
        false ->
            merge_(A, B, St, Ss)
    end.

merge_(A, B, St, Ss) ->
    Type = get_type(St, Ss, A),
    case Type of
        object ->
            update_object(A, B, St, Ss);
        _ ->
            valid(A, Type, St, Ss)
    end.

update_semantics(A, St, Ss) ->
    case maps:find(<<"$updateSemantics">>, schema_map(A, St)) of
        {ok, _} = Ok ->
            {Ok, object};
        error ->
            {any_schema_prop(<<"updateSemantics">>, St, Ss), schema}
    end.

remove_semantic_props(O, Sem, Where) when is_map(O) ->
    Recursive = case {Sem, Where} of
                    {{ok, <<"replace">>}, object} -> true;
                    _ -> false
                end,
    remove_props(O, [<<"$updateSemantics">>], Recursive);
remove_semantic_props(Other, _, _) ->
    Other.

remove_props(O, Keys, Recurse) when is_map(O) ->
    if Recurse ->
            maps:map(fun(_, V) ->
                             remove_props(V, Keys, Recurse)
                     end, maps:without(Keys, O));
       true ->
            maps:without(Keys, O)
    end;
remove_props(Other, _, _) ->
    Other.

get_type(#st{} = St0, Value) ->
    {Ss, St} = schemas_from_dynamic_eval(Value, St0),
    {get_type(St, Ss, Value), St}.

get_type(#st{} = St, Ss, Value) ->
    case any_schema_prop(<<"type">>, St, Ss) of
        {ok, Type} when is_binary(Type); is_list(Type) ->
            select_type(Type, Value, St);
        error ->
            try infer_type(Value)
            catch
                _:_ ->
                    fail(invalid, St)
            end
    end.

select_type(TBin, Value, St) ->
    case TBin of
        <<"null">> -> null;
        <<"boolean">> -> boolean;
        <<"object">> -> object;
        <<"array">>  -> array;
        <<"number">> -> number;
        <<"integer">> -> integer;
        <<"string">> -> string;
        Types when is_list(Types) ->
            pick_a_type(Types, Value, St);
        _ ->
            fail(invalid_schema, St)
    end.

infer_type(V) ->
    if is_map(V) -> object;
       is_integer(V) -> integer;
       is_number(V)  -> number;
       is_boolean(V) -> boolean;
       is_binary(V)  -> string;
       is_list(V)    -> array;
       V == null     -> null
    end.

-spec pick_a_type([json_string()], json(), st()) -> json_type().
pick_a_type([H|T], Value, St) ->
    case H of
        <<"object">> when is_map(Value)      -> object;
        <<"array">>  when is_list(Value)     -> array;
        <<"number">> when is_number(Value)   -> number;
        <<"integer">> when is_integer(Value) -> integer;
        <<"string">> when is_binary(Value)   -> string;
        <<"boolean">> when is_boolean(Value) -> boolean;
        _ -> pick_a_type(T, Value, St)
    end;
pick_a_type([], Value, St) ->
    fail(wrong_type, St#st{v = Value}).

%% Updating objects is the tricky bit. We need to check for anyOf, etc.
%% since we can't simply join elements from disjunct schemas.
-spec update_object(json(), json_object(), st(), [st()]) -> json_object().
update_object(A0, B, St, Ss) ->
    {Sem, Where} = update_semantics(A0, St, Ss),
    A = remove_semantic_props(A0, Sem, Where),
    case Sem of
        {ok, <<"replace">>} ->
            valid(A, object, St, Ss);
        {ok, <<"merge">>} ->
            update_object_(A, B, St, Ss);
        {ok, <<"suggest">>} ->
            if B == null; map_size(B) == 0 ->
                    valid(A, object, St, Ss);
               true ->
                    update_object_(A, B, St, Ss)
            end;
        error ->
            if is_map(A), is_map(B) ->
                    update_object_(A, B, St, Ss);
               true ->
                    valid(A, object, St, Ss)
            end
    end.

update_object_(New, Old, St, Ss) ->
    Dyn = acc_props(Ss),
    {SsOld, _} = schemas_from_dynamic_eval(Old, St#st{d = undefined}),
    PropSchemas = [{P, prop_schema(P, Dyn, St)} || P <- maps:keys(New)],
    try do_update_object(New, Old, St, PropSchemas)
    catch
        error:E when Ss =/= SsOld ->
            %% Merging failed. Try replacing. If this fails,
            %% go with the error raised by the first attempt.
            try valid(New, object, St, Ss)
            catch
                error:_ ->
                    error(E)
            end
    end.

do_update_object(New, Old, St, PropSchemas) ->
    Res = lists:foldl(
            fun({P, S}, Acc) ->
                    S1 = push_path(P, S),
                    V = maps:get(P, New),
                    case maps:find(P, Old) of
                        {ok, OldV} ->
                            Acc#{P => merge(V, OldV, S1)};
                        error ->
                            Acc#{P => valid(V, S1)}
                    end
            end, Old, PropSchemas),
    valid(Res, object, St).

validate(V, Schema, Opts) when is_map(Opts) ->
    St0 = use_schema(Schema),
    St = St0#st{opts = Opts},
    V1 = valid(V, St),
    case Opts of
        #{enum_to_atom := true} ->
            convert_enums(V1, St);
        _ ->
            V1
    end.

convert_enums(V, St0) when is_binary(V) ->
    case get_type(St0, V) of
        {string, St} ->
            {Ss, St1} = schemas_from_dynamic_eval(V, St),
            case any_schema_prop(<<"enum">>, St1, Ss) of
                {ok, _} ->
                    binary_to_atom(V, unicode);
                _ ->
                    V
            end;
        _ ->
            V
    end;
convert_enums(V, St0) when is_map(V) ->
    {Ss, St} = schemas_from_dynamic_eval(V, St0),
    Dyn = acc_props(Ss),
    maps:map(
      fun(P, Vp) ->
              PSchema = prop_schema(P, Dyn, St),
              convert_enums(Vp, push_path(P, s(PSchema, St)))
      end, V);
convert_enums(V, St0) when is_list(V) ->
    {Ss,St} = schemas_from_dynamic_eval(V, St0),
    case any_schema_prop(<<"items">>, St, Ss) of
        {ok, Is} ->
            [convert_enums(Vi, push_path(items, s(Is, St)))
             || Vi <- V];
        error ->
            case any_schema_prop(<<"prefixItems">>, St, Ss) of
                {ok, PfxIs} ->
                    [convert_enums(Vi, push_path(prefixItems, s(PfxIs, St)))
                     || Vi <- V];
                error ->
                    V
            end
    end;
convert_enums(V, _) ->
    V.

valid(V) ->
    valid(V, get_schema()).

valid(V, #st{} = St) ->
    valid_(V, St#st{v = V});
valid(V, Schema) ->
    valid(V, #st{p = [], s = Schema, r = Schema, v = V}).

valid_(V, #st{s = true}) -> V;
valid_(_, #st{s = false} = St) -> fail(invalid, St);
valid_(V, St0) ->
    {Type, St} = get_type(St0, V),
    valid(V, Type, St).

valid(V, _, #st{s = true}) -> V;
valid(_, _, #st{s = false} = St) -> fail(invalid, St);
valid(V, Type, St0) ->
    %% We run dynamic eval to find conditional parts of the schema.
    %% we keep these in a separate list.
    {Ss,St} = schemas_from_dynamic_eval(V, St0),
    valid(V, Type, St, Ss).

valid(V, Type, St, Ss) ->
    _ = valid_const(V, Type, St, Ss),
    _ = valid_enum(V, Type, St, Ss),
    %% Dynamic eval returns a list of matching schemas
    %% We pass them along as they may contain properties,
    %% but `V` has already been validated against them.
    case Type of
        object  -> valid_object(V, push_path(object, St), Ss);
        integer -> valid_number(V, integer, push_path(integer, St), Ss);
        number  -> valid_number(V, number, push_path(number, St), Ss);
        string  -> valid_string(V, push_path(string, St), Ss);
        array   -> valid_array(V, push_path(array, St), Ss);
        boolean -> valid_boolean(V, push_path(boolean, St), Ss);
        null    -> valid_null(V, push_path(null, St), Ss)
    end.

split_valid(V, St, Ss) ->
    split_valid(V, 0, St, Ss, [], []).
split_valid(V, Ix, St, [S|Ss], Yes, No) ->
    try valid(V, push_path(Ix, s(S, St))) of
        _ -> split_valid(V, Ix+1, St, Ss, [{Ix,S}|Yes], No)
    catch
        error:Err ->
            split_valid(V, Ix+1, St, Ss, Yes, [{Ix, Err}|No])
    end;
split_valid(_, _, _, [], Yes, No) ->
    {lists:reverse(Yes), lists:reverse(No)}.

-spec valid_const(any(), json_type(), st(), [st()]) -> json().
valid_const(V, Type, St, Ss) ->
    case any_schema_prop(<<"const">>, St, Ss) of
        error -> V;
        {ok, C} ->
            case is_equal(Type, V, C) of
                true -> ok;
                false ->
                    fail(not_in_enum, push_path(const, St))
            end
    end.

valid_enum(V, Type, St, Ss) ->
    case any_schema_prop(<<"enum">>, St, Ss) of
        error -> V;
        {ok, En} ->
            case lists:any(fun(X) ->
                                    is_equal(Type, V, X)
                           end, En) of
                true ->
                    V;
                false ->
                    fail(not_in_enum, push_path(enum, St))
            end
    end.

-spec valid_object(any(), st(), [st()]) -> json_object().
valid_object(O, #st{s = true}, []) -> O;
valid_object(_, #st{s = false} = St, []) -> fail(invalid, St);
valid_object(O, St, Ss) when is_map(O) ->
    Dyn = acc_props(Ss),
    PropSchemas = [{P, prop_schema(P, Dyn, St)} || P <- maps:keys(O)],
    MinP = schema_prop(<<"minProperties">>, St, Ss, 0),
    OSz = length(PropSchemas),
    MaxP = schema_prop(<<"maxProperties">>, St, Ss, OSz),
    assert(fun(Sz) -> Sz >= MinP end, OSz,
           min_properties, push_path(min_properties, St)),
    assert(fun(Sz) -> Sz =< MaxP end, OSz,
           max_properties, push_path(max_properties, St)),
    Required = schema_prop(<<"required">>, St, Ss, []),
    case [P || P <- Required, not lists:keymember(P, 1, PropSchemas)] of
        [] -> ok;
        RPs -> fail(required, add_anno(RPs, push_path(required, St)))
    end,
    lists:foreach(
        fun({P, #st{} = S}) ->
            valid(maps:get(P, O), push_path(P, S#st{d = undefined}))
        end, PropSchemas),
    O;
valid_object(_, St, _) ->
    fail(wrong_type, St).

-spec valid_boolean(json(), st(), [st()]) -> json_bool().
valid_boolean(V, #st{s = true}, []) -> V;
valid_boolean(_, #st{s = false} = St, []) -> fail(invalid, St);
valid_boolean(<<"true">> , #st{opts = #{coerce := true}}, _) -> true;
valid_boolean(<<"false">>, #st{opts = #{coerce := true}}, _) -> false;
valid_boolean(V, St, _) ->
    assert_type(fun is_boolean/1, V, St),
    V.

valid_null(N, #st{s = true}, []) -> N;
valid_null(_, #st{s = false} = St, []) -> fail(invalid, St);
valid_null(<<"null">>, #st{s = null, opts = #{coerce := true}}, _) -> null;
valid_null(null, #st{s = null}, _) ->
    null;
valid_null(_, St, _) ->
    fail(wrong_type, St).


valid_string(S, #st{s = true}, []) -> S;
valid_string(_, #st{s = false} = St, []) -> fail(invalid, St);
valid_string(S, St, Ss) when is_binary(S) ->
    P = schema_prop(<<"pattern">>, St, Ss, <<>>),
    try re:run(S, P, []) of
        {match, _} -> ok;
        nomatch    -> fail(no_match, St)
    catch
        error:_ -> fail(no_match, St)
    end,
    Sz = byte_size(S),
    Lmin = schema_prop(<<"minLength">>, St, Ss, 0),
    Lmax = schema_prop(<<"maxLength">>, St, Ss, Sz),
    assert_min(Sz, Lmin, min_length, St),
    assert_max(Sz, Lmax, max_length, St),
    valid_enum(S, string, St, Ss);
valid_string(_, St, _) ->
    fail(wrong_type, St).


valid_number(N, _, #st{s = true}, []) -> N;
valid_number(_, _, #st{s = false} = St, []) -> fail(invalid, St);
valid_number(I, Sub, #st{opts = #{coerce := true}} = St, Ss) when is_binary(I) ->
    try coerce_num(Sub, I) of
        I1 ->
            valid_number_(I1, Sub, St#st{v = I1}, Ss)
    catch
        error:_ ->
            fail(wrong_type, St)
    end;
valid_number(I, Sub, St, Ss) when is_number(I) ->
    valid_number_(I, Sub, St, Ss);
valid_number(_, _, St, _) ->
    fail(wrong_type, St).

valid_number_(I, Sub, St, Ss) when is_number(I) ->
        [assert_type(fun is_integer/1, I, St) || Sub == integer],
    case any_schema_prop(<<"multipleOf">>, St, Ss) of
        error -> ok;
        {ok, X} when is_integer(X), X > 0 ->
            %% The spec says:
            %%
            %% "6.2.1. multipleOf
            %% The value of "multipleOf" MUST be a number, strictly greater than 0.
            %%
            %% A numeric instance is valid only if division by
            %% this keyword's value results in an integer."
            %%
            %% Not sure how to implement (or use!) this reliably without
            %% forcing both I and X to be integers, so this is what we'll do.
            assert_schema(fun pos_int/1, X, push_path(multipleOf, St)),

            St1 = add_anno(X, push_path(multipleOf, St)),
            try I rem X of
                  0 -> ok;
                  _ -> fail(not_a_multiple, St1)
            catch
                _:_ ->
                    fail(not_a_multiple, St1)
            end
    end,
    Min = schema_prop(<<"minimum">>, St, Ss, I),
    Max = schema_prop(<<"maximum">>, St, Ss, I),
    test_range('>=', Max, I, add_anno(Max, push_path(maximum, St))),
    test_range('=<', Min, I, add_anno(Min, push_path(minimum, St))),
    EMin = schema_prop(<<"exclusiveMinimum">>, St, Ss, I-1),
    EMax = schema_prop(<<"exclusiveMaximum">>, St, Ss, I+1),
    test_range('>', EMax, I, add_anno(EMax, push_path(exclusiveMaximum, St))),
    test_range('<', EMin, I, add_anno(EMin, push_path(exclusiveMinimum, St))),
    I.

coerce_num(integer, I) when is_binary(I) ->
    binary_to_integer(I);
coerce_num(number, I) when is_binary(I) ->
    try binary_to_integer(I)
    catch
        error:_ ->
            binary_to_float(I)
    end.

valid_array(A, #st{s = true}, []) -> A;
valid_array(_, #st{s = false} = St, []) -> fail(invalid, St);
valid_array(A, #st{} = St, Ss) when is_list(A) ->
    Len = length(A),
    MaxIs = schema_prop(<<"maxItems">>, St, Ss, Len),
    MinIs = schema_prop(<<"minItems">>, St, Ss, 0),
    assert_schema(fun non_neg_int/1, MaxIs, push_path(maxItems, St)),
    assert_schema(fun non_neg_int/1, MinIs, push_path(minItems, St)),
    test_range('>=', MaxIs, Len, add_anno(MaxIs, push_path(maxItems, St))),
    test_range('=<', MinIs, Len, add_anno(MinIs, push_path(minItems, St))),
    Uniq = schema_prop(<<"uniqueItems">>, St, Ss, false),
    assert_schema(fun is_boolean/1, Uniq, push_path(uniqueItems, St)),
    [assert(fun uniqueItems/1, A, not_unique, push_path(uniqueItems, St)) || Uniq],
    PfxItems = any_schema_prop(<<"prefixItems">>, St, Ss),
    case any_schema_prop(<<"items">>, St, Ss) of
        {ok, Is} ->
            case PfxItems of
                {ok, PfxIs} ->
                    assert_schema(fun is_list/1, PfxIs, push_path(prefixItems, St)),
                    check_prefix_items(
                      PfxIs, A, Is, push_path(prefixItems, s(PfxIs, St)));
                  error ->
                      check_items(A, push_path(items, s(Is, St)))
              end;
        error ->
            case PfxItems of
                {ok, PfxIs} ->
                    assert_schema(fun is_list/1, PfxIs, push_path(prefixItems, St)),
                    check_prefix_items(
                      PfxIs, A, true, push_path(prefixItems, s(PfxIs, St)));
                error ->
                    ok
            end
    end,
    case any_schema_prop(<<"contains">>, St, Ss) of
        {ok, Cs} ->
            check_contains(A, push_path(contains, s(Cs, St)),
                           schema_prop(<<"minContains">>, St, Ss, null),
                           schema_prop(<<"maxContains">>, St, Ss, null));
        error ->
            ok
    end,
    A;
valid_array(_, St, _) ->
    fail(wrong_type, St).

test_range(Op, X, I, St) ->
    assert_schema(fun is_number/1, X, St),
    try erlang:Op(X, I) of
        true  -> ok;
        false -> fail(not_in_range, St)
    catch
        error:_ ->
            fail(not_in_range, St)
    end.

-spec check_prefix_items([schema()], [json()], schema(), st()) -> ok.
check_prefix_items(Is, A, Items, St) when is_list(Is), is_list(A) ->
    check_prefix_items(Is, A, 0, Items, St);
check_prefix_items(_, _, _, St) ->
    fail(invalid, St).

check_prefix_items([I|Is], [H|T], Ix, Items, St) ->
    _ = valid(H, push_path(Ix, s(I, St))),
    check_prefix_items(Is, T, Ix+1, Items, St);
check_prefix_items(_, [], _, _, _) ->
    ok;
check_prefix_items([], Rest, Ix, Items, St) ->
    check_items(Rest, Ix, push_path(items, s(Items, St))).

check_items(A, St) ->
    check_items(A, 0, St).

check_items([H|T], Ix, St) ->
    _ = valid(H, push_path(Ix, St)),
    check_items(T, Ix+1, St);
check_items([], _, _) ->
    ok.

check_contains(A, St, Min, Max) ->
    check_contains(A, 0, St, Min, Max, [], []).

check_contains([H|T], Ix, St, Min, Max, Yes, No) ->
    try valid(H, push_path(Ix, St)) of
        _ -> check_contains(T, Ix+1, St, Min, Max, [Ix|Yes], No)
    catch
        error:_ ->
            check_contains(T, Ix+1, St, Min, Max, Yes, [Ix|No])
    end;
check_contains([], _, St, Min, Max, Yes, _No) ->
    case {Yes, Min, Max} of
        {[_|_], null, null} ->
            ok;
        {[], null, _} ->
            fail(contains, St);
        _ ->
            YesLen = length(Yes),
            if is_integer(Max) ->
                    _ = valid(YesLen,
                              push_path(max,
                                        s(#{<<"maximum">> => Max}, St)));
               true -> ok
            end,
            if is_integer(Min) ->
                    _ = valid(YesLen,
                              push_path(min,
                                        s(#{<<"minimum">> => Min}, St)));
               true ->
                    ok
            end
    end.

prop_schema(P, Dyn, St) ->
    try_props([fun() -> in_dyn(P, Dyn, St) end,
               fun() -> in_properties(P, St) end,
               fun() -> in_patternprops(P, St) end,
               fun() -> in_additionalprops(P, St) end,
               fun() -> unevaluated_or_true(St) end
              ]).

try_props([F|Fs]) ->
    case F() of
        {ok, S} -> S;
        error ->
            try_props(Fs)
    end;
try_props([]) ->
    %% If we don't find anything, validation doesn't fail.
    %% (empty schema validates everything)
    true.

in_dyn(P, Dyn, St) ->
    case maps:find(P, Dyn) of
        {ok, S1} ->
            {ok, add_anno(dynamic_eval, St#st{s = S1})};
        error ->
            error
    end.

in_properties(P, St) ->
    case maps:find(P, schema_get(<<"properties">>, St, #{})) of
        {ok, S1} ->
            {ok, add_anno(properties, St#st{s = S1})};
        error ->
            error
    end.

in_patternprops(P, S) ->
    case any_pattern(schema_get(<<"patternProperties">>, S, #{}), P) of
        {ok, S1} ->
            {ok, add_anno(patternProperties, S#st{s = S1})};
        error ->
            error
    end.

in_additionalprops(_, St) ->
    case schema_prop_find(<<"additionalProperties">>, St) of
        error -> error;
        {ok, S} ->
            {ok, add_anno(additionalProperties, St#st{s = S})}
    end.

unevaluated_or_true(St) ->
    case schema_prop_find(<<"unevaluatedProperties">>, St) of
        error -> {ok, add_anno(no_unevaluated, St#st{s = true})};
        {ok, S} ->
            {ok, add_anno(unevaluated, St#st{s = S})}
    end.

any_pattern(Ps, P) ->
    I = maps:iterator(Ps),
    any_pattern_(maps:next(I), P).

any_pattern_(none, _) ->
    error;
any_pattern_({Pat, Schema, I}, P) ->
    case re:run(P, Pat, []) of
        {match, _} ->
            {ok, Schema};
        nomatch ->
            any_pattern_(maps:next(I), P)
    end.

maybe_expand_ref(#st{s = S} = St) ->
    case S of
        #{<<"$ref">> := Ref} ->
            St#st{s = expand_ref(Ref, St)};
        _ ->
            St
    end.

schemas_from_dynamic_eval(_, #st{d = Ss} = St) when Ss =/= undefined ->
    {Ss, St};
schemas_from_dynamic_eval(Obj, #st{s = Schema} = St0) ->
    St = maybe_expand_ref(St0),
    SMap = schema_map(Schema, St),
    Ss =
    maps:fold(
      fun(<<"allOf">>, Ss, Acc) ->
              St1 = push_path(allOf, St),
              case split_valid(Obj, St, Ss) of
                  {ValidSs, []} ->
		      Acc ++ [s(S, St1) || {_, S} <- ValidSs];
                  {_, FailedSs} ->
		      fail(failing_schemas, add_anno(FailedSs, St1))
              end;
         (<<"anyOf">>, Ss, Acc) ->
              St1 = push_path(anyOf, St),
              case split_valid(Obj, St1, Ss) of
                  {[_|_] = ValidSs, _} ->
                      Acc ++ [s(S, St1) || {_, S} <- ValidSs];
                  {[], FailedSs} ->
                      fail(no_matching_schema, add_anno(FailedSs, St1))
              end;
         (<<"oneOf">>, Ss, Acc) ->
	      St1 = push_path(oneOf, St),
              case split_valid(Obj, St1, Ss) of
                  {[{_, S}], _} ->
		      Acc ++ [s(S, St1)];
		  {[_|_] = MoreValid, _} ->
		      ValidIxs = [I || {I,_} <- MoreValid],
		      fail(more_than_one, add_anno({valid, ValidIxs}, St1));
		  {[], _} ->
		      fail(no_matching_schema, St1)
              end;
         (<<"if">>, S, Acc) ->
	      St1 = push_path('if', St),
              try valid(Obj, s(S, St1)) of
                  _ ->
                      Sthen =
                          push_path(
                            'then', s(maps:get(<<"then">>, SMap, #{}), St1)),
                      _ = valid(Obj, Sthen),
                      Acc ++ [Sthen]
              catch
                  error:_ ->
                      Selse =
                          push_path(
                            'else', s(maps:get(<<"else">>, SMap, #{}), St1)),
                      _ = valid(Obj, Selse),
                      Acc ++ [Selse]
              end;
	 (<<"not">>, S, Acc) ->
              Snot = push_path('not', s(S, St)),
	      try valid(Obj, Snot) of
		  _ -> fail(invalid, Snot)
	      catch
		  error:_ ->
		      Acc
	      end;
         (<<"x-", _/binary>> = Prop, SExt, Acc) ->
              case St#st.opts of
                  #{extensions := #{Prop := ExtF}} ->
                      St1 = push_path(Prop, St),
                      call_extension(ExtF, Obj, SExt, Prop, St1),
                      Acc;
                  _ ->
                      Acc
              end;
         (_, _, Acc) ->
              Acc
      end, [], SMap),
    {Ss, St#st{d = Ss}}.

call_extension(F, Obj, S, Prop, St) ->
    try F(Obj, S)
    catch
        error:E ->
            fail(extended_check, add_anno({Prop, E}, St))
    end.

acc_props(Ss) ->
    lists:foldl(
      fun(#st{} = S, Acc1) ->
              case schema_prop_find(<<"properties">>, S) of
                  error -> Acc1;
                  {ok, Ps} ->
                      maps:merge(Acc1, Ps)
              end
      end, #{}, Ss).

s(S, #st{} = St) ->
    St#st{s = S, d = undefined}.

push_path(Ps, #st{p = P0} = St) when is_list(Ps) ->
    %% Assume Ps is in reverse order
    St#st{p = Ps ++ P0};
push_path(P, #st{p = P0} = St) ->
    St#st{p = [P|P0]}.

add_anno(A, #st{a = Ann} = St) ->
    St#st{a = [A|Ann]}.

assert_schema(F, X, St) ->
    assert(F, X, invalid_schema, St).

assert_type(F, X, St) ->
    assert(F, X, wrong_type, St).

fail(Error, #st{p = Path0, a = Ann, v = Val, s = S}) ->
    error(#{e => Error, p => lists:reverse(Path0),
            a => Ann, v => Val, s => S}).

is_equal(_Type, A, B) ->
    A == B.

assert(F, X, Err, #st{} = St) when is_function(F, 1) ->
    assert(fun() -> F(X) end, Err, St).

assert(F, Err, St) when is_function(F, 0) ->
    try F() of
        true -> ok;
        false -> fail(Err, St)
    catch
        error:_ ->
            fail(Err, St)
    end.

assert_min(V, Min, EInfo, St) ->
    assert(fun(X) -> X >= Min end, V, EInfo, St).
                    
assert_max(V, Min, EInfo, St) ->
    assert(fun(X) -> X =< Min end, V, EInfo, St).

-spec non_neg_int(any()) -> boolean().
non_neg_int(I) ->
    is_integer(I) andalso I >= 0.

-spec pos_int(any()) -> boolean().
pos_int(I) ->
    is_integer(I) andalso I > 0.

uniqueItems(L) ->
    USorted = lists:usort(L),
    [] == L -- USorted.

expand_schema(S) ->
    %% S = expand_definitions(S0),
    expand_schema(S, S).

%% expand_definitions(#{<<"definitions">> := D} = S) ->
%%     S#{<<"definitions">> := expand_schema(D, S)}.

expand_schema(#{<<"$ref">> := Path} = V, S0) when map_size(V) == 1 ->
    expand_schema(expand_ref(Path, use_schema(S0)), S0);
expand_schema(S, S0) when is_map(S) ->
    %% https://json-schema.org/understanding-json-schema/structuring#dollarref
    %% When $id is used in a subschema, it indicates an embedded schema.
    %% The identifier for the embedded schema is the value of $id
    %% resolved against the Base URI of the schema it appears in.
    %% A schema document that includes embedded schemas is called a
    %% Compound Schema Document. Each schema with an $id in a
    %% Compound Schema Document is called a Schema Resource.
    S1 = case maps:find(<<"$id">>, S) of
             {ok, _} ->
                 S;
             error ->
                 S0
         end,
    maps:fold(fun(K, V, Acc) -> expand_schema_(K, V, Acc, S1) end, #{}, S);
%% expand_schema([#{<<"$ref">> := Path} = V], S0) when map_size(V) == 1 ->
%%     D = expand_ref(Path, S0),
%%     [expand_schema(D, S0)];
expand_schema(S, S0) when is_list(S) ->
    [expand_schema(E, S0) || E <- S];
expand_schema(S, _) ->
    S.

expand_schema_(K, #{<<"$ref">> := Path} = V, Acc, S0) when map_size(V) == 1 ->
    D = expand_ref(Path, use_schema(S0)),
    Acc#{K => D};
expand_schema_(K, V, Acc, S0) ->
    Acc#{K => expand_schema(V, S0)}.

expand_ref(R, _, #{follow_refs := false}) ->
    R;
expand_ref(R, S, _) ->
    expand_ref(R, use_schema(S)).

expand_ref(<<"#">>, #st{r = R}) ->
    %% The $ref keyword may be used to create recursive schemas that refer to themselves.
    %% This done by using `{"$ref" : "#"}`
    R;
expand_ref(<<"#/", Path/binary>>, #st{r = S}) ->
    Key = filename:split(Path),
    case schema(Key, S, #{follow_refs => false}) of
        {ok, #{<<"$ref">> := _}} ->
            %% a $ref referring to another $ref could cause an infinite loop
            %% in the resolver, and is explicitly disallowed.
            %%
            %% Example:
            %% {
            %%   "$defs": {
            %%     "alice": { "$ref": "#/$defs/bob" },
            %%     "bob": { "$ref": "#/$defs/alice" }
            %%   }
            %% }
            %%
            error(nested_references);
        {ok, Def} ->
            Def;
        undefined ->
            error(unknown_ref, [Path])
    end;
expand_ref(<<"#", Anchor/binary>>, #st{r = S}) ->
    case find_anchor(Anchor, S) of
        {ok, Ss} ->
            Ss;
        error ->
            error({unknown_anchor, Anchor})
    end.

%% get_schema_by_path([T|P], #{<<"type">> := Ts} = S) when is_atom(T) ->
%%     case atom_to_binary(T, utf8) of
%%         Ts ->
%%             get_schema_by_path(P, S);
%%         Prop when is_map_key(Prop, S) ->
%%             get_schema_by_path(P, maps:get(Prop, S));
%%         _ ->
%%             error(invalid_schema_path)
%%     end;
%% get_schema_by_path([Property|P], #{<<"properties">> := Ps} = S) when is_binary(Property) ->
%%     get_schema_by_path(P, maps:get(Property, Ps));
%% get_schema_by_path([], S) ->
%%     S.

%% == Anchor search (unoptimized - must search whole root schema)

find_anchor(Anchor, S) when map_get(<<"$anchor">>, S) =:= Anchor ->
    {ok, S};
find_anchor(Anchor, S) when is_map(S) ->
    Iter = maps:iterator(S),
    map_search_anchor(maps:next(Iter), Anchor);
find_anchor(Anchor, S) when is_list(S) ->
    list_search_anchor(S, Anchor);
find_anchor(_, _) ->
    error.

map_search_anchor({_K, V, I}, Anchor) ->
    case find_anchor(Anchor, V) of
        {ok, _} = Ok ->
            Ok;
        error ->
            map_search_anchor(maps:next(I), Anchor)
    end;
map_search_anchor(none, _) ->
    error.

list_search_anchor([H | T], Anchor) ->
    case find_anchor(Anchor, H) of
        {ok, _} = Ok ->
            Ok;
        error ->
            list_search_anchor(T, Anchor)
    end;
list_search_anchor([], _) ->
    error.

%% ==

schema(Path) ->
    schema(Path, get_schema()).

schema(Path, Schema) ->
    schema(Path, Schema, #{follow_refs => true}).

schema(Path, #st{s = Schema, r = RootSchema}, Opts) ->
    schema_(Path, Schema, RootSchema, Opts);
schema(Path, Schema, Opts) ->
    schema_(Path, Schema, Schema, Opts).

schema_([H|T], Schema, RootSchema0, Opts) ->
    RootSchema = set_rootschema(Schema, RootSchema0),
    case Schema of
        #{<<"$schema">> := _, <<"properties">> := #{H := Tree}} ->
            schema_find(T, Tree, RootSchema, Opts);
        #{'$schema' := _, properties := #{H := Tree}} ->
            schema_find(T, Tree, RootSchema, Opts);
        #{H := Tree} ->
            schema_find(T, Tree, RootSchema, Opts);
        _ ->
            undefined
    end;
schema_([], Schema, _, _) ->
    {ok, Schema};
schema_(Key, Schema, RootSchema, Opts) ->
    case maps:find(Key, Schema) of
        {ok, #{<<"$ref">> := R} = S1} when map_size(S1) == 1 ->
            case maps:get(follow_refs, Opts, true) of
                true ->
                    D = expand_ref(R, RootSchema, Opts),
                    {ok, D};
                false ->
                    {ok, S1}
            end;
        {ok, _} = Ok -> Ok;
        error        -> undefined
    end.

schema_find([H|T], S, RS, Opts) ->
    case S of
        #{<<"properties">> := #{H := Tree}} ->
            schema_find(T, Tree, set_rootschema(Tree, RS), Opts);
        #{<<"patternProperties">> := Tree} ->
            schema_match(H, Tree, T, RS, Opts);
        #{properties := #{H := Tree}} ->
            schema_find(T, Tree, set_rootschema(Tree, RS), Opts);
        #{patternProperties := Tree} ->
            schema_match(H, Tree, T, RS, Opts);
        Map when is_map(Map) ->
            case maps:find(H, Map) of
                {ok, #{<<"$ref">> := R} = M} when map_size(M) == 1 ->
                    case maps:get(follow_refs, Opts, true) of
                        true ->
                            D = expand_ref(R, RS, Opts),
                            schema_find(T, D, RS, Opts);
                        false ->
                            schema_find(T, M, RS, Opts)
                    end;
                {ok, Tree} ->
                    schema_find(T, Tree, RS, Opts);
                error ->
                    undefined
            end;
        _ ->
            schema_inspect([H|T], S, RS, Opts)
    end;
schema_find([], S, _, _) ->
    {ok, S}.

schema_match(P, Tree, T, RS, Opts) ->
    case any_pattern(Tree, P) of
        {ok, SubTree} ->
            schema_find(T, SubTree, set_rootschema(SubTree, RS), Opts);
        error ->
            undefined
    end.

set_rootschema(#{<<"$id">> := _} = S, _) ->
    S;
set_rootschema(_, S) ->
    S.

schema_inspect([H|T], S, RS, Opts) ->
    case S of
        #{<<"properties">> := #{<<"oneOf">> := Alts}} ->
            case map_list_search(H, Alts) of
                false ->
                    undefined;
                #{H := Tree} ->
                    schema_find(T, Tree, set_rootschema(Tree, RS), Opts)
            end;
        #{properties := #{oneOf := Alts}} ->
            case map_list_search(H, Alts) of
                false ->
                    undefined;
                #{H := Tree} ->
                    schema_find(T, Tree, set_rootschema(Tree, RS), Opts)
            end;
        _ ->
            undefined
    end.

map_list_search(K, [H|T]) ->
    case maps:is_key(K, H) of
        true ->
            H;
        false ->
            map_list_search(K, T)
    end;
map_list_search(_, []) ->
    false.