package Amazon::API::Botocore::Shape;

use strict;
use warnings;

our $VERSION = '2.2.1';

use parent qw(Exporter Class::Accessor::Fast);

use Amazon::API::Constants qw(:chars :booleans);
use Amazon::API::Botocore::Shape::Utils qw(flatten require_shape check_type check_pattern );
use Amazon::API::NullLogger;

use Carp qw(croak confess);
use Cwd;
use Data::Dumper;
use English qw(-no_match_vars);
use Readonly;
use Scalar::Util qw( reftype blessed );
use List::Util qw( any pairs none );

__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_accessors(
  qw(
    documentation
    enum
    flattened
    logger
    location
    locationName
    key
    value
    max
    member
    members
    min
    paginator
    pattern
    required
    service
    shape
    type
    _value
  )
);

our $PROTOCOL;
our $LOGGER_SOURCE;

########################################################################
sub new {
########################################################################
  my ( $class, $args, $is_response ) = @_;

  my $self = $class->SUPER::new($args);

  $self->set_logger(
      $LOGGER_SOURCE
    ? $LOGGER_SOURCE->($class)
    : Amazon::API::NullLogger->new
  );

  if ($is_response) {
    $self->set__value(undef);
    return;
  }

  $self->_init_value;

  return $self;
}

########################################################################
sub is_structure {
########################################################################
  my ($self) = @_;

  return $self->get_type eq 'structure';
}

########################################################################
sub is_list {
########################################################################
  my ($self) = @_;

  return $self->get_type eq 'list';
}

########################################################################
sub is_string {
########################################################################
  my ($self) = @_;

  return $self->get_type eq 'string';
}

########################################################################
sub is_integer {
########################################################################
  my ($self) = @_;

  return $self->get_type eq 'integer';
}

########################################################################
sub is_map {
########################################################################
  my ($self) = @_;

  return $self->get_type eq 'map';
}

########################################################################
sub is_flattened {
########################################################################
  my ($self) = @_;

  return $self->get_flattened;
}

########################################################################
sub _init_structure {
########################################################################
  my ($self) = @_;

  my $value = $self->get__value;

  foreach my $member ( @{ $self->get_required // [] } ) {
    croak "$member is a required parameter"
      if !any { $_ eq $member } keys %{$value};
  }

  my %result = %{$value};  # do not alter input!

  foreach my $member ( keys %{ $self->get_members } ) {

    if ( exists $result{$member} ) {
      my $val = $result{$member};
      next if blessed $val && reftype($val) eq 'SCALAR';  # JSON::PP::true

      my $class = require_shape( $self->get_members->{$member}->{shape}, $self->get_service );

      $result{$member} = $class->new($val);
    }
  }

  return \%result;
}

########################################################################
sub _init_map {
########################################################################
  my ($self) = @_;

  my $value = $self->get__value;

  return $value
    if $self->is_flattened;

  if ( ref $value eq 'HASH' ) {
    $value = [$value];
  }

  foreach my $elem ( @{$value} ) {
    croak 'elements of a map must be of type HASH'
      if ref($elem) ne 'HASH';
  }

  my @list;

  my $key_class   = require_shape( $self->get_key->{shape},   $self->get_service );
  my $value_class = require_shape( $self->get_value->{shape}, $self->get_service );

  foreach my $elem ( @{$value} ) {
    my @kv = %{$elem};
    push @list, { $key_class->new( $kv[0] ) => $value_class->new( $kv[1] ) };
  }

  $value = \@list;

  return $value;
}

########################################################################
sub _init_list {
########################################################################
  my ($self) = @_;

  my $value = $self->get__value;

  croak 'more than ' . $self->get_max . ' elements in list'
    if $self->get_max && @{$value} > $self->get_max;

  croak 'need at least ' . $self->get_min . ' elements in list'
    if $self->get_min && @{$value} < $self->get_min;

  my $class = require_shape( $self->get_member->{shape}, $self->get_service );

  # do not alter the input!
  my @list;

  foreach my $elem ( @{$value} ) {
    push @list, $class->new($elem);
  }

  return \@list;
}

########################################################################
sub _init_string {
########################################################################
  my ($self) = @_;

  my $value = $self->get__value;

  my $pattern = $self->get_pattern;

  croak 'length of value must be > ' . $self->get_min
    if $self->get_min && length $value < $self->get_min;

  croak 'length of value must be < ' . $self->get_max
    if $self->get_max && length $value > $self->get_max;

  check_pattern( $value, $pattern );

  return $value;
}

########################################################################
sub _init_integer {
########################################################################
  my ($self) = @_;

  my $value = $self->get__value;

  croak 'value must be > ' . $self->get_min
    if defined $self->get_min && $value < $self->get_min;

  croak 'value must be < ' . $self->get_max
    if defined $self->get_max && $value > $self->get_max;

  return $value;
}

########################################################################
sub _init_value {
########################################################################
  my ($self) = @_;

  my $value = $self->get__value;

  return
    if !$value;

  croak 'ref type of value should be one of SCALAR, ARRAY or HASH'
    if blessed $value && reftype($value) ne 'SCALAR';

  my %types = (
    structure => 'HASH',
    list      => 'ARRAY',
    map       => [ 'ARRAY', 'HASH' ],
    string    => 'SCALAR',
    integer   => 'SCALAR',
    long      => 'SCALAR',
    timestamp => 'SCALAR',
    double    => 'SCALAR',
    boolean   => 'SCALAR',
    blob      => 'SCALAR',
  );

  my $required_type = $types{ $self->get_type };

  my $actual_type = ref($value) || 'SCALAR';

  check_type( $required_type, $actual_type )
    or croak sprintf '%s requires a value of type %s', ref $self,
    $required_type;

  my %init_value_subs = (
    structure => sub { $self->_init_structure },
    map       => sub { $self->_init_map },
    list      => sub { $self->_init_list },
    string    => sub { $self->_init_string },
    integer   => sub { $self->_init_integer },
  );

  my $sub = $init_value_subs{ $self->get_type } // sub { return $value };

  $self->set__value( $sub->() );

  return $value;
}

########################################################################
sub get_shape_type {
########################################################################
  my ($self) = @_;

  return 'MAP'
    if $self->is_map;

  return 'STRUCTURE'
    if $self->is_structure;

  return 'LIST'
    if $self->is_list;

  return 'SCALAR';
}

# 'finalization' of a shape is done in order to create a data structure
# that can then be used to create a Botocore request
########################################################################
sub finalize {
########################################################################
  my ( $self, $protocol ) = @_;

  local $PROTOCOL = $protocol
    if defined $protocol;

  return $self
    if !blessed $self;

  $self->get_logger->debug(
    sub {
      return Dumper(
        [ type       => $self->get_type,
          shape_type => $self->get_shape_type,
          shape      => $self,
          protocol   => $PROTOCOL,
        ]
      );
    }
  );

  my %dispatch = (
    SCALAR    => sub { return $self->get__value },
    MAP       => sub { return $self->finalize_map },
    LIST      => sub { return $self->finalize_list },
    STRUCTURE => sub { return $self->finalize_structure },
  );

  return $dispatch{ $self->get_shape_type }->();
}

########################################################################
sub finalize_map {
########################################################################
  my ($self) = @_;

  my $location_name = $self->{locationName};

  my ( $key, $value ) = @{$self}{qw(key value)};

  my $key_location_name   = $key->{locationName};
  my $value_location_name = $value->{locationName};

  $key   = $key_location_name   || undef;
  $value = $value_location_name || undef;

  my @elem_list = eval {
    my $values = $self->get__value;

    return @{$values}
      if reftype($values) ne 'HASH';

    return map {
      { $_ => $values->{$_} }
    } keys %{$values};
  };

  my $list
    = $key
    ? _create_key_value_list( $key, $value, @elem_list )
    : [@elem_list];

  return flatten( $location_name, $list )
    if $self->is_flattened;

  return $location_name ? { $location_name => $list } : $list;
}

# @list is an array of key/value hashes
########################################################################
sub _create_key_value_list {
########################################################################
  my ( $key, $value, @list ) = @_;

  my @kv_list;

  foreach my $p ( pairs map { %{$_} } @list ) {
    my ( $k, $v ) = @{$p};

    push @kv_list,
      {
      $key   => $k,
      $value => blessed $v ? $v->finalize : $v,
      };

  }

  return \@kv_list;
}

########################################################################
sub finalize_list {
########################################################################
  my ($self) = @_;

  my $member = $self->get_member;

  my $location_name = $member->{locationName};

  my $list = [];

  my $output;

  my @bare_list_protocols = qw( ec2 query );

  if ( $location_name && none { $PROTOCOL eq $_ } @bare_list_protocols ) {
    $output = {};
    $output->{$location_name} = $list;
  }
  else {
    $output = $list;
  }

  foreach my $elem ( @{ $self->get__value } ) {
    push @{$list}, $elem->finalize;
  }

  return flatten($output)
    if $self->is_flattened;

  return $output;
}

########################################################################
sub finalize_structure {
########################################################################
  my ($self) = @_;

  my $members = $self->get_members;

  $self->get_logger->debug(
    sub {
      return Dumper(
        [ sub     => 'finalize',
          members => $members,
          value   => $self->get__value,
        ]
      );
    }
  );

  my $output = {};

  foreach my $member ( keys %{$members} ) {

    my $member_name;

    if ( !$members->{$member}->{location} ) {
      $member_name = $members->{$member}->{locationName} // $member;
    }
    else {
      $member_name = $member;
    }

    next
      if !defined $self->get__value->{$member};

    my $value = $self->get__value->{$member};

    $output->{$member_name} = blessed $value && $value->can('finalize') ? $value->finalize : $value;
  }

  return $output;
}

1;

