%% @author Marc Worrell <marc@worrell.nl>
%% @copyright 2017-2023 Marc Worrell
%%
%% @doc Accept-Language handling.
%% @end

%% Copyright 2017-2023 Marc Worrell
%%
%% Licensed 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(cowmachine_accept_language).

-author("Marc Worrell <marc@worrell.nl").

-export([
    parse_header/1,
    accept_header/2,
    accept_list/2
    ]).

-spec parse_header(AcceptHeader) -> Result when
    AcceptHeader :: cowmachine_req:context() | binary() | undefined,
    Result :: {ok, [binary()]} | {error, nomatch | header}.
parse_header(undefined) ->
    {error, nomatch};
parse_header(AcceptHeader) when is_binary(AcceptHeader) ->
    case parse(AcceptHeader) of
        error ->
            {error, header};
        List ->
            Sorted = sort_accept(List),
            AcceptList = [ Lang || {Lang,_Prio} <- Sorted, Lang =/= <<"*">> ],
            {ok, ensure_baselangs(AcceptList)}
    end;
parse_header(Context) ->
    parse_header(cowmachine_req:get_req_header(<<"accept-language">>, Context)).

-spec accept_header(AvailableLangs, AcceptHeader) -> Result when
    AvailableLangs :: [{binary(),[ binary() ]}],
    AcceptHeader :: cowmachine_req:context() | binary() | undefined,
    Result :: {ok, binary()} | {error, nomatch | header}.
accept_header(_AvailableLangs, undefined) ->
    {error, nomatch};
accept_header(AvailableLangs, AcceptHeader) ->
    case parse_header(AcceptHeader) of
        {error, _} = Error ->
            Error;
        {ok, []} ->
            {error, nomatch};
        {ok, AcceptList} ->
            accept_list(AvailableLangs, AcceptList)
    end.

-spec parse(AcceptHeader) -> Result when
    AcceptHeader :: binary(),
    Result :: [{binary(), cow_http_hd:qvalue()}] | error.
parse(AcceptHeader) ->
    try
        cow_http_hd:parse_accept_language(AcceptHeader)
    catch
        _:_ -> error
    end.


-spec accept_list(AvailableLangs, AcceptableLangs) -> Result when   
    AvailableLangs :: [{binary(), [ binary() ]}], 
    AcceptableLangs :: [binary()],
    Result :: {ok, binary()} | {error, nomatch}.
accept_list(AvailableLangs, AcceptableLangs) ->
    case match_language(AvailableLangs, AcceptableLangs) of
        {ok, _} = OK -> OK;
        error ->
            % Map language variations like "en-gb" to "en"
            Main = main_languages(AcceptableLangs),
            case match_language(AvailableLangs, Main) of
                {ok, _} = OK -> OK;
                error -> {error, nomatch}
            end
    end.

-spec sort_accept(List) -> Result when
    List :: list(),
    Result :: list().
sort_accept([]) -> [];
sort_accept(List) ->
    lists:keysort(2, fix_order(List,1,[])).

-spec ensure_baselangs(Langs) -> Result when
    Langs :: [binary()],
    Result :: [binary()].
ensure_baselangs(Langs) ->
    lists:foldl(
        fun
            (<<A,B,$-,_/binary>> = Lang, Acc) ->
                BaseLang = <<A,B>>,
                case lists:member(BaseLang, Langs) of
                    true -> [Lang|Acc];
                    false -> [Lang,BaseLang|Acc]
                end;
            (Lang, Acc) ->
                [Lang|Acc]
        end,
        [],
        Langs).


% Modify the priority so that for languages with equal priority the first mentioned
% will be chosen.

-spec fix_order(LangList, N, Acc) -> Result when
    LangList :: [LangItem],
    LangItem :: {Lang, Prio},
    Lang :: binary(), 
    Prio :: integer(),
    N :: non_neg_integer(),
    Acc :: LangList,
    Result :: Acc.
fix_order([], _N, Acc) ->
    Acc;
fix_order([{Lang,Prio}|Langs], N, Acc) ->
    fix_order(Langs, N+1, [{Lang, Prio*100-N}|Acc]).

-spec match_language(AvailableLangs, AcceptList) -> Result when
    AvailableLangs :: [{binary(), [ binary() ]}], 
    AcceptList :: [binary()],
    Result :: {ok, binary()} | error.
match_language(AvailableLangs, AcceptList) ->
    case firstmap(fun(Lang) -> available_language(Lang, AvailableLangs) end, AcceptList) of
        {ok, _} = OK -> OK;
        error ->
            firstmap(fun(Lang) -> fallback_language(Lang, AvailableLangs) end, AcceptList)
    end.

firstmap(_Fun, []) ->
    error;
firstmap(Fun, [H|T]) ->
    case Fun(H) of
        {ok, Found} -> {ok, Found};
        error -> firstmap(Fun, T)
    end.

available_language(Lang, AvailableLangs) ->
    case lists:keymember(Lang, 1, AvailableLangs) of
        true -> {ok, Lang};
        false -> error
    end.

-spec fallback_language(Lang, [{AvailableLang,FallbackLangs}]) -> Result when
    Lang :: binary(), 
    AvailableLang :: binary(),
    FallbackLangs :: [binary()],
    Result :: error | {ok, AvailableLang}.
fallback_language(_Lang, []) ->
    error;
fallback_language(Lang, [{AvailableLang,FallbackLangs}|AvailableLangs]) ->
    case lists:member(Lang, FallbackLangs) of
        true -> {ok, AvailableLang};
        false -> fallback_language(Lang, AvailableLangs)
    end.

-spec main_languages(Accept) -> Result when
    Accept :: [binary()],
    Result :: [binary()].
main_languages(Accept) ->
    Accept1 = lists:foldl(
        fun
            (<<A,B,$-,_/binary>>, Acc) -> [<<A,B>>|Acc];
            (_, Acc) -> Acc
        end,
        [],
        Accept),
    lists:reverse(Accept1).