package RestfulDB::JSONAPI;
use strict;
use warnings;

use Encode qw( decode );
use JSON -support_by_pp;
use List::Util qw( any );
use POSIX qw( strftime );

use Database qw( has_values );
use RestfulDB::Exception;
use RestfulDB::SQL qw( is_numerical );

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw(
    data2collection
    data2resource
    error2jsonapi
    jsonapi2data
    warnings2jsonapi
);

our $MEDIA_TYPE = 'application/vnd.api+json';

sub data2collection
{
    my $json_struct = &data2jsonapi;
    return JSON->new->canonical->allow_bignum->encode( $json_struct );
}

sub data2resource
{
    my $json_struct = &data2jsonapi;
    if( @{$json_struct->{data}} ) {
        $json_struct->{data} = $json_struct->{data}[0];
    } else {
        $json_struct->{data} = undef;
    }
    return JSON->new->canonical->allow_bignum->encode( $json_struct );
}

sub data2jsonapi
{
    my ($db, $items, $db_table, $options) = @_;

    my $json_struct = {
        data => [],
        meta => {
            time_stamp =>
                strftime( '%Y-%m-%dT%H:%M:%SZ', gmtime( time() ) ),
            warnings2jsonapi( @{$options->{warnings}} )
        }
    };

    $options = {} unless $options;
    my( $web_base ) = (
            $options->{web_base},
        );

    my $included = {};
    foreach (@$items) {
        next if !has_values( $_ );
        push @{$json_struct->{data}},
             entry2jsonapi( $_, { included => $included,
                                  web_base => $web_base } );
    }

    if( %$included ) {
        for my $type (sort keys %$included) {
            for my $id (sort keys %{$included->{$type}}) {
                # Citing JSON API v1.0:
                # "A compound document MUST NOT include more than one
                #  resource object for each type and id pair":
                next if any { $_->{type} eq $type &&
                              $_->{id} eq $id } @{$json_struct->{data}};

                push @{$json_struct->{included}},
                     $included->{$type}{$id};
            }
        }
    }

    $json_struct->{meta}{data_returned} =
        scalar @{$json_struct->{data}};

    if( $options->{request_uri} ) {
        $json_struct->{meta}{query}{representation} =
            decode( 'utf8', $options->{request_uri} );
    }

    return $json_struct;
}

sub jsonapi2data
{
    my ($db, $json, $options) = @_;

    $options = {} unless $options;
    my( $request_id ) = $options->{request_id};

    my $jsonstruct;
    eval { $jsonstruct = JSON->new()->allow_bignum()->decode( $json ) };
    InputException->throw( $@ ) if $@;

    my $struct = jsonstruct2data( $db, $jsonstruct, $options );
    if( defined $request_id ) {
        my $id_column = $db->get_id_column( $struct->[0]{metadata}{table_name} );
        die 'JSON resource object does not contain \'id\' member'
            if !$id_column || !exists $struct->[0]{columns}{$id_column};

        my $request_body_id = $struct->[0]{columns}{$id_column}{value};
        if( defined $request_id &&
            $request_id ne $request_body_id ) {
            die "IDs of the request URI ('$request_id') and body " .
                "('$request_body_id') do not match";
        }
    }

    return $struct;
}

sub jsonstruct2data
{
    my ($db, $json, $options) = @_;

    my $item = $json->{data};
    my $columns = {};
    if( exists $item->{attributes} ) {
        for my $field (sort keys %{$item->{attributes}}) {
            if( ref $item->{attributes}{$field} eq 'ARRAY' &&
                     !grep { ref $_ } @{$item->{attributes}{$field}} ) {
                # Flat arrays typically carry SET values
                $columns->{$field}{value} = $item->{attributes}{$field};
            } elsif( ref $item->{attributes}{$field} ) {
                # Store any other structure as JSON string:
                $columns->{$field}{value} =
                    JSON->new->canonical->allow_bignum->encode(
                        $item->{attributes}{$field} );
            } else {
                $columns->{$field}{value} = $item->{attributes}{$field};
            }
        }
    }

    my $id_column = $db->get_id_column( $item->{type} );
    if( exists $item->{id} && !exists $columns->{$id_column} ) {
        $columns->{$id_column} = { value => $item->{id} };
    }

    my $related_tables = {};
    if( exists $item->{relationships} ) {
        for my $relation (sort keys %{$item->{relationships}}) {
            if(      ref $item->{relationships}{$relation}{data} eq 'HASH' ) {
                $columns->{$relation}{value} =
                    $item->{relationships}{$relation}{data}{id};
            } elsif( ref $item->{relationships}{$relation}{data} eq 'ARRAY' ) {
                # FIXME: this is supposed to be the full replacement of
                # relationship list. That means that all relationships for
                # the entry in question that are not mentioned here must be
                # removed. Currently this is not done.
                my( $fk ) = grep { !$_->is_composite &&
                                    $_->parent_table eq $item->{type} }
                                 @{$db->get_foreign_keys( $relation )};
                die 'there are no foreign keys from table ' .
                    "'$relation' to '$item->{type}'" if !$fk;
                $related_tables->{$relation} = [
                    map { $_->[0]{columns}{$fk->child_column}{value} =
                            $item->{id}; $_->[0] }
                    map { jsonstruct2data( $db, { data => $_ }, $options ) }
                        @{$item->{relationships}{$relation}{data}} ];
            } else {
                die 'relationships must be a single resource identifier ' .
                    'or an array of them';
            }
        }
    }

    die 'JSON resource object does not contain \'type\' member'
        if !$item->{type};

    my $action = $options->{default_action}
                    ? $options->{default_action} : 'insert';

    return [ {
                 metadata => { table_name => $item->{type}, action => $action },
                 columns => $columns,
                 related_tables => $related_tables,
             } ];
}

sub entry2jsonapi
{
    my( $entry, $options ) = @_;

    $options = {} unless $options;
    my( $included, $skip_related, $web_base ) = (
            $options->{included},
            $options->{skip_related},
            $options->{web_base},
        );

    my $json = data2resource_identifier( $entry );
    $json = $json->{data};

    if( $web_base ) {
        $json->{links}{self} = "$web_base/$json->{type}/$json->{id}";
    }

    for my $key (keys %{$entry->{columns}}) {
        my $column = $entry->{columns}{$key};

        my $value;
        if( exists $column->{value} ) {
            $value = $column->{value};
        }

        # MySQL DBI driver seems to retrieve numbers as strings from
        # a MySQL database, therefore, these values have to be
        # converted to numeric.
        if( defined $value &&
            is_numerical( $column->{sqltype} ) ) {
            $value = $value + 0;
        }

        ## DISCUSS: let's add the ID column for now. It is also
        ## explicitly included in "id" field of top-level object, thus
        ## we may want to exclude it from the attributes.
        # next if $key eq $id_column;
        if( $column->{fk_target} ) {
            $json->{relationships}{$key} =
                data2resource_identifier( $column->{fk_target} );
            my( $related ) = entry2jsonapi( $column->{fk_target},
                                            { included => $included,
                                              skip_related => 1,
                                              web_base => $web_base } );
            $included->{$related->{type}}
                       {$related->{id}} = $related;
        #~ } elsif( exists $fields->{$key}{urlvalue} ) {
            #~ $attributes->{$key} =
                #~ { links => { self => $fields->{$key}{urlvalue} } };
        } else {
            $json->{attributes}{$key} = $value;
        }
    }

    if( $entry->{related_tables} && !$skip_related ) {
        for my $table (keys %{$entry->{related_tables}}) {
            for my $related (@{$entry->{related_tables}{$table}}) {
                next if !has_values( $related );
                push @{$json->{relationships}{$table}},
                     data2resource_identifier( $related );
                my $related_entry = entry2jsonapi( $related,
                                                   { included => $included,
                                                     skip_related => 1,
                                                     web_base => $web_base } );
                $included->{$related_entry->{type}}
                           {$related_entry->{id}} = $related_entry;
            }
        }
    }

    return $json;
}

sub data2resource_identifier
{
    my( $item ) = @_;
    my $table = $item->{metadata}{table_name};
    my( $id_column ) = grep { $item->{columns}{$_}{coltype} &&
                              $item->{columns}{$_}{coltype} eq 'id' }
                            @{$item->{metadata}{column_order}};
    die "table '$table' does not have an ID column" if !$id_column;
    return { data => { id => "$item->{columns}{$id_column}{value}",
                       type => $table } };
}

sub error2jsonapi
{
    my( $cgi, $error ) = @_;

    my $status = $error->isa( RestfulDB::Exception:: )
                    ? $error->http_status : 500;

    chomp $error;
    print $cgi->header( -type => $MEDIA_TYPE,
                        -status => $status,
                        -charset => 'UTF-8' ),
          JSON->new->canonical->allow_bignum->encode(
            { errors => [ { detail => "$error" } ] } );
}

sub warnings2jsonapi
{
    my @warnings = @_;
    return () if !@warnings;

    my %seen_warnings;
    @warnings = grep { $seen_warnings{$_}++; $seen_warnings{$_} == 1 }
                     @warnings;

    return warnings => \@warnings;
}

1;
