#!perl -w

use strict;

use Test::More;

# Testing _check_subobj()


use Array::To::Moose qw(array_to_moose throw_multiple_rows);

BEGIN {
  eval "use Test::Exception";
  plan skip_all => "Test::Exception needed" if $@;
}

plan tests => 11;

#----------------------------------------
package Sibling;
use namespace::autoclean;
use Moose;
use MooseX::StrictConstructor;

has [ qw( name sex ) ] => (is => 'rw', isa => 'Str' );

__PACKAGE__->meta->make_immutable;

#----------------------------------------
package Cousin;
use namespace::autoclean;
use Moose;
use MooseX::StrictConstructor;

has [ qw( name sex ) ] => (is => 'rw', isa => 'Str' );

__PACKAGE__->meta->make_immutable;

#----------------------------------------
package Person;
use namespace::autoclean;
use Moose;
use MooseX::StrictConstructor;

has [ qw( name sex ) ] => (is => 'rw', isa =>          'Str' );
has SibH               => (is => 'rw', isa => 'HashRef[Sibling]' );
has SibA               => (is => 'rw', isa => 'ArrayRef[Sibling]');
has SibB               => (is => 'rw', isa =>           'Sibling'); # (B)are

__PACKAGE__->meta->make_immutable;

package main;

my @s1 = ( 'John', 'm' );
my @s2 = ( 'Jane', 'f' );

my @p1 = ( 'Bill', 'm' );
my @p2 = ( 'Pam',  'f' );

my $data = [ [ @p1, @s1 ],
             [ @p1, @s2 ],
             [ @p2, @s1 ],
             [ @p2, @s2 ],
           ];

# Moose says HashRef, desc says ArrayRef
#----------------------------------------
my $desc = {  class => 'Person',
           name  => 0,
           sex   => 1,
           SibH  => {
             class => 'Sibling',
             name  => 2,
             sex   => 3,
           }
};

throws_ok { array_to_moose(data => $data, desc => $desc); }
  qr/'SibH' has type 'HashRef\[Sibling\]' but your.*of type 'ARRAY'/,
'_check_subobj(): Moose says HashRef[`a], desc says ArrayRef[`a]';

# Moose says HashRef[`a] desc says Hashref[`b]
#----------------------------------------
$desc = {  class => 'Person',
              name  => 0,
              sex   => 1,
              SibH  => {
                class => 'Cousin',    # !! should be Sibling
                key   => 2,
                name  => 2,
                sex   => 3,
              }
};

throws_ok { array_to_moose(data => $data, desc => $desc); }
  qr/'SibH' has type 'HashRef\[Sibling\]' but your.*of type 'HashRef\[Cousin\]'/,
  '_check_subobj(): Moose says HashRef[`a], desc says HashRef[`b]';

# Moose and desc both say HashRef[`a]
#----------------------------------------
$desc = {  class => 'Person',
           name  => 0,
           sex   => 1,
           SibH  => {
             class => 'Sibling',
             key   => 2,
             name  => 2,
             sex   => 3,
           }
};

lives_ok { array_to_moose(data => $data, desc => $desc) }
  '_check_subobj(): Moose & desc both say HashRef[`a]';

# Moose says ArrayRef, desc says HashRef
#----------------------------------------
$desc = {  class => 'Person',
           name  => 0,
           sex   => 1,
           SibA  => {
             class => 'Sibling',
             key => 2,            # force it to be a hashref
             name  => 2,
             sex   => 3,
           }
};

throws_ok { array_to_moose(data => $data, desc => $desc); }
  qr/'SibA' has type 'ArrayRef\[Sibling\]' but your.*of type 'HASH'/,
'_check_subobj(): Moose says ArrayRef[`a], desc says HashRef[`a]';

# Moose says ArrayRef[`a], desc says ArrayRef[`b]
#----------------------------------------
$desc = {  class => 'Person',
              name  => 0,
              sex   => 1,
              SibA  => {
                class => 'Cousin',    # !! should be Sibling
                name  => 2,
                sex   => 3,
              }
};

throws_ok { array_to_moose(data => $data, desc => $desc); }
  qr/'SibA' has type 'ArrayRef\[Sibling\]' but your.*of type 'ArrayRef\[Cousin\]'/,
  '_check_subobj(): Moose says ArrayRef[`a], desc says ArrayRef[`b]';


# Moose and desc both say ArrayRef[`a]
#----------------------------------------
$desc = {  class => 'Person',
           name  => 0,
           sex   => 1,
           SibA  => {
             class => 'Sibling',
             name  => 2,
             sex   => 3,
           }
};

lives_ok { array_to_moose(data => $data, desc => $desc) }
  '_check_subobj(): Moose & desc both say ArrayRef[`a]';

# Moose says `a, desc says HashRef[`a]
#----------------------------------------
$desc = {  class => 'Person',
           name  => 0,
           sex   => 1,
           SibB  => {
             class => 'Sibling',
             key => 2,            # force it to be a hashref
             name  => 2,
             sex   => 3,
           }
};

throws_ok { array_to_moose(data => $data, desc => $desc); }
  qr/'SibB' has type 'Sibling' but your.* a 'HASH'.*expected ARRAY/,
'_check_subobj(): Moose says `a, desc says HashRef[`a]';

# Moose says `a, desc says ArrayRef[`a] which is converted to `a
#----------------------------------------
$desc = {  class => 'Person',
           name  => 0,
           sex   => 1,
           SibB  => {
             class => 'Sibling',
             name  => 2,
             sex   => 3,
           }
};

lives_ok { array_to_moose(data => $data, desc => $desc); }
'_check_subobj(): Moose says `a, desc says ArrayRef[`a]';

# Moose says `a, desc says `b
#----------------------------------------
$desc = {  class => 'Person',
              name  => 0,
              sex   => 1,
              SibB  => {
                class => 'Cousin',    # !! should be Sibling
                name  => 2,
                sex   => 3,
              }
};

throws_ok { array_to_moose(data => $data, desc => $desc); }
  qr/'SibB' has type 'Sibling' but your.*of type 'Cousin'/,
  '_check_subobj(): Moose says `a, desc says `b';

# Moose says `a, desc returns multiple rows, throw_multiple_rows is "on"
#----------------------------------------
throw_multiple_rows();

$desc = {  class => 'Person',
              name  => 0,
              sex   => 1,
              SibB  => {
                class => 'Sibling',
                name  => 2,
                sex   => 3,
              }
};

throws_ok { array_to_moose(data => $data, desc => $desc); }
  qr/Expected a single 'Sibling' object, but got \d of them at/,
  '_check_subobj(): Moose says single `a, but > 1 (throw)';

# Moose says `a, desc returns multiple rows, throw_multiple_rows is "off"
#----------------------------------------
throw_multiple_rows(0);

$desc = {  class => 'Person',
              name  => 0,
              sex   => 1,
              SibB  => {
                class => 'Sibling',
                name  => 2,
                sex   => 3,
              }
};

lives_ok { array_to_moose(data => $data, desc => $desc); }
  "_check_subobj(): Moose says single `a, got > 1 (don't care)";