package Webservice::InterMine::Parser::JSON;

=head1 NAME

Webservice::InterMine::Parser::JSON - parse rows of JSON results

=head1 DESCRIPTION

One of the parsers used to intepret results sent from 
the webservice.

=cut

use Moose;
with 'Webservice::InterMine::Parser';

use JSON::XS;
use MooseX::Types::Moose qw(Str);
use InterMine::Model::Types qw(Model);

=head1 IMPLEMENTED PARSER METHODS

The following methods implement the Parser interface.

=over 4

=item * header_is_parsed()
reports whether the header has been parsed yet.
Here, this reports whether the beginning of the JSON
object has been seen, and whether the results array
is open.

=item * parse_header($line) 
Parse a line from the connection as header information. 
This method may be called multiple times, depending on 
the return value of C<header_is_parsed>.

=item * parse_line($line)
Given a line of text, returns whatever its processor returns.
This implementation checks for headers reported in the footer.

=back

=cut

has json_decoder => (
    default => sub {JSON::XS->new},
    handles => {
        decode => 'decode'
    }
);

has model => (
    is => 'ro',
    isa => Model,
);

has json_format => (
    is => "ro",
    isa => Str,
    default => "perl",
);

has header => (
    is => 'rw', 
    isa => Str,
    traits => ['String'],
    handles => {
        add_to_header => 'append',
    },
    default => '',
);

has footer => (
    is => 'rw', 
    isa => Str,
    traits => ['String'],
    handles => {
        add_to_footer => 'append',
    },
    default => '',
);

sub parse_header {
    my $self = shift;
    my $line = shift;
    warn "HEADER-LINE: " . ((defined $line) ? $line : "NULL") if $ENV{DEBUG};
    return unless (defined $line);
    $self->add_to_header($line);
}

sub header_is_parsed {
    my $self = shift;
    return $self->header =~ /results["']:\[$/;
}

has completeness => (
    reader => '_get_completeness', 
    writer => '_set_completeness',
    isa => 'Bool', 
    default => 0,
);

# Horrible hack to get around issue with role requirements...
sub is_complete {
    my $self = shift; 
    return $self->_get_completeness;
};

sub check_status {
    my $self = shift;
    my $container_text = $self->header . $self->footer;
    $container_text =~ s/'/"/g; # Fix bad quotes.
    warn $container_text if $ENV{DEBUG};
    my $container = eval {$self->decode($container_text)};
    unless ($container) {
        confess "Problem decoding container", $@, $container_text;
    }
    return unless (exists $container->{wasSuccessful});
    confess "Results returned error: ", $container->{statusCode}, " - ", $container->{error}
        unless ($container->{wasSuccessful});
}

sub parse_line {
    my $self = shift;
    my $line = shift;
    if ($line and $line =~ /^\]/) {
        $self->add_to_footer($line);
        $self->check_status;
        $self->_set_completeness(1);
        return undef;
    }
    if ($line and length($line)) {
        chomp($line);
        $line =~ s/,\s*$//;
        my $json = eval {$self->decode($line);};
        unless ($json) {
            confess "error: " => $@, "problem line: " => $line;
        }
        return $self->process($json) || $line;
    } else {
        return undef;
    }
}

=head2 process 

Process a parsed json data structure into either a perl structure 
(which is what it now is), or two different flavours of object.

If this method returns a false value, it indicates that the line
parser should return the line as it was received.

=cut

sub process {
    my $self = shift;
    my $perl = shift;

    if ($self->json_format eq "inflate") {
        return inflate($perl);
    } elsif ($self->json_format eq "instantiate") {
        return $self->model->make_new($perl)
    } elsif ($self->json_format eq "raw") {
        return undef;
    } else {
        return $perl;
    }
}

=head1 FUNCTIONS

=head2 inflate( $thing )

Inflates the thing passed in, blessing hashes into 
L<Webservice::InterMine::ResultObjects>, 
and recursing through their values, and iterating over arrays.

=cut

sub inflate {
    my $thing = shift;
    my $type  = ref $thing;
    if ( $type eq "HASH" ) {
        bless $thing, "Webservice::InterMine::ResultObject";
        for my $sub_thing ( values %$thing ) {
            inflate($sub_thing);
        }
    }
    elsif ( $type eq "ARRAY" ) {
        for my $sub_thing (@$thing) {
            inflate($sub_thing);
        }
    }
    return $thing;
}

no Moose;
__PACKAGE__->meta->make_immutable;
1;