%%% This file is part of RefactorErl.
%%%
%%% RefactorErl is free software: you can redistribute it and/or modify
%%% it under the terms of the GNU Lesser General Public License as published
%%% by the Free Software Foundation, either version 3 of the License, or
%%% (at your option) any later version.
%%%
%%% RefactorErl is distributed in the hope that it will be useful,
%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%%% GNU Lesser General Public License for more details.
%%%
%%% You should have received a copy of the GNU Lesser General Public License
%%% along with RefactorErl.  If not, see <http://plc.inf.elte.hu/erlang/>.
%%%
%%% The Original Code is RefactorErl.
%%%
%%% The Initial Developer of the Original Code is Eötvös Loránd University.
%%% Portions created  by Eötvös Loránd University and ELTE-Soft Ltd.
%%% are Copyright 2007-2025 Eötvös Loránd University, ELTE-Soft Ltd.
%%% and Ericsson Hungary. All Rights Reserved.


%%% @doc This  module  compares  the clauses  of an  Erlang  syntax  tree to
%%% a RefactorErl database.

%%% @author Ely Deckers <e.deckers@student.ru.nl>

-module(refqc_tc_clauses).

-vsn("$Rev: 17551 $").

-include_lib("referl_qc/include/qc.hrl").

-export([referl_eq/2]).

-author("Ely Deckers <e.deckers@student.ru.nl>").

%% @spec referl_eq(Scope::list(),Node::syntaxTree()) -> bool()
%%
%% @doc Verify that a Clause parsed by Erlang is the same as the one in
%% the database (Guard,Patterns and Bodies are equal).
referl_eq([Scope],Node) ->
    ?QCTCLOG:writepath("?QCTCCLAUSE:referl_eq",Scope,Node),

    %Compare guards.
    IsValidGuard = compare_guard(Scope,Node),

    %Only check patterns when guard is valid.
    if IsValidGuard ->
        PatternsOK = compare_patterns(Scope,Node);
    true ->
        PatternsOK = false
    end,

    if PatternsOK ->
        %Guard and Patterns validated, result is the validation of Bodies.
        compare_bodies(Scope,Node);
    true ->
        false
    end;
referl_eq(Scopes,Node) when is_list(Scopes) ->
    ComparedClauses = [ referl_eq([Scope],Node) || Scope <- Scopes ],

    %Return exactly 1 true.
    (length(lists:filter( true_filter(), ComparedClauses )) == 1);
referl_eq(Scope,Node) ->
    referl_eq([Scope],Node).

%% @private
%%
%% @spec compare_guard(Scope,syntaxTree()) -> bool()
%%
%% @doc Compares tge Guard of a clause in a certain Scope.
compare_guard(Scope,Node) ->
    Guard = erl_syntax:clause_guard(Node),

    GuardScope = ?Query:exec(Scope,?Clause:guard()),
    guard_eq(GuardScope,Guard).

%% @private
%%
%% @spec compare_patterns(Scope::list(),Node::syntaxTree()) -> bool()
%%
%% @doc Compares Patterns of a clause in a certain Scope.
compare_patterns(Scope,Node) ->
    Patterns = erl_syntax:clause_patterns(Node),

    %compare all referl patterns with erl patterns.
    PatternScopeL = ?Query:exec(Scope,?Clause:patterns()),
    case PatternScopeL of
        [] ->
            ?QCTCLOG:append("?QCTCCLAUSE:referl_eq (no patterns)"),
            (length(Patterns) == 0);
        PatternScope ->
            % PatternScope contains all patterns of the clause. Here all
            % erl_syntax patterns are compared to PatternScope. A list
            % containing exactly one 'true' atoms should be the result.
            ComparedPatterns = [ pattern_eq(PatternScope,Pattern) ||
                                    Pattern <- Patterns ],
            (length(lists:filter( true_filter(), ComparedPatterns )) == 1)
    end.

%% @private
%%
%% @spec compare_bodies(Scope,syntaxTree()) -> true | false
%%
%% @doc Compares Bodies of a clause in a certain Scope.
compare_bodies(Scope,Node) ->
    Bodies = erl_syntax:clause_body(Node),

    BodyScope = ?Query:exec(Scope,?Clause:body()),

    % BodyScope contains all bodies of the clause. Here all
    % erl_syntax bodies are compared to BodyScope. A list
    % containing one or more 'true' atoms should be the result.

    ComparedBodies = [ body_eq(BodyScope,Body) ||
                        Body <- Bodies ],
    (length(lists:filter( true_filter(), ComparedBodies )) > 0).

%% @private
%%
%% @spec guard_eq(Scope,Node) -> true | false
%%
%% @doc Compare the Erlang guard of a clause to that in the RefErl db.
guard_eq(Scope,none) ->
    ?QCTCLOG:append("?QCTCCLAUSE:guard_eq (Node=none)"),
    (Scope == []);
guard_eq([],Node) ->
    ?QCTCLOG:append("?QCTCCLAUSE:guard_eq (Scope=[])"),
    (Node == none);
guard_eq(Scope,Node) when is_list(Scope) ->
    ?QCTCLOG:writepath("?QCTCCLAUSE:guard_eq (always true, fixme)",Scope,Node),
    
    handle_guard(Scope,Node);
guard_eq(Scope,Node) ->
    guard_eq([Scope],Node).

handle_guard(Scope,Node) ->
    % The Node is a disjunction of a list of conjunctions.
    Conjunctions = erl_syntax:disjunction_body(Node),
    ConBodies = [ hd(erl_syntax:conjunction_body(Conjunction)) ||
                Conjunction <- Conjunctions ],
    Results = [ ?QCTCCOMPARE:traverse(Scope,[ConBody]) || ConBody <- ConBodies ],

    %TODO: Should return exaclty length(Conjunctions) 'true' atoms.
    (length(lists:filter( true_filter(), Results )) > 0).

%% @private
%%
%% @spec pattern_eq(Scope,Node) -> true | false
%%
%% @doc Compare the Erlang patterns of a clause to those in the RefErl db.
pattern_eq(Scope,Node) when is_list(Scope) ->
    Patterns = Scope,    %alias.

    %It's ?QCTCCLAUSE:pattern_eq's responsibility to 'extract' expressions
    %before sending them to ?QCTCCOMPARE:traverse.
    Compared = [ ?QCTCCOMPARE:traverse( ?QCTCEXPR:referl_sub(Pattern), Node )
                    || Pattern <- Patterns ],

    %Was at least one 'true' atom returned?
    NOTrue = length(lists:filter( true_filter(), Compared )),
    Result = (NOTrue > 0),

    log_pattern_eq(Scope,Node,length(Patterns),NOTrue),

    Result;
pattern_eq(Scope,Node) ->
    pattern_eq([Scope],Node).


%% @private
%%
%% @spec body_eq(Scope,Node) -> true | false
%%
%% @doc Compare the Erlang bodies of a clause to those in the RefErl db.
body_eq(Scope,Body) when is_list(Scope) ->
    ?QCTCLOG:writepath("?QCTCCLAUSE:body_eq",Scope,Body),

    ComparisonResults = [ body_eq_sub(SubScope,Body) || SubScope <- Scope ],
    ComparedString = [ atom_to_list(Result) || Result <- ComparisonResults ],

    ?QCTCLOG:writepath(["?QCTCCLAUSE:body_eq|compared: ",ComparedString],Scope,Body),

    (length(lists:filter( true_filter(), ComparisonResults )) > 0);
body_eq(Scope,Body) ->
    body_eq([Scope],Body).

%% @private
%%
%% @spec body_eq_sub(Scope,Body) -> true | false
%%
%% @doc Helper function for body_eq.
body_eq_sub(Scope,Body) ->
    Type = ?Expr:type(Scope),
    ?QCTCLOG:append(["?QCTCCLAUSE:body_eq_sub: ",atom_to_list(Type)]),
    ?QCTCEXPR:referl_eq(Scope,Body).

%% TODO: Move to a general-purpose module
%% @private
%%
%% @spec true_filter() -> function()
%%
%% @doc For use as a filter function in lists:filter. It filters out
%% everything but the 'true' atom.
true_filter() ->
    (fun(X) -> X==true end).

%% @private
%%
%% @spec log_pattern_eq(Scope::list(),Node::syntaxTree(),
%% NOPatterns::integer(),Result::bool()) -> ok
%%
%% @doc For use as a filter function in lists:filter. It filters out
%% everything but the <em>true</em> atom.
log_pattern_eq(Scope,Node,NOPatterns,Result) ->
    Type = erl_syntax:type(Node),
    if (Type==atom) ->
        ComparedString = erl_syntax:atom_name(Node);
    true ->
        ComparedString = atom_to_list(erl_syntax:variable_name(Node))
    end,

    ?QCTCLOG:writepath(["?QCTCCLAUSE:pattern_eq (",ComparedString,",",
                        atom_to_list(Type),"): P",integer_to_list(NOPatterns),
                        "R",integer_to_list(Result)],Scope,Node).
