package utils::support::moo_validations;

use strict;
use warnings;
use Carp;
use Scalar::Util qw(blessed);
use Scalar::Util::Numeric qw(:all);
use Switch;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(validates is_valid errors);
our @EXPORT_OK = qw(register_validator);

my %VALIDATORS = (
    presence => \&_presense_validator,
    numericality => \&_numericality_validator,
    length => \&_length_validator,
    #with => \&_with_validator;
);

my %THINGS = ();

sub validates {
    my ($fields, %args) = @_;
    my $caller = caller;

    my $thing = $THINGS{$caller};

    $fields = [$fields] if ref($fields) ne 'ARRAY';

    my $all_on = delete $args{on};
    my $all_message = delete $args{message};
    my $all_allow_blank = delete $args{allow_blank};

    foreach my $field (@$fields) {

        my $field_validators = $thing->{fields}->{$field} //= [];

        while (my ($validator, $options) = each %args) {

            if (not exists $VALIDATORS{$validator}) {
                croak "There is no validator registered with name $validator";
            }

            if  (not ref($options) eq 'HASH') {
                my $option = $options;
                $options = {};
                if (ref($option) eq 'ARRAY') {
                    $options->{in} = $option;
                } else {
                    $options->{with} = $option;
                }
            }

            my $on = delete $options->{on} || $all_on || 'all';
            my $message = delete $options->{message} || $all_message;
            my $allow_blank = delete $options->{allow_blank} || $all_allow_blank;

            my $validation_options = {
                on => $on,
                message => $message,
                allow_blank => $allow_blank
            };

            push @$field_validators, {
                validator => $VALIDATORS{$validator},
                args => $options,
                options => $validation_options
            };

        }

    }

    return;
}

sub is_valid {
    my ($self, @args) = @_;
    my $class = blessed $self;

    if (@args % 2 != 0) {
        my ($field, %args) = @args;
        return _validate_field($self, $field, %args);
    }

    my $thing = $THINGS{$class};

    my $valid = 1;
    $self->{_validation_errors} = {};

    foreach my $field (keys %{$thing->{fields}}) {
        my $field_valid = _validate_field($self, $field, @args);
        $valid &&= $field_valid;
    }

    return $valid;
}

sub _validate_field {
    my ($self, $field, %args) = @_;
    my $class = blessed $self;

    my $thing = $THINGS{$class};
    my $field_valid = 1;
    my $for = $args{for} || 'all';

    my $field_validators = $thing->{fields}->{$field} // [];

    foreach my $validation (@$field_validators) {

        my $validator = $validation->{validator};
        my $validator_args = $validation->{args};
        my $options = $validation->{options};

        my $on = $options->{on};
        my $message = $options->{message};
        my $allow_blank = $options->{allow_blank};

        my $validator_messages = [];

        next unless ($on eq 'all' || $on eq $for);

        my $field_value = $self->$field;

        next if ($allow_blank && (not defined $field_value || $field_value eq ""));

        my $valid = $validator->(
            $self->$field,
            %$validator_args,
            messages => $validator_messages
        );

        if (not $valid) {
            $self->errors($field => $message || $validator_messages);
            $field_valid = 0;
        }
    }

    return $field_valid;
}

sub errors {
    my ($self, %args) = @_;
    my $class = blessed $self;

    $self->{_validation_errors} //= {};

    if (keys %args == 0) {
        return $self->{_validation_errors};
    }

    while (my ($field, $error_messages) = each %args) {
        my $field_errors = $self->{_validation_errors}->{$field} //= [];
        $error_messages = [$error_messages] if ref($error_messages) ne 'ARRAY';
        push @$field_errors, @$error_messages;
    }

    return;
}

sub register_validator {
    my ($name, $sub) = @_;

    if (not ref($sub) eq 'CODE') {
        croak 'Validator subroutine must be a CODE ref';
    }

    if (exists $VALIDATORS{$name}) {
        carp "A Validator subroutine with name $name already exists";
    }

    $VALIDATORS{$name} = $sub;

    return;
}

sub _presense_validator {
    my ($value, %config) = @_;

    my $required = $config{with} || $config{is} || 1;
    my $present = defined $value && $value ne "";
    my $pass = $required == $present;

    if (not $pass) {
        push @{$config{messages}}, " must be present.";
    }

    return $pass;
}

sub _numericality_validator {
    my ($value, %config) = @_;

    my $messages = delete $config{messages};
    my $only_integer = !! delete $config{only_integer};

    if ($only_integer) {
        unless (isint($value)) {
            push @$messages, " is not an integer";
            return 0;
        }
    } else {
        my $numericality = !! delete $config{with} || 1;
        unless (isnum($value) == $numericality) {
            push @$messages, $numericality ? " is not a number" : " is a number";
            return 0;
        }
    }

    my %numericality_options = %config;
    my $pass = 1;

    while (my ($option, $option_value) = each %numericality_options) {

        unless ($option eq 'odd' || $option eq 'even') {
            croak "$option must be a number" if (not isnum($option_value));
        }

        switch ($option) {
            case 'greater_than' {
                unless ($value > $option_value) {
                    push @$messages, " is not greater than $option_value";
                    $pass = 0;
                }
            }
            case 'greater_than_or_equal_to' {
                unless ($value >= $option_value) {
                    push @$messages, " is not greater than or equal to $option_value";
                    $pass = 0;
                }
            }
            case 'equal_to' {
                unless ($value == $option_value) {
                    push @$messages, " is not equal to $option_value";
                    $pass = 0;
                }
            }
            case 'less_than' {
                unless ($value < $option_value) {
                    push @$messages, " is not less than $option_value";
                    $pass = 0;
                }
            }
            case 'less_than_or_equal_to' {
                unless ($value <= $option_value) {
                    push @$messages, " is not less than or equal to $option_value";
                    $pass = 0;
                }
            }
            case 'odd' {
                unless ($value % 2 == 1) {
                    push @$messages, " is not a odd number";
                    $pass = 0;
                }
            }
            case 'even' {
                unless ($value % 2 == 0) {
                    push @$messages, " is not a even number";
                    $pass = 0;
                }
            }
        }
    }

    return $pass;
}

sub _length_validator {
    my ($value, %config) = @_;

    my $messages = delete $config{messages};

    my ($option) = keys %config;
    my $option_value = $config{$option};
    my $value_length = length $value;
    my $pass = 1;

    switch ($option) {
        case ['within', 'in'] {
            my ($min, $max) = @$option_value;
            if ($value_length < $min || $value_length > $max) {
                push @$messages, " is the wrong length (should be between $min and $max characters)";
                $pass = 0;
            }
        }
        case 'is' {
            if ($value_length != $option_value) {
                push @$messages, " is the wrong length (should be $option_value characters)";
                $pass = 0;
            }
        }
        case 'minimum' {
            if ($value_length < $option_value) {
                push @$messages, " is too short (minimum is $option_value characters)";
                $pass = 0;
            }
        }
        case 'maxmimum' {
            if ($value_length > $option_value) {
                push @$messages, " is too long (maximum is $option_value characters)";
                $pass = 0;
            }
        }
    }

    return $pass;
}

sub import {
    my $class = shift;
    my $caller = caller;

    my $thing = $THINGS{$caller} = {
        fields => {}
    };

    no strict 'refs';
    no warnings 'redefine';

    my $import = $caller->can('import');

    *{"$caller\::import"} = sub {
        # Attempt to check at compile time
        # if validate fields exists on object
        foreach my $field (keys %{$thing->{fields}}) {
            if (not $caller->can($field)) {
                croak "Field: $field is not available on $caller";
            }
        }

        if ($import) {
            $import->(@_);
        }
    };

    __PACKAGE__->export_to_level(1, @_);
}

1;