package Test::Stream::Workflow::Unit;
use strict;
use warnings;

use Test::Stream::Sync;
use Test::Stream::Context();
use Test::Stream::DebugInfo;

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

use Test::Stream::HashBase(
    accessors => [qw{
        name meta type wrap stash
        package file start_line end_line
        post
        modify
        buildup
        primary
        teardown
    }],
);

sub init {
    $_[0]->{+META} ||= {};

    for (NAME, PACKAGE, FILE, START_LINE, END_LINE) {
        confess "$_ is a required attribute" unless defined $_[0]->{$_}
    }

    $_[0]->{+STASH} ||= {};
}

sub contains {
    my $self = shift;
    my ($thing) = @_;
    my ($file, $line, $name);
    if ($thing =~ m/^(\S+) (\d+)$/) {
        ($file, $line) = ($1, $2);
    }
    elsif ($thing =~ m/^\d+$/) {
        $line = $thing;
    }
    else {
        $name = $thing;
    }

    return $self->_contains($file, $line, $name);
}

sub _contains {
    my $self = shift;
    my ($file, $line, $name) = @_;

    my $name_ok = !defined($name) || $self->{+NAME} eq $name;
    my $file_ok = !defined($file) || $self->{+FILE} eq $file;

    my $line_ok = !defined($line) || (
        $line >= $self->{+START_LINE}
        && ($self->{+END_LINE} . "" eq 'EOF' || $line <= $self->{+END_LINE})
    );

    my $child_ok = 0;
    for my $stash (MODIFY(), BUILDUP(), PRIMARY(), TEARDOWN()) {
        my $set = $self->$stash || next;
        next unless ref $set && reftype($set) eq 'ARRAY';
        for my $unit (@$set) {
            $child_ok = 1 if $unit->_contains($file, $line, $name);
        }
    }

    return $child_ok || ($name_ok && $file_ok && $line_ok);
}

sub do_post {
    my $self = shift;

    my $post = delete $self->{+POST} or return;
    $_->($self) for @$post;
}

for my $type (MODIFY(), BUILDUP(), PRIMARY(), TEARDOWN()) {
    no strict 'refs';
    *{"add_$type"} = sub {
        use strict;
        my $self = shift;
        $self->{$type} ||= [];
        push @{$self->{$type}} => @_;
    };
}

sub adjust_lines {
    my $self = shift;

    my $start = $self->{+START_LINE};
    my $end   = $self->{+END_LINE};

    for my $stash (MODIFY(), BUILDUP(), PRIMARY(), TEARDOWN()) {
        my $list = $self->{$stash} or next;
        next unless ref $list;
        next unless reftype($list) eq 'ARRAY';
        next unless @$list;

        my $top = $list->[0] or next;

        my $c_start = $top->start_line;
        my $c_end   = $top->end_line;

        $start = $c_start
            if defined($c_start)
            && $c_start =~ m/^\d+$/
            && $c_start < $start;

        next if $end && "$end" eq 'EOF';
        next unless defined $c_end;

        $end = $c_end
            if ($c_end =~ m/^\d+$/ && $c_end > $end)
            || "$c_end" eq 'EOF';
    }

    if ("$end" eq 'EOF') {
        $start -= 1 if $start != $self->{+START_LINE};
    }
    else {
        $start -= 1 if $start != $end && $start != $self->{+START_LINE};
        $end   += 1 if $end != $start && $end   != $self->{+END_LINE};
    }

    $self->{+START_LINE} = $start;
    $self->{+END_LINE}   = $end;
}

sub add_post {
    my $self = shift;
    confess "post units only apply to group units"
        unless $self->type eq 'group';
    $self->{post} ||= [];
    push @{$self->{post}} => @_;
}

sub debug {
    my $self = shift;

    my $stack = Test::Stream::Sync->stack;
    my $hub   = $stack->top;

    return Test::Stream::DebugInfo->new(
        frame       => [@$self{qw/package file start_line name/}],
        skip        => $self->meta->{skip},
        detail => "in block '$self->{+NAME}' defined in $self->{+FILE} (Approx) lines $self->{+START_LINE} -> $self->{+END_LINE}",
        $hub->debug_todo,
    );
}

sub context {
    my $self = shift;

    my $stack = Test::Stream::Sync->stack;
    my $hub   = $stack->top;

    my $ref;
    if(my $todo = $self->meta->{todo}) {
        $ref = $hub->set_todo($todo);
    }

    my $dbg = $self->debug;

    my $ctx = Test::Stream::Context->new(
        stack => $stack,
        hub   => $hub,
        debug => $dbg,
    );

    # Stash the todo ref in the context so that it goes away with the context
    $ctx->{_todo_ref} = $ref;

    return $ctx;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test::Stream::Workflow::Unit - Representation of a workflow unit.

=head1 EXPERIMENTAL CODE WARNING

B<This is an experimental release!> Test-Stream, and all its components are
still in an experimental phase. This dist has been released to cpan in order to
allow testers and early adopters the chance to write experimental new tools
with it, or to add experimental support for it into old tools.

B<PLEASE DO NOT COMPLETELY CONVERT OLD TOOLS YET>. This experimental release is
very likely to see a lot of code churn. API's may break at any time.
Test-Stream should NOT be depended on by any toolchain level tools until the
experimental phase is over.

=head1 DESCRIPTION

This package is a single unit of work to be done in a workflow. The unit may
contain a codeblock, or many child units.

=head1 METHODS

=over 4

=item $bool = $unit->contains($name)

=item $bool = $unit->contains($line)

=item $bool = $unit->contains("$file $line)

Check if the unit contains (or is) a unit with the given specification. The
specification may be a line number, a filename + line number, or a unit name.
This will return true if either the unit, or one of the child units, matches.

=item $unit->add_modify($other_unit)

=item $unit->add_buildup($other_unit)

=item $unit->add_teardown($other_unit)

These add C<$other_unit> as a child unit. The child is added to the group
specified in the method name.

=item $unit->add_primary($other_unit)

Add a primary unit child. B<Note:> The primary unit is either an arrayref of
other units, or a single coderef. In cases where the primary is a coderef, this
will fail badly.

=item $unit->add_post(sub { ... })

Add a post-build callback.

=item $unit->do_post()

Run (and remove) the post-build callbacks.

=item $dbg = $unit->debug

Generate an L<Test::Stream::Debug> object for this unit.

=item $ctx = $unit->context

Generate a context representing the scope of the unit. B<Note:> this context is
non-canonical.

=item $name = $unit->name

Get the unit name.

=item $hr = $unit->meta

Get the meta hashref, this contains things like 'todo' and 'skip'.

=item $type = $unit->type

Get the unit type.

=item $bool = $unit->wrap

True if the codeblock for this unit is a wrap (around_all, around_each, etc).

=item $hr = $unit->stash

General purpose stash for use in plugins and extensions.

=item $pkg = $unit->package

Package for the unit.

=item $file = $unit->file

Filename for the unit

=item $start = $unit->start_line

Starting line for the unit.

=item $end = $unit->end_line

Ending line number for the unit. B<Note:> This can be set to an integer, or to
the string 'EOF'.

=item $unit->adjust_lines

This will check all child unit bounds, if they fall outside the parents bounds
then the parent will be adjusted.

=item $ar = $unit->post

=item $ar = $unit->modify

=item $ar = $unit->buildup

=item $ar = $unit->teardown

Access to the arrayrefs for the specific child types.

=item $code_or_ar = $unit->primary

Get the primary, which may be an arrayref of other units, or a single coderef.

=back

=head1 SOURCE

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

=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://www.perl.com/perl/misc/Artistic.html>

=cut
