package MooseX::Sub::Arguments;
use warnings;
use strict;

use Filter::Util::Call;
use Data::Dump                          qw( dump );
use MooseX::Sub::Arguments::Positional;
use MooseX::Sub::Arguments::Named;
use namespace::clean;

sub import {
    my ($class) = @_;
    *args::import = \&args_import;
    $INC{'args.pm'} = 1;
}

sub args_import {
    my ($class, @args) = @_;
    filter_add([0, \@args]);
}

sub filter {
    my ($self) = @_;
    my $status = filter_read;

    # first call, create the argument parsing line
    if ($self->[0] == 0) {
        $self->[0]++;

        # separate flags from actual args
        my ($args, %flags) = (@{ $self->[1] } and $self->[1][0] !~ /^-/)
                           ? @{ $self->[1] }
                           : ('', @{ $self->[1] });
        my $processor = 'MooseX::Sub::Arguments::' 
                      . ($flags{ -named } ? 'Named' : 'Positional');

        # split args up in position/[type/var] blocks
        my $args_count;
        my @args = ( defined $args and length $args )
                 ? ( map { [$args_count++, [split /\s+/, $_]] } 
                     split /\s*,\s*/, $args )
                 : ( );

        # make sure the argument spec looks right
        for my $arg (@args) {
            my ($pos, $parts) = @$arg;
            @$parts = ('', $parts->[0]) if @$parts == 1;
        }

        # split up list types (arrays, hashes) and scalars
        my (@scalar, @other, $rest);
        for my $arg (@args) {
            my $var     = $arg->[1][1];
            $arg->[2]   = 1 if $arg->[1][1] =~ s/\?$//; # optionals
            ($arg->[3]) = $var =~ /^.(.+)$/;            # name
            if ($var =~ /^\$/) {
                push @scalar, $arg;
                next;
            }
            elsif ($var =~ /^\*([@%].+)$/) {
                $arg->[1][1] = $1;
                $rest = $arg;
                # TODO die if more than one rest
                next;
            }
            push @other, $arg;
        }

        # generate calls to the argument parser
        my @literal;
        my $literal_flags = dump \%flags;

        # invocant arguments
      INVOCANT_PROCESS: {
            my @inv_option 
                = map  { s/^-// ; lc $_ } 
                  grep { $flags{ $_ } }
                  grep { 
                    my $i = $_; 
                    grep { $i eq $_ } qw(-class -instance -function);
                  }
                  keys %flags;
            # TODO croak if more than one arg
            my @inv;
            my ($iop) = @inv_option;
            $iop ||= 'instance';
            # instance or nothing at all gets both vars,
            if ($iop eq 'instance') {
                @inv = ( [undef, ['SELF',       '$self']], 
                         [undef, ['SELF_CLASS', '$class']] );
            }
            # class gets only the class
            elsif ($iop eq 'class') {
                @inv = ([undef, ['CLASS', '$class']]);
            }
            # function gets nothing, we don't need the following
            else {
                last INVOCANT_PROCESS;
            }
            
            my $literal_invocant_list 
                = join ', ', map { $_->[1][1] } @inv;
            my $literal_invocants = dump \@inv;
            push @literal, qq{
                my ($literal_invocant_list) = $processor
                  ->process_invocant_args(
                    '$iop', $literal_invocants, $literal_flags, \\\@_ );
            };
        }

        # scalar vars are assigned in one go
        if (@scalar) {
            my $literal_scalar_list 
                = join ', ', map { $_->[1][1] } @scalar;
            my $literal_scalar = dump \@scalar;

            push @literal, qq{
                my ($literal_scalar_list) = $processor
                  ->process_scalar_args(
                    $literal_scalar, $literal_flags, \\\@_ );
            };
        }

        # each list type gets it's own assignment
        for my $o (@other) {
            my ($pos, $parts, $is_opt, $name) = @$o;
            my ($type, $var)  = @$parts;
            my $var_type = ($var =~ /^\@/ ? 'array' : 'hash');
            
            push @literal, qq{
                my $var = $processor
                  ->process_${var_type}_arg(
                    $pos, '$name', '$type', $literal_flags, \\\@_ );
            };
        }

        # handle rest argument, if there was one
        if ($rest) {
            my ($type, $var) = @{ $rest->[1] };
            my $arg_count = @scalar + @other;
            my %known = map { ($_->[3] => 1) } @scalar, @other;
            my $literal_rest  = dump $rest;
            my $literal_known = dump \%known;
            push @literal, qq{
                my $var = $processor
                  ->process_rest_args( '$type', $literal_rest, 
                      $literal_known, $arg_count, $literal_flags, 
                      \\\@_ );
            };
        }

        # combine literals and original first line
        $_ = join '', @literal, $_;
        
#        print $_;
        return length $_;
    }
#    print $_;
    return $status;
}

=head1 TODO

=over

=item constraint handling

=item -omni => 1 flag for class/instance/function

=item -method => 1 flag for class/instance, should probably be default

=item invocation validation

=item existance validation (optional flag is already there)

=item hash/array type validation

=item syntax checking the argument line

=back

=head1 CAVEATS

=over

=item use args; line can't be on same line as arg usage

E.g., this won't work:

 sub foo { use args; print $class }

=item args package visible during other use's

=back

=cut

1;