package Test2::Workflow::Task;
use strict;
use warnings;

use Carp qw/croak/;
use Scalar::Util qw/reftype/;

use overload(
    'fallback' => 1,
    '&{}' => sub {
        my $self = shift;
        my @caller = caller(0);
        update_mask($caller[1], $caller[2], '*', {restart => 1, stop => 1, 3 => 'CONTINUE'});
        my $out = sub { $self->iterate(@_) };
        set_sub_name(__PACKAGE__ . '::iterator', $out)
            if CAN_SET_SUB_NAME();
        return $out;
    },
);

use Test2::API qw/test2_stack run_subtest no_context/;
use Test2::Util qw/try/;

use Test2::Workflow qw/push_workflow_vars pop_workflow_vars/;
use Test2::Workflow::Util qw/CAN_SET_SUB_NAME set_sub_name update_mask/;

use Test2::Util::HashBase qw{
    unit args runner
    no_final no_subtest
    stage
    _buildup_idx _teardown_idx
    exception
    failed events pending
};

sub STAGE_BUILDUP()  { 0 }
sub STAGE_PRIMARY()  { 1 }
sub STAGE_TEARDOWN() { 2 }
sub STAGE_COMPLETE() { 3 }

sub init {
    my $self = shift;

    croak "Attribute 'unit' is required"
        unless $self->{+UNIT};

    $self->{+ARGS} ||= [];

    $self->reset;
}

sub finished {
    my $self = shift;
    return 1 if $self->{+EXCEPTION};
    return 1 if $self->{+STAGE} >= STAGE_COMPLETE();

    return 0;
}

sub subtest {
    my $self = shift;
    return 0 if $self->{+NO_SUBTEST};

    my $meta = $self->{+UNIT}->meta;
    return $meta->{mini} ? 0 : 1 if $meta && defined($meta->{mini});

    return 0 if $self->{+NO_FINAL};
    return 1;
}

sub reset {
    my $self = shift;

    $self->{+STAGE}         = STAGE_BUILDUP();
    $self->{+_BUILDUP_IDX}  = 0;
    $self->{+_TEARDOWN_IDX} = 0;
    $self->{+FAILED}        = 0;
    $self->{+EVENTS}        = 0;
    $self->{+PENDING}       = 0;
    $self->{+EXCEPTION}     = undef;
}

sub _have_primary {
    my $self = shift;

    my $primary = $self->{+UNIT}->primary;

    # Make sure we have primary, and that it is a ref
    return 0 unless $primary;
    return 0 unless ref $primary;

    # code ref is fine
    my $type = reftype($primary);
    return 1 if $type eq 'CODE';

    # array ref is fine if it is populated
    return 0 unless $type eq 'ARRAY';
    return @$primary;
}

sub run {
    my $self = shift;

    return if $self->finished;

    my $unit = $self->{+UNIT};

    return if $unit->filtered;

    my $ctx = $unit->context;

    my $meta = $unit->meta;

    # Skip?
    if (my $reason = $meta->{skip}) {
        $self->{+STAGE} = STAGE_COMPLETE();
        $ctx->skip($unit->name, $reason);
        return;
    }

    # Make sure we have something to do!
    unless ($self->_have_primary) {
        return if $unit->is_root;
        $self->{+STAGE} = STAGE_COMPLETE();
        $ctx->ok(0, $unit->name, ['No primary actions defined! Nothing to do!']);
        return;
    }

    my $vars;
    $vars = push_workflow_vars({}) unless $self->{+NO_FINAL};

    if ($self->subtest) {
        $ctx->do_in_context(
            \&run_subtest,
            $self->{+UNIT}->name,
            sub {
                $self->iterate();
                return if $self->{+EVENTS};
                my $ctx = Test2::API::context();
                $ctx->ok(0, "EVENT CHECK", ["No events were generated"]) unless $self->{+EXCEPTION};
                $ctx->release;
            },
            'buffered'
        );
    }
    else {
        no_context { $self->iterate() };

        $ctx->ok(0, $unit->name, ["No events were generated"])
            unless $self->{+EVENTS} || $self->{+NO_FINAL} || $self->{+EXCEPTION};

        if (!($self->{+NO_FINAL} || $meta->{mini})) {
            $ctx->ok(!$self->{+FAILED}, $unit->name)
        }
        elsif($self->{+FAILED}) {
            $ctx->diag($ctx->trace->debug);
        }
    }

    pop_workflow_vars($vars) if $vars;

    # In case something is holding a reference to vars itself.
    %$vars = ();
    $vars = undef;

    return;
}

sub iterate {
    my $self = shift;

    $self->{+PENDING}-- if $self->{+PENDING};

    return if $self->finished;

    my ($ok, $err) = try {
        $self->_run_buildups  if $self->{+STAGE} == STAGE_BUILDUP();
        $self->_run_primaries if $self->{+STAGE} == STAGE_PRIMARY();
        $self->_run_teardowns if $self->{+STAGE} == STAGE_TEARDOWN();
    };

    unless ($ok) {
        $self->{+FAILED}++;
        $self->{+EXCEPTION} = $err;
        $self->unit->context->send_event('Exception', error => $err);
    }

    return;
}

sub _run_buildups {
    my $self = shift;

    my $buildups = $self->{+UNIT}->buildup;

    # No Buildups
    unless ($buildups) {
        $self->{+STAGE} = STAGE_PRIMARY() if $self->{+STAGE} == STAGE_BUILDUP();
        return;
    }

    while ($self->{+_BUILDUP_IDX} < @$buildups) {
        my $bunit = $buildups->[$self->{+_BUILDUP_IDX}++];
        if ($bunit->wrap) {
            $self->{+PENDING}++;
            $self->runner->run(unit => $bunit, no_final => 1, args => [$self]);
            if ($self->{+PENDING}) {
                $self->{+PENDING}--;
                my $ctx = $bunit->context;
                my $trace = $ctx->trace->debug;
                die "Inner sub was never called $trace\n";
            }
        }
        else {
            $self->runner->run(unit => $bunit, no_final => 1, args => $self->{+ARGS});
        }
    }

    $self->{+STAGE} = STAGE_PRIMARY() if $self->{+STAGE} == STAGE_BUILDUP();
}

sub intercept {
    my $self = shift;

    my $ctx = $self->{+UNIT}->context;
    my $msg = $ctx->trace->debug;
    $msg = "wrapped $msg" if $self->{+UNIT}->wrap;

    my $phub = test2_stack->top;
    my $hub = test2_stack->new_hub;
    $hub->format(undef);
    $hub->listen(sub {
        my ($hub, $e) = @_;
        $phub->send($e);
        $self->{+EVENTS}++;
        return unless $e->causes_fail;
        $self->{+FAILED}++;

        return unless $self->runner->verbose;
        return unless $self->{+NO_FINAL};
        $ctx->diag($msg);
    });

    return $hub;
}

sub _run_primary {
    my $self = shift;

    my $hub = $self->intercept;

    my $ok = eval { $self->_really_run_primary(); 1 };
    my $err = $@;

    test2_stack->pop($hub);

    die $err unless $ok;
}

sub _really_run_primary {
    my $self = shift;
    my $unit = $self->{+UNIT};
    my $primary = $unit->primary;

    if(reftype($primary) eq 'ARRAY') {
        $self->runner->run(unit => $_, args => $self->{+ARGS}) for @$primary
    }
    else {
        BEGIN { update_mask(__FILE__, __LINE__ + 1, '*', {stop => 1, restart => 1, shift => 1}) }
        $primary->(@{$self->{+ARGS}});
    }
}

sub _run_primaries {
    my $self = shift;

    # Make sure this does not run again
    $self->{+STAGE} = STAGE_TEARDOWN() if $self->{+STAGE} < STAGE_TEARDOWN();

    my $modifiers = $self->{+UNIT}->modify or return $self->_run_primary();

    for my $mod (@$modifiers) {
        my $primary = sub {
            $mod->primary->(@{$self->{+ARGS}});
            $self->_run_primary();
        };

        my $name = $mod->name;
        set_sub_name($name, $primary) if CAN_SET_SUB_NAME;

        my $temp = Test2::Workflow::Unit->new(
            %$mod,
            primary => $primary,
        );
        $self->runner->run(unit => $temp, args => $self->{+ARGS});
    }
}

sub _run_teardowns {
    my $self = shift;

    my $teardowns = $self->{+UNIT}->teardown;
    unless ($teardowns) {
        $self->{+STAGE} = STAGE_COMPLETE();
        return;
    }

    while($self->{+_TEARDOWN_IDX} < @$teardowns) {
        my $tunit = $teardowns->[$self->{+_TEARDOWN_IDX}++];
        # Popping a wrap
        return if $tunit->wrap;

        $self->runner->run(unit => $tunit, no_final => 1, args => $self->{+ARGS});
    }

    $self->{+STAGE} = STAGE_COMPLETE();
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::Workflow::Task - Compiled form of a unit.

=head1 *** EXPERIMENTAL ***

This distribution is experimental, anything can change at any time!

=head1 DESCRIPTION

This object is a temporary object created by a runner to process
L<Test2::Workflow::Unit> objects.

=head1 SYNOPSIS

You rarely encounter a task object, they are mainyl used under the hood. When
you do get one you usually just want to call C<iterate()> on it. This can be
done by treating it as a coderef.

    $task->();

Or direcectly:

    $task->iterate();

=head1 METHODS

=over 4

=item $task->run()

Run the task, this should only every be done by a runner.

=item $task->iterate()

Sometimes tasks are recursive. This method is how they resume running in a
recursive structure.

=item $task->reset()

Reset the task. This is rarely needed.

=item $ar = $task->args()

Get the args that will be passed to the primary actions.

=item $bool = $task->finished()

Check if the task has finished running.

=item $bool = $task->no_final()

True if the task is not required to generate events.

=item $bool = $task->subtest()

True if the task should produce a subtest.

=item $int = $task->events()

Number of events produced by the primary actions.

=item $int = $task->failed()

Number of failures produced inside the primary actions.

=item $int = $task->pending()

How many pending iterations remain.

=item $int = $task->stage()

What stage the task is in.

=item $msg = $task->exception()

If an exception has occured the message will be stored here.

=item $unit = $task->unit()

Get the unit the task wraps.

=item $runner = $task->runner()

Get the runner instance and/or class.

=back

=head1 SOURCE

The source code repository for Test2-Workflow can be found at
F<http://github.com/Test-More/Test2-Workflow/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 COPYRIGHT

Copyright 2015 Chad Granum E<lt>exodist7@gmail.comE<gt>.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See F<http://dev.perl.org/licenses/>

=cut
