:- module(helper_tests, [run_helper_tests/0]).

:- use_module(library(plunit)).


%% requirements of library(struct)
:- load_files(library(str_decl),
                [when(compile_time), if(changed)]).

:- use_module(library(structs)).

:- use_module('helper.pl').

:- use_module(library(csv)).

%% type definitions for the float array
:- foreign_type
        float32          = float_32,
        float_array      = array(float32).



%%
%% TESTING Integer
%%
:- begin_tests(integer).

%% Failure 

test(integer_Input_Wrong_Input, [error(type_error(number, a),_)]) :-
        testing_Taking_IntegerI(a, _).

%% Success

test(integer_Input, [true(Return =:= 1)]) :-
        testing_Taking_IntegerI(1, Return).

test(integer_Output, [true(Return =:= 1)]) :-
        testing_Returning_IntegerI(Return).
        
:- end_tests(integer).


%%
%% TESTING Float
%%
:- begin_tests(float).

%% Failure 
test(float_Input, [true(Return =:= 0)]) :-
        testing_Taking_DoubleI(2.0, Return).

test(float_Input_Wrong_Input, [error(type_error(number, a),_)]) :-
        testing_Taking_DoubleI(a, _).


%% Success

test(float_Input, [true(Return =:= 1)]) :-
        testing_Taking_DoubleI(1.0, Return).


test(float_Output, [true(Return =:= 1.0)]) :-
        testing_Returning_DoubleI(Return).
        
:- end_tests(float).


%%
%% TESTING String
%%
:- begin_tests(string).

%% Failure 
test(string_Input, [true(Return =:= 0)]) :-
        testing_Taking_StringI(false, Return).

test(string_Input_Wrong_Input, [error(type_error(atom, 100),_)]) :-
        testing_Taking_StringI(100, _).

%% Success

test(string_Input, [true(Return =:= 1)]) :-
        testing_Taking_StringI(true, Return).

test(string_Output) :-
        testing_Returning_StringI('true').
        
:- end_tests(string).


%%
%% TESTING Vector
%%
:- begin_tests(vector).

%% Failure 

test(vector_Input_Empty_List, [true(Return=:=1)]) :-
        convert_list_to_float_array([], array(Xsize, X)),
        testing_Taking_Float_VectorI(X, Xsize, Return).

test(vector_Input_Bad_List_Input, fail) :-
        convert_list_to_float_array(2, array(Xsize, X)),
        testing_Taking_Float_VectorI(X, Xsize, _).

%% Success

test(vector_Input, [true(Return =:= 1)]) :-
        convert_list_to_float_array([1.0,2.0,3.0,4.0,5.0], array(Xsize, X)),
        testing_Taking_Float_VectorI(X, Xsize, Return).

test(vector_Input) :-
        testing_Returning_Float_VectorI(X, Xsize),
        convert_float_array_to_list(X, Xsize, [0.0,1.0,2.0,3.0,4.0]).
        
:- end_tests(vector).


%%
%% TESTING Matrix
%%
:- begin_tests(matrix).

%% Failure 
test(matrix_Input_Too_High_DataPoint_Dim, fail) :-
        convert_list_to_float_array([0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0], 20, array(Xsize, XDataPointDim,X)),
        testing_Taking_Float_MatrixI(X, Xsize, XDataPointDim, _).

test(matrix_Input_Empty_List1, fail) :-
        convert_list_to_float_array([], 2, array(Xsize, XDataPointDim,X)),
        testing_Taking_Float_MatrixI(X, Xsize, XDataPointDim, _).

test(matrix_Input_Empty_List2, fail) :-
        convert_list_to_float_array([], 0, array(Xsize, XDataPointDim,X)),
        testing_Taking_Float_MatrixI(X, Xsize, XDataPointDim, _).

test(matrix_Input_Empty_List3, fail) :-
        convert_list_to_float_array([], 1, array(Xsize, XDataPointDim,X)),
        testing_Taking_Float_MatrixI(X, Xsize, XDataPointDim, _).

test(matrix_Input_Wrong_List_Input, fail) :-
        convert_list_to_float_array(1, 2, array(Xsize, XDataPointDim,X)),
        testing_Taking_Float_MatrixI(X, Xsize, XDataPointDim, _).

test(matrix_Input_Bad_Output_Of_Data, fail) :-
        convert_list_to_float_array([0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0], 2, array(Xsize, X)),
        testing_Taking_Float_MatrixI(X, Xsize, _, _).

test(matrix_Input_Different_Input, [true(Return =:= 0)]) :-
        convert_list_to_float_array([0.0,1.0,2.0,3.0,-4.0,5.0,6.0,10.0], 2, array(Xsize, XDataPointDim,X)),
        testing_Taking_Float_MatrixI(X, Xsize, XDataPointDim, Return).

%% Success

test(matrix_Input, [true(Return =:= 1)]) :-
        convert_list_to_float_array([0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0], 2, array(Xsize, XDataPointDim,X)),
        testing_Taking_Float_MatrixI(X, Xsize, XDataPointDim, Return).

test(matrix_Output) :-
        testing_Returning_Float_MatrixI(X, XDataPointAmount, XDataPointDim),
        convert_float_array_to_2d_list(X, XDataPointAmount, XDataPointDim, [[0.0,1.0],[2.0,3.0],[4.0,5.0],[6.0,7.0]]).
        
:- end_tests(matrix).


%%
%% TESTING Conversion
%%
:- begin_tests(conversion).

%% Failure 

%% Success
test(vector_Conversion) :-
        convert_list_to_float_array([0.0,0.1,0.2,0.3], array(Xsize, X)),
        convert_float_array_to_list(X, Xsize, ResultList),
        print(ResultList),
        print('\n').


test(matrix_Conversion) :-
        open('src/data_csv/iris2.csv', read, File),
        take_csv_row(File, skipFirstRow, 2, Records),
        print(Records),
        print('\n'),
        convert_list_to_float_array(Records, 4, array(_, XDataDimension, X)),
        convert_float_array_to_2d_list(X, 2, XDataDimension, ProbsList),
        print(ProbsList),
        print('\n').
        
:- end_tests(conversion).


%%
%% TESTING Helper Predicate len/2
%%
:- begin_tests(len).

%% Failure 

test(len_Bad_Input, fail) :-
        len(1, _).

%% Success

test(len_Normal_Use, [true(Length =:= 3)]) :-
        len([1,2,3], Length).

test(len_Empty_List, [true(Length =:= 0)]) :-
        len([], Length).

test(len_Mixed_List) :-
        len([1,2,a,9.0], 4).
        
:- end_tests(len).


%%
%% TESTING Helper Predicate convert_record_to_arr/2
%%
:- begin_tests(convert_record_to_arr).

%% Failure 
test(convert_record_to_arr_Bad_Input, fail) :-
        convert_record_to_arr([1,2,3,a], _).

%% Success

test(convert_record_to_arr_Normal_Use) :-
        convert_record_to_arr([float(1.0,_), float(2.0,_), string(_)], [1.0,2.0]).
        
:- end_tests(convert_record_to_arr).


%%
%% TESTING Helper Predicate take_rows_from_iris_CSV
%%
:- begin_tests(take_rows_from_iris_CSV).

%% Failure 
test(take_rows_from_iris_CSV_Negative_Amount, fail) :-
        take_rows_from_iris_CSV(-2, _).

test(take_rows_from_iris_CSV_Taking_Too_Much, fail) :-
        take_rows_from_iris_CSV(160, _).

%% Success

test(take_rows_from_iris_CSV_Normal_Use) :-
        take_rows_from_iris_CSV(2, [5.1,3.5,1.4,0.2,4.9,3.0,1.4,0.2]).
        
:- end_tests(take_rows_from_iris_CSV).


%%
%% TESTING raising Prolog Errors
%%
:- begin_tests(errors).

%% Failure 

test(testing_Raising_SystemError_Normal_Use, [error(_, system_error('error_Message'))]) :-
        testing_Raising_SystemErrorI(error_Message).

test(testing_Raising_DomainError_Normal_Use, [error(domain_error('error_Message' , []), _)]) :-
        testing_Raising_DomainErrorI(error_Message, string).

test(testing_Raising_DomainError_Normal_Use, [error(domain_error('error_Message' , 0.0), _)]) :-
        testing_Raising_DomainErrorI(error_Message, number).

%% Success

:- end_tests(errors).


run_helper_tests :-
        run_tests.


foreign(testing_Taking_Integer, c, testing_Taking_IntegerI(+integer, [-integer])).
foreign(testing_Taking_Double, c, testing_Taking_DoubleI(+float32, [-integer])).
foreign(testing_Taking_String, c, testing_Taking_StringI(+string, [-integer])).
foreign(testing_Taking_Float_Vector, c, testing_Taking_Float_VectorI(+pointer(float_array), +integer, [-integer])).
foreign(testing_Taking_Float_Matrix, c, testing_Taking_Float_MatrixI(+pointer(float_array), +integer, +integer, [-integer])).

foreign(testing_Returning_Integer, c, testing_Returning_IntegerI(-integer)).
foreign(testing_Returning_Double, c, testing_Returning_DoubleI(-float32)).
foreign(testing_Returning_String, c, testing_Returning_StringI(-string)).
foreign(testing_Returning_Float_Vector, c, testing_Returning_Float_VectorI(-pointer(float_array), -integer)).
foreign(testing_Returning_Float_Matrix, c, testing_Returning_Float_MatrixI(-pointer(float_array), -integer, -integer)).

foreign(testing_Raising_SystemError, c, testing_Raising_SystemErrorI(+string)).
foreign(testing_Raising_DomainError, c, testing_Raising_DomainErrorI(+string, +string)).


%% Defines the functions that get connected from helper_tests.cpp
foreign_resource(helper_tests, [testing_Taking_Integer,
                                testing_Taking_Double,
                                testing_Taking_String,
                                testing_Taking_Float_Vector,
                                testing_Taking_Float_Matrix,
                                testing_Returning_Integer,
                                testing_Returning_Double,
                                testing_Returning_String,
                                testing_Returning_Float_Vector,
                                testing_Returning_Float_Matrix,
                                testing_Raising_SystemError,
                                testing_Raising_DomainError]).

:- load_foreign_resource(helper_tests).