package Parse::Constructor::Arguments;
our $VERSION = '0.091510';


#ABSTRACT: Parse Moose constructor arguments using PPI
use MooseX::Declare;

BEGIN
{
    *DEBUG = sub () { 0 } unless defined *DEBUG{CODE};
}

class Parse::Constructor::Arguments
{
    use PPI;
    use MooseX::Types::Moose(':all');
    
    has document =>
    (
        is          => 'ro',
        isa         => 'PPI::Document',
        lazy_build  => 1,
    );

    has current =>
    (
        is          => 'ro',
        isa         => 'PPI::Element',
        lazy        => 1,
        builder     => '_build_current',
        writer      => '_set_current',
    );

    has input   =>
    (
        is          => 'ro',
        isa         => Str,
        required    => 1,
    );

    method _build_current()
    {
        # our first token should be significant
        my $token = $self->document->first_token;

        if($token->significant)
        {
            return $token;
        }
        
        while(1)
        {
            $token = $token->next_token;
            die "No more significant tokens in stream: '$token'" if not $token;
            return $token if $token->significant;
        }
    }

    method _build_document()
    {
        my $input = $self->input;
        my $document = PPI::Document->new(\$input);
        return $document;
    }


    # states:
    # 0 - Looking for a Word or Literal to use as a key
    # 1 - Looking for a comma operator
    # 2 - Looking for a value
    method parse(ClassName $class: Str $str)
    {
        my $self = $class->new(input => $str);

        # grab the current token, which should be the first significant token
        my $token = $self->current;
        
        # what we are building
        my %data;

        # state related parsing variables
        my $key;
        my $state = 0;
        
        while(1)
        {
            if($state == 0)
            {
                if($token->isa('PPI::Token::Word'))
                {
                    DEBUG && warn "Word Key: $token";
                    $key = $token->content;
                }
                elsif($token->isa('PPI::Token::Quote::Single') or $token->isa('PPI::Token::Quote::Literal'))
                {
                    DEBUG && warn "Quote Key: $token";
                    $key = $token->literal;
                }
                else
                {
                    die "Invalid state: Expected a Word or Literal but got '$token'";
                }
                
                $state++;
            }
            elsif($state == 1)
            {
                if($token->isa('PPI::Token::Operator') && $token->content =~ /,|=>/)
                {
                    DEBUG && warn "Comma: $token";
                }
                else
                {
                    die "Invalid state: Expected a Comma operator, but got '$token'";
                }
                
                $state++;
            }
            elsif($state == 2)
            {
                if($token->isa('PPI::Token::Quote::Single') or $token->isa('PPI::Token::Quote::Literal'))
                {
                    DEBUG && warn "Quote Value: $token";
                    $data{$key} = $token->literal;
                }
                elsif($token->isa('PPI::Token::Structure'))
                {
                    my $content = $token->content;
                    die "Unsupported structure '$content'"
                        if $content ne '[' and $content ne '{';

                    DEBUG && warn 'Constructor: ' . $token->parent;
                    $data{$key} = $self->process;
                }
                elsif($token->isa('PPI::Token::Number'))
                {
                    DEBUG && warn "Number: $token";
                    $data{$key} = $token->literal;
                }
                else
                {
                    die "Invalid state: Expected Literal, Number or Structure, but got '$token'";
                }
                
                $state++;
                $key = undef;
            }
            elsif($state == 3)
            {
                if($token->isa('PPI::Token::Operator') && $token->content =~ /,|=>/)
                {
                    DEBUG && warn "Comma: $token";
                }
                else
                {
                    die "Invalid state: Expected a Comma operator, but got '$token'";
                }

                $state = 0;
            }
            
            if(my $t = $self->peek_next_token)
            {
                DEBUG && warn "Peeked and took $t";
                $token = $t;
                $self->_set_current($token);
            }
            else
            {
                DEBUG && warn "Peeked and there were no more tokens";
                last;
            }
        }

        return \%data;
    }

    method process()
    {
        my ($data, $applicator, $terminator, $word, $token);
        
        if($self->current->content eq '[')
        {
            DEBUG && warn "Processing Array...";
            $data = [];
            $terminator = ']';
            $applicator = sub { push(@{$_[0]}, $_[2]) };
        }
        else
        {
            DEBUG && warn "Processing Hash...";
            $data = {};
            $terminator = '}';
            $applicator = sub { $_[0]->{$_[1]} = $_[2] };
        }

        $token = $self->get_next_significant;

        while($token->content ne $terminator)
        {
            # words are stored until we know if they are a key or a value
            if($token->isa('PPI::Token::Word'))
            {
                DEBUG && warn "Process Word: $token";
                $word = $token->content;
                $token = $self->get_next_significant;
            }

            if($token->isa('PPI::Token::Number'))
            {
                DEBUG && warn "Process Number: $token";
                $applicator->($data, $word, $token->content);
                $word = undef;
            }
            elsif($token->isa('PPI::Token::Structure'))
            {
                DEBUG && warn "Process Structure: $token";
                $applicator->($data, $word, $self->process);
                $word = undef;
            }
            elsif($token->isa('PPI::Token::Quote::Single') || $token->isa('PPI::Token::Quote::Literal'))
            {
                DEBUG && warn "Process Quote: $token";
                if(!$word && $terminator eq '}')
                {
                    DEBUG && warn "Process Hash Key Quote: $token";
                    $word = $token->literal;
                    $token = $self->get_next_significant;
                    next;
                }

                $applicator->($data, $word, $token->literal);
                $word = undef;
            }
            elsif($token->isa('PPI::Token::QuoteLike::Words') and $terminator ne '}')
            {
                # This seems to be the only way to get the fuckin data from this token
                # which is completely retarded. Need to file a bug with PPI on this
                DEBUG && warn "Process QuoteLike Words: $token";
                
                my $operator = $token->{operator};
                my $separator = $token->{separator};
                my $content = $token->content;
                $content =~ s/$operator|$separator//g;
                
                $applicator->($data, undef, $_) for split(' ', $content);
            }
            elsif($token->isa('PPI::Token::Operator'))
            {
                DEBUG && warn "Process Comma: $token";
                if($token->content =~ /,|=>/)
                {
                    $token = $self->get_next_significant;
                    next;
                }
            }
            
            # now we process our words if they haven't been consumed
            DEBUG && warn "Process Add Word: $word" if $word;
            $applicator->($data, undef, $word) if $word;
            $word = undef;

            $token = $self->get_next_significant;
        }
        
        DEBUG && warn "Returning From Processing";
        return $data;
    }

    method get_next_significant()
    {
        my $token = $self->current;
        
        DEBUG && warn "Current: $token";
        while(1)
        {
            $token = $token->next_token;
            die 'No more significant tokens in stream: '. $self->document if not $token;
            
            if(!$token->significant)
            {
                next;
            }
            
            DEBUG && warn "Significant: $token";
            $self->_set_current($token);
            return $token;
        }
    }

    method peek_next_token()
    {
        my $token = $self->current;

        while(1)
        {
            $token = $token->next_token;
            return 0 if not $token;
            return $token if $token->significant;
        }
    }
}

1;



=pod

=head1 NAME

Parse::Constructor::Arguments - Parse Moose constructor arguments using PPI

=head1 VERSION

version 0.091510

=head1 DESCRIPTION
Parse::Constructor::Arguments parses Moose-style constructor arguments into a 
usable data structure using PPI to accomplish the task. It exports nothing 
and the only public method is a class method: parse.

=head1 METHODS

=head2 parse(ClassName $class: Str $str)

This is a class method used for parsing constructor arguments. It takes a
string that will be used as the basis of the PPI::Document. Returns a hashref
where the keys are the named arguments and the values are the actual values to
those named arguments. (eg. q|foo => ['bar']| returns { foo => ['bar'] })

=head1 AUTHOR

  Nicholas Perez <nperez@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2009 by Nicholas Perez.

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

=cut 



__END__
