package Padre::Plugin::Parrot::ColorizeTask;

use strict;
use warnings;
use base 'Padre::Task';
use Scalar::Util ();

our $VERSION = '0.26';
our $thread_running = 0;

# This is run in the main thread before being handed
# off to a worker (background) thread. The Wx GUI can be
# polled for information here.
# If you don't need it, just inherit this default no-op.
sub prepare {
	my $self = shift;

	# it is not running yet.
	$self->{broken} = 0;
	
	return if $self->{_editor};
	$self->{_editor} = Scalar::Util::refaddr(Padre::Current->editor);

	# assign a place in the work queue
	if($thread_running) {
		# single thread instance at a time please. aborting...
		$self->{broken} = 1;
		return "break";
	}
	$thread_running = 1;
	return 1;
}

sub is_broken {
	my $self = shift;
	return $self->{broken};
}

# used for coloring by parrot
my %colors = (
# Perl 6
	quote_expression => Padre::Constant::PADRE_BLUE,
	parse            => undef,
	statement_block  => undef,
	statementlist    => undef,
	statement        => undef,
	expr             => undef,
	'term:'          => undef,
	noun             => undef,
	value => undef,
	quote => undef,
	quote_concat => undef,
	quote_term => undef,
	quote_literal => undef,
	post => Padre::Constant::PADRE_MAGENTA,
	dotty => undef,
	dottyop => undef,
	methodop => Padre::Constant::PADRE_GREEN,
	name => Padre::Constant::PADRE_GREEN,
	identifier => undef,
	term => undef,
	args => undef,
	arglist => undef,
	EXPR => undef,
	statement_control => undef,
	use_statement => undef,
	sym => Padre::Constant::PADRE_RED,
	'infix:='  => Padre::Constant::PADRE_GREEN,
	'infix:+'  => Padre::Constant::PADRE_GREEN,
	'infix:,'  => Padre::Constant::PADRE_GREEN,
	'infix:..' => undef,
	'prefix:=' => undef,
	'infix:|' => undef,
	'infix:==' => undef,
	'infix:*=' => undef,
	twigil => undef,
	if_statement => undef,
	'infix:eq' => undef,
	semilist => undef,
	scope_declarator => undef,
	scoped => undef,
	variable_declarator => undef,
	declarator => undef,
	variable => Padre::Constant::PADRE_RED,
	integer => undef,
	number => Padre::Constant::PADRE_BROWN,
	circumfix => undef,
	param_sep => undef,
	sigil => undef,
	desigilname => undef,
	longname => undef,
	parameter => undef,
	param_var => undef,
	quant => undef,
	pblock => undef,
	block => undef,
	signature => undef,
	for_statement => undef,
	xblock => undef,
	lambda => Padre::Constant::PADRE_GREEN,
	
# Cardinal
	ident => undef,
	local_variable => undef,
	basic_primary => undef,
	basic_stmt => undef,
	stmt => undef,
	before => undef,
	mrhs => undef,
	varname => undef,
	stmts => undef,
	comp_stmt => undef,
	assignment => undef,
	mlhs => undef,
	literal => undef,
	arg => undef,
	call_arsg => undef,
	funcall => undef,
	post_primary_expr => undef,
	call_args => undef,
	string => undef,
);

# This is run in the main thread after the task is done.
# It can update the GUI and do cleanup.
# You don't have to implement this if you don't need it.
sub finish {
	my $self = shift;
	my $mainwindow = shift;

	my $editor = Padre::Current->editor;
	my $addr = delete $self->{_editor};
	if (not $addr or not $editor or $addr ne Scalar::Util::refaddr($editor)) {
		# shall we try to locate the editor ?
		$thread_running = 0;
		return 1;
	}

	my $doc = Padre::Current->document;
	if (not $doc) {
		$thread_running = 0;
		return 1;
	}

	if($self->{_parse_tree}) {
		$doc->remove_color;
		foreach my $pd (@{$self->{_parse_tree}}) {
			my $type = $pd->{type};
			if (not exists ($colors{$type})) {
				warn "No color definiton for '$type':  " . 
					$pd->{str} . "\n";
				next;
			}
			if(not defined $colors{$type}) {
				# no need to color
				next;
			}
			my $color = $colors{$type};
			$editor->StartStyling($pd->{start}, $color);
			$editor->SetStyling($pd->{length}, $color);
		}
	}
	$doc->{tokens} = [];
	$doc->{issues} = [];
	
	#$doc->check_syntax_in_background(force => 1); # $task-
	#$doc->get_outline(force => 1);

	# finished here
	$thread_running = 0;

	return 1;
}

# Task thread subroutine
sub run {
	my $self = shift;
	

	use File::Temp qw(tempdir);
	my $dir = tempdir(CLEANUP => 1);
	my $file = "$dir/file";

	if (open my $fh, '>', $file) {
		print $fh $self->{text};
		delete $self->{text};
	} else {
		warn "Could not open $file for writing\n";
		return;
	}

	# TODO check if the path is there
	my $cmd = ($self->{pbc} ? qq("$ENV{PARROT_DIR}/parrot" ) : '');
	$cmd .= qq("$self->{path}");
	$cmd .= qq( --target=parse --dumper=padre "$file");
	#print "$cmd\n";
	my @data = `$cmd`;
	chomp @data;
	my @pd;
	foreach my $line (@data) {
		$line =~ s/^\s+//;
		my ($start, $length, $type, $str) = split /\s+/, $line, 4;
		push @pd, {
			start => $start,
			length => $length,
			type => $type,
			str => $str,
		};
	}
	$self->{_parse_tree} = \@pd;
	return;
	
	return 1;
};

1;

__END__

=head1 AUTHOR

Ahmad M. Zawawi C<< <ahmad.zawawi at gmail.com> >>

Gabor Szabo L<http://szabgab.com/>

=head1 COPYRIGHT AND LICENSE

Copyright 2008-2009 Padre Developers as in Perl6.pm

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