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;
    
    try {
        $result = $nextHandler->();
        $result = [$result] unless ref $result;
    } otherwise {
        my $err = shift;
        $result = { error => $err };
    };
    
    my $t = new IMPL::Transform::Json($action->context->{json});
    
    if ($action->context->{transactionType} and $action->context->{transactionType} eq 'form') {
        delete @$result{qw(formData formSchema)};
        my $errors = @$result{formErrors};
        
        $result->{formErrors} = [ map $_->Message, @$errors ] if $errors;
    }
    
    $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 {
        my $options = shift;
        (
            $options ? %{$options} : ()
        ),
        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;