use 5.010001;
use strict;
use warnings;
use Test::More 0.96;
use Test::Deep qw/!blessed/;

use BSON;
use BSON::Types ':all';
use Config;
use Path::Tiny 0.054; # better basename
use JSON::MaybeXS;
use Data::Dumper;

# from t/lib
use TestUtils;

use constant {
    IS_JSON_PP => ref( JSON::MaybeXS->new ) eq 'JSON::PP'
};

use base 'Exporter';
our @EXPORT = qw/test_corpus_file/;

binmode( Test::More->builder->$_, ":utf8" )
  for qw/output failure_output todo_output/;

sub test_corpus_file {
    my ($file) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $f = path( "corpus", $file );
    my $base = $f->basename;

    my $json = eval { decode_json( $f->slurp ) };
    if ( my $err = $@ ) {
        fail("$base failed to load");
        diag($err);
        return;
    }

    if ( $json->{deprecated} ) {
        $f = path( "corpus", "deprecated", $file );
        $json = eval { decode_json( $f->slurp ) };
        if ( my $err = $@ ) {
            fail("deprecaed/$base failed to load");
            diag($err);
            return;
        }
    }

    _validity_tests($json);
    _decode_error_tests($json);
    _parse_error_tests($json);
}

sub _validity_tests {
    my ($json) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;

    # suppress caching that throws off Test::Deep
    local $BSON::Types::NoCache = 1;

    # aggressively force ext-json representation, even for int32 and double
    local $ENV{BSON_EXTJSON_FORCE} = 1;

    my $bson_type = $json->{bson_type};

    for my $case ( @{ $json->{valid} } ) {
        local $Data::Dumper::Useqq = 1;

        my $desc = $case->{description};
        my $wrap = $bson_type =~ /\A(?:0x01|0x10|0x12)\z/;
        my $codec = BSON->new( prefer_numeric => 1, wrap_numbers => $wrap, ordered => 1 );
        my $lossy = $case->{lossy};

        my $B = $case->{bson};
        my $E = $case->{extjson}; # could be undef

        my $cB = exists($case->{canonical_bson}) ? $case->{canonical_bson} : $B;
        my $cE = exists($case->{canonical_extjson}) ? $case->{canonical_extjson} : $E;

        my $skip_extjson = !(defined($E) && _extjson_ok($bson_type, $E));

        $B = pack( "H*", $B );
        $cB = pack( "H*", $cB );

        $E = _normalize( $E, "$desc: normalizing E"  );
        $cE = _normalize( $cE, "$desc: normalizing cE"  );

        _bson_to_bson( $codec, $B, $cB, "$desc: B->cB" );

        if ($B ne $cB) {
            _bson_to_bson( $codec, $cB, $cB, "$desc: cB->cB" );
        }

        if ( ! $skip_extjson ) {
            _bson_to_extjson( $codec, $B, $cE, "$desc: B->cE" );
            _extjson_to_extjson( $codec, $E, $cE, "$desc: E->cE" );

            if ($B ne $cB) {
                _bson_to_extjson( $codec, $cB, $cE, "$desc: cB->cE" );
            }

            if ($E ne $cE) {
                _extjson_to_extjson( $codec, $cE, $cE, "$desc: cE->cE" );
            }

            if ( ! $lossy ) {
                _extjson_to_bson( $codec, $E, $cB, "$desc: E->cB" );

                if ($E ne $cE) {
                    _extjson_to_bson( $codec, $E, $cB, "$desc: cE->cB" );
                }

            }
        }
    }

    return;
}

# this handle special cases that just don't work will in perl
sub _extjson_ok {
    my ($type, $E) = @_;

    if ( $type eq "0x01" ) {
        return if $E =~ /\d\.0\D/; # trailing zeros wind up as integers
        return if $E =~ '-0(\.0)?'; # negative zero not preserved in Perl
    }

    # JSON::PP has trouble when TO_JSON returns a false value; in our case
    # it could stringify 0 as "0" rather than treat it as a number; see
    # https://github.com/makamaka/JSON-PP/pull/23
    if ( ( $type eq "0x10" || $type eq "0x12" ) && IS_JSON_PP ) {
        return if $E =~ /:\s*0/;
    }

    return 1;
}

sub _normalize {
    my ($json, $desc) = @_;
    return unless defined $json;

    try_or_fail(
        sub {
            $json = to_myjson( decode_json( $json ) );
        },
        $desc
    ) or next;

    return $json;
}

sub _bson_to_bson {
    my ($codec, $input, $expected, $label) = @_;

    my ($decoded,$got);

    try_or_fail(
        sub { $decoded = $codec->decode_one( $input ) },
        "$label: Couldn't decode BSON"
    ) or return;

    try_or_fail(
        sub { $got = $codec->encode_one( $decoded ) },
        "$label: Couldn't encode BSON from BSON"
    ) or return;

    return bytes_are( $got, $expected, $label );
}

sub _bson_to_extjson {
    my ($codec, $input, $expected, $label) = @_;

    my ($decoded,$got);

    try_or_fail(
        sub { $decoded = $codec->decode_one( $input ) },
        "$label: Couldn't decode BSON"
    ) or return;

    try_or_fail(
        sub { $got = to_extjson( $decoded ) },
        "$label: Couldn't encode ExtJSON from BSON"
    ) or return;

    return is($got, $expected, $label);
}

sub _extjson_to_bson {
    my ($codec, $input, $expected, $label) = @_;

    my ($decoded,$got);

    try_or_fail(
        sub { $decoded = $codec->inflate_extjson( decode_json( $input ) ) },
        "$label: Couldn't decode ExtJSON"
    ) or return;

    try_or_fail(
        sub { $got = $codec->encode_one( $decoded ) },
        "$label: Couldn't encode BSON from BSON"
    ) or return;

    return bytes_are( $got, $expected, $label );
}

sub _extjson_to_extjson {
    my ($codec, $input, $expected, $label) = @_;

    my ($decoded,$got);

    try_or_fail(
        sub { $decoded = $codec->inflate_extjson( decode_json( $input ) ) },
        "$label: Couldn't decode ExtJSON"
    ) or return;

    try_or_fail(
        sub { $got = to_extjson( $decoded ) },
        "$label: Couldn't encode ExtJSON from BSON"
    ) or return;

    return is($got, $expected, $label);
}

sub _decode_error_tests {
    my ($json) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;

    return unless $json->{decodeErrors};
    for my $case ( @{ $json->{decodeErrors} } ) {
        my $desc = $case->{description};
        my $bson = pack( "H*", $case->{bson} );

        eval { BSON::decode($bson) };
        ok( length($@), "Decode error: $desc:" );
    }
}

my %PARSER = (
    '0x13' => sub { bson_decimal128(shift) },
);

sub _parse_error_tests {
    my ($json) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my $parser = $PARSER{$json->{bson_type}};
    if ( $json->{parseErrors} && !$parser  ) {
        BAIL_OUT("No parseError parser available for $json->{bson_type}");
    }

    for my $case ( @{ $json->{parseErrors} } ) {
        eval { $parser->($case->{string}) };
        ok( $@, "$case->{description}: parse should throw an error " )
            or diag "Input was: $case->{string}";
    }
}

1;
#
# This file is part of BSON
#
# This software is Copyright (c) 2018 by Stefan G. and MongoDB, Inc.
#
# This is free software, licensed under:
#
#   The Apache License, Version 2.0, January 2004
#

# vim: set ts=4 sts=4 sw=4 et tw=75: