/* is_colour_space str: is a string one of nip's colorimetric spaces
 */
is_colour_space str = Interpretation_3ary.has_key str;

/* is_colour_type n: is a number one of nip's colorimetric numbers
 */
is_colour_type n = Interpretation_3ary.has_value n;

/* is_number: is a real or a complex number.
 */
is_number a = is_real a || is_complex a;

/* is_int: is an integer
 */
is_int a = is_real a && a == (int) a;

/* is_uint: is an unsigned integer
 */
is_uint a = is_int a && a >= 0;

/* is_pint: is a positive integer
 */
is_pint a = is_int a && a > 0;

/* is_preal: is a positive real
 */
is_preal a = is_real a && a > 0;

/* is_ureal: is an unsigned real
 */
is_ureal a = is_real a && a >= 0;

/* is_letter c: true if character c is an ASCII letter
 *
 * is_letter :: char -> bool
 */
is_letter c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z');

/* is_digit c: true if character c is an ASCII digit
 *
 * is_digit :: char -> bool
 */
is_digit x = '0' <= x && x <= '9';

/* A whitespace character.
 *
 * is_space :: char -> bool
 */
is_space = member " \n\t";

/* List str starts with a prefix.
 *
 * is_prefix "hell" "hello world!" == true
 * is_prefix :: [*] -> [*] -> bool
 */
is_prefix prefix str = take (len prefix) str == prefix;

/* List str ends with a suffix.
 *
 * is_suffix "ld!" "hello world!" == true
 * is_suffix :: [*] -> [*] -> bool
 */
is_suffix suffix str = take (len suffix) (reverse str) == reverse suffix;

/* List contains sequence.
 *
 * is_substr "llo" "hello world!" == true
 * is_substr :: [*] -> [*] -> bool
 */
is_substr seq str = any (map (is_prefix seq) (iterate tl str));

/* is_listof p s: true if finite list with p true for every element.
 */
is_listof p l = is_list l && all (map p l);

/* is_string s: true if finite list of char.
 */
is_string s = is_listof is_char s;

/* is_real_list l: is l a list of real numbers ... test each element,
 * so no infinite lists pls.
 */
is_real_list l = is_listof is_real l;

/* is_string_list l: is l a finite list of finite strings.
 */
is_string_list l = is_listof is_string l;

/* is_image_list l: is l a finite list of images
 */
is_image_list l = is_listof is_image l;

/* Test list length is exactly n ... quicker than len l == n for large
 * (or infinite) lists, since it won't eval the whole of l.
 */
is_list_len 0 [] = true;
is_list_len 0 l = false;
is_list_len n [] = false;
is_list_len n a:x = is_list_len (n - 1) x;

/* Test length is strictly more than n.
 */
is_list_len_more 0 [] = false;
is_list_len_more 0 l = true;
is_list_len_more n [] = false;
is_list_len_more n a:x = is_list_len_more (n - 1) x;

/* Test length is more than or equal to n.
 */
is_list_len_more_equal 0 [] = true;
is_list_len_more_equal 0 l = true;
is_list_len_more_equal n [] = false;
is_list_len_more_equal n a:x = is_list_len_more_equal (n - 1) x;

/* is_rectangular l: is l a rectangular data structure
 */
is_rectangular l
    = true, !is_list l
    = true, all (map is_obj l)
    = true, all (map is_list l) &&
        all (map (not @ is_obj) l) &&
        all (map is_rectangular l) &&
        is_list_len_more 0 l &&
        all (map (is_list_len (len (hd l))) (tl l))
    = false
{
    // treat strings as a base type, not [char]
    is_obj x = !is_list x || is_string x;
}

/* is_matrix l: is l a list of lists of real numbers, all the same length
 *
 * [[]] is the empty matrix, [] is the empty list ... disallow []
 */
is_matrix l = is_list l && l != [] && is_listof is_real_list l && is_rectangular l;

/* is_square_matrix l: is l a matrix with width == height
 */
is_square_matrix l
      = true, l == [[]]
      = is_matrix l && is_list_len (len (hd l)) l;

/* is_odd_matrix l: is l a matrix with both sides of odd-length
 */
is_odd_matrix l
      = true, l == [[]]
      = is_matrix l && len l % 2 == 1 && len l?0 % 2 == 1;

/* is_odd_square_matrix l: is l a square_matrix with odd-length sides
 */
is_odd_square_matrix l = is_square_matrix l && len l % 2 == 1;

/* is_matrix_image x: is x a matrix or an image
 */
is_matrix_image x = is_matrix x || is_image x;

/* Is HGuide or VGuide.
 */
is_HGuide x = is_instanceof "HGuide" x;

is_VGuide x = is_instanceof "VGuide" x;

is_Guide x = is_HGuide x || is_VGuide x;

is_Mark x = is_instanceof "Mark" x;

is_Group x = is_instanceof "Group" x;

is_NULL x = is_instanceof "NULL" x;

is_List x = is_instanceof "List" x;

is_Image x = is_instanceof "Image" x;

is_Plot x = is_instanceof "Plot" x;

is_Region x = is_instanceof "Region" x;

is_Real x = is_instanceof "Real" x;

is_Matrix x = is_instanceof "Matrix_base" x;

is_Vector x = is_instanceof "Vector" x;

is_Colour x = is_instanceof "Colour" x;

is_Arrow x = is_instanceof "Arrow" x;

is_Bool x = is_instanceof "Bool" x;

is_Scale x = is_instanceof "Scale" x;

is_Rect x = is_instanceof "Rect" x;

is_Number x = is_instanceof "Number" x;

is_Expression x = is_instanceof "Expression" x;

is_String x = is_instanceof "String" x;

/* A list of the form [[1, 2], [3, 4], [5, 6] ...]
 */
is_xy_list l
    = is_list l && all (map xy l)
{
    xy l = is_real_list l && is_list_len 2 l;
}

// does a nested list structure contain a Group object?
contains_Group l
    = true, is_list l && any (map is_Group l)
    = any (map contains_Group l), is_list l
    = false;

/* Does an object have a libvips interpretation?
 */
has_interpretation x = is_image x || is_Image x || is_Arrow x || is_Colour x;

/* Try to get a VIPS image interpretation from an object.
 */
get_interpretation x
    = Interpretation.get_value x.colour_space, is_Colour x
    = vips_image_guess_interpretation (get_image x), has_image x
    // slightly odd ... but our display is always 0-255, so it makes sense for
    // a plain number to be in the same range
    = Interpretation.B_W, is_real x || (is_real_list x && len x < 3)
    = Interpretation.sRGB, is_real_list x && len x >= 3
    = oo_unary_function get_interpretation_op x, is_class x
    = error (_ "bad arguments to " ++ "get_interpretation")
{
    get_interpretation_op = Operator "get_interpretation" get_interpretation
        Operator_type.COMPOUND false;
}

has_image x = is_image x || is_Image x || is_Arrow x;

get_image x
    = x.value, is_Image x
    = x.image.value, is_Arrow x
    = x, is_image x
    = oo_unary_function get_image_op x, is_class x
    = error (_ "bad arguments to " ++ "get_image")
{
    get_image_op = Operator "get_image" get_image
        Operator_type.COMPOUND false;
}

has_header field x
    = true, is_class x && has_member field x
    = oo_unary_function has_header_op x, is_class x
    = get_header_type field x != 0, is_image x
    = false
{
    has_header_op = Operator "has_header" (has_header field)
        Operator_type.COMPOUND false;
}

get_header field x
    = get_member field x, has_member field x
    = oo_unary_function get_header_op x, is_class x
    = vips_header_get field x, is_image x
    = get_header field (get_image x), has_image x
    = error (_ "bad arguments to " ++ "get_header")
{
    get_header_op = Operator "get_header" (get_header field)
        Operator_type.COMPOUND false;
}

has_format = has_header "format";

get_format = get_header "format";

has_bands x = is_image x || has_member "bands" x || is_Arrow x;

get_bands x
    = x.bands, has_member "bands" x
    = get_header "bands" (get_image x), has_image x
    = 1, is_real x
    = len x, is_real_list x
    = oo_unary_function get_bands_op x, is_class x
    = error (_ "bad arguments to " ++ "get_bands")
{
    get_bands_op = Operator "get_bands" get_bands
        Operator_type.COMPOUND false;
}

has_coding = has_header "coding";

get_coding = get_header "coding";

has_xres = has_header "xres";

get_xres = get_header "xres";

has_yres = has_header "yres";

get_yres = get_header "yres";

has_xoffset = has_header "xoffset";

get_xoffset = get_header "xoffset";

has_yoffset = has_header "yoffset";

get_yoffset = get_header "yoffset";

has_left = has_header "left";

get_left = get_header "left";

has_top = has_header "top";

get_top = get_header "top";

has_width = has_header "width";

get_width = get_header "width";

has_height = has_header "height";

get_height = get_header "height";

has_value = has_member "value";

get_value = get_header "value";

has_number x = is_number x || is_Real x;

get_number x
    = x.value, is_Real x
    = x, is_number x
    = oo_unary_function get_number_op x, is_class x
    = error (_ "bad arguments to " ++ "get_number")
{
    get_number_op = Operator "get_number" get_number
        Operator_type.COMPOUND false;
}

has_real x = is_real x || is_Real x;

get_real x
    = x.value, is_Real x
    = x, is_real x
    = oo_unary_function get_real_op x, is_class x
    = error (_ "bad arguments to " ++ "get_real")
{
    get_real_op = Operator "get_real" get_real
        Operator_type.COMPOUND false;
}

// like has/get member, but first in a list of objects
has_member_list has objects = filter has objects != [];

// need one with the args swapped
get_member = converse dot;

// get a member from the first of a list of objects to have it
get_member_list has get objects
    = hd members, members != []
    = error "unable to get property"
{
    members = map get (filter has objects);
}

is_hist x
    = has_image x && (h == 1 || w == 1 || t == Interpretation.HISTOGRAM)
{
    im = get_image x;
    w = get_width im;
    h = get_height im;
    t = get_interpretation im;
}

get_header_type field x
    = oo_unary_function get_header_type_op x, is_class x
    = vips_header_typeof field x, is_image x
    = error (_ "bad arguments to " ++ "get_header_type")
{
    get_header_type_op = Operator "get_header_type" (get_header_type field)
        Operator_type.COMPOUND false;
}

// set core header values, eg. "interpretation" ... strings are allowed for
// enums, eg. $interpretation $lab
set_header field value x
    = oo_unary_function set_header_op x, is_class x
    = copy [field => value'] x, is_image x
    = error (_ "bad arguments to " ++ "set_header")
{
    set_header_op = Operator "set_header" (set_header field value)
        Operator_type.COMPOUND false;

    // map eg b_w to b-w
    value'
        = map (\x if x == '_' then '-' else x) value, is_string value
        = value;
}

// set metadata, eg. "banana" ... can't set core fields, no strings for enums
set_meta field value x
    = oo_unary_function set_header_op x, is_class x
    = vips_copy_set_meta x field value, is_image x
    = error (_ "bad arguments to " ++ "set_header")
{
    set_header_op = Operator "set_meta" (set_meta field value)
        Operator_type.COMPOUND false;
}
