#!/usr/bin/env snip

// test snip language features

// all the image formats we test, and their matching number format
// we can't use uchar as a number format directly since it'll become 'a' or
// whatever and arithmetic ops will start failing
fmts = [
    ["uchar", cast_unsigned_char, cast_unsigned_int @ cast_unsigned_char],
    ["char", cast_signed_char, cast_signed_int @ cast_signed_char],
    ["ushort", cast_unsigned_short, cast_unsigned_short],
    ["short", cast_signed_short, cast_signed_short],
    ["uint", cast_unsigned_int, cast_unsigned_int],
    ["int", cast_signed_int, cast_signed_int],
    ["float", cast_float, cast_float],
    ["double", cast_double, cast_double],
    ["complex", cast_complex, cast_complex],
    ["dcomplex", cast_double_complex, cast_double_complex]
];

// we need a to_real that does images as well
to_real2 x
    = abs x, is_complex x
    = mean x, is_Image x
    = x;

// numbers we test
numbers = [-10, 0, 1, 10, 3.1415927];

test_unary op_name fn
    = [test fname ifmt nfmt x :: [fname, ifmt, nfmt] <- fmts; x <- numbers]
{
    test fname ifmt nfmt x
        = [status, message]
    {
        status = abs (image - number) < 0.001 && abs (matrix - number) < 0.001;
        message = join_sep " " (map print [
            "unary", fname, op_name, x, "==", image, number, matrix
        ]);
        image = (to_real2 @ fn @ ifmt @ to_image) x;
        number = (to_real2 @ fn @ nfmt) x;
        //matrix = (to_real2 @ fn @ ifmt @ to_matrix) x;
        matrix = image;
    }
}

test_binary op_name fn
    = [test fname ifmt nfmt x y ::
         [fname, ifmt, nfmt] <- fmts; x <- numbers; y <- numbers]
{
    // image == number can fail due to rounding differences
    test fname ifmt nfmt x y
        = [status, message]
    {
        status = abs (image - number) < 0.001 && abs (matrix - number) < 0.001;
        message = join_sep " " (map print [
            "binary", fname, x, op_name, y, "==", image, number, matrix
        ]);
        image = to_real2 (fn ((ifmt @ to_image) x) ((ifmt @ to_image) y));
        number = to_real2 (fn (nfmt x) (nfmt y));
        //matrix = to_real2 (fn ((ifmt @ to_matrix) x) ((ifmt @ to_matrix) y));
        matrix = image;
    }
}

test_deconstruct = [
    [test_deconstruct, "deconstruct"],
    [test_struct_deconstruct, "structure deconstruct"],
    [test_arg_deconstruct, "argument deconstruct"],
    [test_list_deconstruct, "list deconstruct"],
    [test_arg_list_deconstruct, "arg list deconstruct"]
]
{
    [a] = [12];
    test_deconstruct = a == 12;

    [12, (13, b)] = [12, (13, 14)];
    test_struct_deconstruct = b == 14;

    fred [a] = 12;
    test_arg_deconstruct = fred [99] == 12;

    c:d = [1, 2];
    test_list_deconstruct = c == 1 && d == [2];

    jim (a:x) = a:[1, 2];
    test_arg_list_deconstruct = jim [3] == [3, 1, 2];
}

global_factorial 1 = 1;
global_factorial n = n * global_factorial (n - 1);

test_multidef = [
    [test_local_multidef, "local multiple definitions"],
    [test_global_multidef, "global multiple definitions"],
    [test_multidef_list_pattern, "list pattern multiple definitions"]
]
{
    factorial 1 = 1;
    factorial n = n * factorial (n - 1);
    test_local_multidef = factorial 3 == 6;

    test_global_multidef = global_factorial 3 == 6;

    foldr fn st [] = st;
    foldr fn st (x:xs) = fn x (foldr fn st xs);
    sum = foldr add 0;
    test_multidef_list_pattern = sum [1..10] == 55;
}

test_lcomp = [
    [test_lconst, "list const in lcomp"],
    [test_nested_lconst, "nested list const in lcomp"],
    [test_nested_lcomp, "nested lcomp"],
    [test_multiple_nested_lconst, "multiple nested list const in lcomp"],
    [test_nested_filter_lcomp, "nested filtered lcomp"],
    [test_multiple_filter_lcomp, "multiple filtered lcomp"]
]
{
    test_lconst = [[y] :: y <- [1..3]] == [[1], [2], [3]];
    test_nested_lconst = [[[y]] :: y <- [1..3]] == [[[1]], [[2]], [[3]]];
    test_nested_lcomp = [[[x, y] :: x <- [1..3]] :: y <- [1..3]] ==
        [[[1, 1], [2, 1], [3, 1]],
         [[1, 2], [2, 2], [3, 2]],
         [[1, 3], [2, 3], [3, 3]]];
    test_multiple_nested_lconst = [[[[x, y]]] :: y <- [1..3]; x <- [1..3]] ==
        [[[[1, 1]]], [[[2, 1]]], [[[3, 1]]],
         [[[1, 2]]], [[[2, 2]]], [[[3, 2]]],
         [[[1, 3]]], [[[2, 3]]], [[[3, 3]]]];
    test_nested_filter_lcomp =
        [[[x, y] :: x <- [1..3]; x != y] :: y <- [1..3]] ==
            [[[2, 1], [3, 1]],
             [[1, 2], [3, 2]],
             [[1, 3], [2, 3]]];
    test_multiple_filter_lcomp =
        [[x, y] :: x <- [1..3]; y <- [1..3]; x != y] ==
            [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]];
}

test_concat = [
    [hd [1, error "nope"] == 1, "lazy hd"]
];

main
    = concat (map unit_test [
	    test_binary "add" add,
	    test_binary "subtract" subtract,
	    test_binary "multiply" multiply,
	    test_binary "divide" test_div,
	    test_unary "square" square,
	    test_unary "constant plus" (add 12),
	    test_unary "plus constant" (converse add 12),
	    test_unary "divided by constant" (converse test_div 3),
	    test_unary "multiply constant" (multiply 7),
	    test_unary "constant multiplied by" (converse multiply 7),
	    test_unary "constant subtracted from" (subtract 4),
	    test_unary "subtract constant" (converse subtract 4),
	    test_deconstruct,
	    test_multidef,
	    test_lcomp,
        test_concat
    ])
{
    // libvips image divide sets 0 for divide by zero
    test_div a b
        = 0, is_real b && b == 0
        = 0, is_complex b && re b == 0 && im b == 0
        = divide a b;
}

