use strict;
package IMPL::Transform::Json;

package IMPL::Web::QueryHandler::JsonFormat;
use parent qw(IMPL::Web::QueryHandler);
use Error qw(:try);
use JSON;

sub Process {
	my ($this,$action,$nextHandler) = @_;
	
	my $result;
	my $t = new IMPL::Transform::Json;
	
	try {
		$result = $nextHandler->();
		$result = [$result] unless ref $result;
	} otherwise {
		my $err = shift;
		$result = { error => $err };
	};
	
	$action->response->contentType('text/javascript');
	
	my $hout = $action->response->streamBody;
	print $hout to_json( $t->Transform($result), {pretty => 1} );
} 

package IMPL::Transform::Json;

use parent qw(IMPL::Transform);
use IMPL::Class::Property;
use IMPL::Class::Property::Direct;
use Scalar::Util qw(refaddr);

BEGIN {
	private _direct property _visited => prop_none;
}

my %propListCache;

our %CTOR = (
	'IMPL::Transform' => sub {
		ARRAY => sub {
			my ($this,$object) = @_;
			
			return [
				map { $this->Transform($_) } @$object
			];	
		},
		HASH => sub {
			my ($this,$object) = @_;
			
			return {
				map { $_, $this->Transform($object->{$_}) } keys %$object
			};
		},
		'IMPL::Object::List' => sub {
			my ($this,$object) = @_;
			
			return [
				map { $this->Transform($_) } @$object
			]; 
		},
		-plain => sub {
			$_[1];
		},
		-default => sub {
			my ($this,$object) = @_;
			
			return "$object" unless $object->isa('IMPL::Object::Abstract');
			
			if ( $object->isa(typeof IMPL::Exception) ) {
				return {
					type => $object->typeof,
					message => $object->Message,
					arguments => $this->Transform(scalar $object->Args)
				};
			}
			
			my $propList = $propListCache{ref $object};
			unless ( $propList ) {
				my %props = map {
					$_->Name, (ref $_->Mutators ? 0 : ($_->Mutators & prop_list))
				} $object->get_meta('IMPL::Class::PropertyInfo',sub { $_->Access == IMPL::Class::Member::MOD_PUBLIC and $_->Name !~ /^_/}, 1 );
				
				$propListCache{ref $object} = $propList = \%props;
			}
			
			return {
				map {
					$_, $propList->{$_} ? $this->Transform([$object->$_()]) : $this->Transform(scalar $object->$_());
				} keys %$propList
			};
		}
	}
);

sub Transform {
	my ($this,$object) = @_;
	
	# small hack to prevent cycling
	
	return $this->SUPER::Transform($object) unless ref $object;
	
	if (exists $this->{$_visited}{refaddr $object}) {
		return $this->{$_visited}{refaddr $object};
	} else {
		$this->{$_visited}{refaddr $object} = undef;
		return $this->{$_visited}{refaddr $object} = $this->SUPER::Transform($object);
	}
}

1;