#!/usr/bin/perl -w

use strict;
use warnings;

use lib 't/lib', 'lib';

use Frost::Test;

use Test::More 'no_plan';
use Test::Exception;
use Test::Differences;

$| = 1;

use Frost::Asylum;
use Frost::Util;

$Frost::Util::UUID_CLEAR	= 1;		#	delivers simple 'UUIDs' A-A-A-A-1, -2, -3... for testing

$Data::Dumper::Deparse	= true;

# =begin testing SETUP
{
	package Point;
#	use Moose;
	use Frost;

	has id	=> ( auto_id	=> 1 );

	has 'x' => (isa => 'Int', is => 'rw', required => 1);
	has 'y' => (isa => 'Int', is => 'rw', required => 1);

	sub clear {
		my $self = shift;
		$self->x(0);
		$self->y(0);
	}

	no Frost;
	__PACKAGE__->meta->make_immutable()		unless $::MAKE_MUTABLE;

	package Point3D;
	use Moose;

	extends 'Point';

	has 'z' => (isa => 'Int', is => 'rw', required => 1);

	after 'clear' => sub {
		my $self = shift;
		$self->z(0);
	};

	no Moose;
	__PACKAGE__->meta->make_immutable()		unless $::MAKE_MUTABLE;

	package main;

	use vars qw($CANVAS);

	$CANVAS = Frost::Asylum->new ( data_root	=> $TMP_PATH );

	# hash or hashrefs are ok for the constructor
	my $point1 = Point->new(x => 5, y => 7, asylum => $CANVAS );
	my $point2 = Point->new({x => 5, y => 7, asylum => $CANVAS });

	my $point3d = Point3D->new(x => 5, y => 42, z => -5, asylum => $CANVAS );

	$CANVAS->close;	#	and save
}

$CANVAS->clear;	#	delete all above points

my $POINT;

# =begin testing
{
	my $point = Point->new( x => 1, y => 2, asylum => $CANVAS );
	isa_ok( $point, 'Point' );
	isa_ok( $point, 'Moose::Object' );
	isa_ok( $point, 'Frost::Locum' );

	is( $point->x, 1, '... got the right value for x' );
	is( $point->y, 2, '... got the right value for y' );

	$point->y(10);
	is( $point->y, 10, '... got the right (changed) value for y' );

	$POINT	= { id => $point->id, x => $point->x, y => $point->y };

	$CANVAS->close;
}

{
	my $point	= Point->new ( id => $POINT->{id}, asylum => $CANVAS );
	isa_ok( $point, 'Point' );
	isa_ok( $point, 'Moose::Object' );
	isa_ok( $point, 'Frost::Locum' );

	is( $point->x, $POINT->{x}, '... got the right value for x (reloaded)' );
	is( $point->y, $POINT->{y}, '... got the right (changed) value for y (reloaded)' );

	dies_ok {
		$point->y('Foo');
	}
	'... cannot assign a non-Int to y';

	dies_ok {
		Point->new( asylum => $CANVAS );
	}
	'... must provide required attributes to new';

	$point->clear();

	is( $point->x, 0, '... got the right (cleared) value for x' );
	is( $point->y, 0, '... got the right (cleared) value for y' );

	$CANVAS->close;
}

# check the type constraints on the constructor

lives_ok {
	Point->new( x => 0, y => 0, asylum => $CANVAS );
}
'... can assign a 0 to x and y';

dies_ok {
	Point->new( x => 10, y => 'Foo', asylum => $CANVAS	);
}
'... cannot assign a non-Int to y';

dies_ok {
	Point->new( x => 'Foo', y => 10, asylum => $CANVAS );
}
'... cannot assign a non-Int to x';

# Point3D
{
	my $point3d = Point3D->new( { x => 10, y => 15, z => 3, asylum => $CANVAS} );
	isa_ok( $point3d, 'Point3D' );
	isa_ok( $point3d, 'Point' );
	isa_ok( $point3d, 'Moose::Object' );
	isa_ok( $point3d, 'Frost::Locum' );

	is( $point3d->x,	10, '... got the right value for x' );
	is( $point3d->y,	15, '... got the right value for y' );
#	is( $point3d->{'z'}, 3,	'... got the right value for z' );		#	verboten, always use accessors !
	is( $point3d->z, 3,	'... got the right value for z' );		#	verboten, always use accessors !

	$POINT	= { id => $point3d->id, x => $point3d->x, y => $point3d->y, z => $point3d->z };

	$CANVAS->close;
}

{
	my $point3d = Point3D->new( { id => $POINT->{id}, asylum => $CANVAS } );
	isa_ok( $point3d, 'Point3D' );
	isa_ok( $point3d, 'Point' );
	isa_ok( $point3d, 'Moose::Object' );
	isa_ok( $point3d, 'Frost::Locum' );

	is( $point3d->x,	10, '... got the right value for x' );
	is( $point3d->y,	15, '... got the right value for y' );
#	is( $point3d->{'z'}, 3,	'... got the right value for z' );		#	verboten, always use accessors !
	is( $point3d->z, 3,	'... got the right value for z' );		#	verboten, always use accessors !

	$point3d->clear();

	is( $point3d->x, 0, '... got the right (cleared) value for x' );
	is( $point3d->y, 0, '... got the right (cleared) value for y' );
	is( $point3d->z, 0, '... got the right (cleared) value for z' );

	$CANVAS->close;
}

dies_ok {
	Point3D->new( x => 10, y => 'Foo', z => 3, asylum => $CANVAS );
}
'... cannot assign a non-Int to y';

dies_ok {
	Point3D->new( x => 'Foo', y => 10, z => 3, asylum => $CANVAS );
}
'... cannot assign a non-Int to x';

dies_ok {
	Point3D->new( x => 0, y => 10, z => 'Bar', asylum => $CANVAS );
}
'... cannot assign a non-Int to z';

dies_ok {
	Point3D->new( x => 10, y => 3, asylum => $CANVAS );
}
'... z is a required attribute for Point3D';

#	DON'T DO THIS AT HOME!
#
#	We are NOT dead - test ist still running -,
#	so if we do not manually remove the failing
#	entry here, Locum->save will fail later,
#	because the object is incomplete -
#	i.e. asylum missing!
#
#	$CANVAS->remove;

# test some class introspection

can_ok( 'Point', 'meta' );
isa_ok( Point->meta, 'Moose::Meta::Class' );

can_ok( 'Point3D', 'meta' );
isa_ok( Point3D->meta, 'Moose::Meta::Class' );

isnt( Point->meta, Point3D->meta,
	'... they are different metaclasses as well' );

# poke at Point

eq_or_diff(
	[ Point->meta->superclasses ],
#	['Moose::Object'],
	['Frost::Locum'],
	'... Point got the automagic base class'
);

#	my @Point_methods = qw(meta x y clear);
my @Point_methods = qw(meta x y clear DESTROY new id);
#	my @Point_attrs = ( 'x', 'y' );
my @Point_attrs = ( 'x', 'y', 'id' );

eq_or_diff(
	[ sort Point->meta->get_method_list() ],
	[ sort @Point_methods ],
	'... we match the method list for Point'
);

eq_or_diff(
	[ sort @Point_attrs ],
	[ sort Point->meta->get_attribute_list() ],
	'... we match the attribute list for Point'
);

foreach my $method (@Point_methods) {
	ok( Point->meta->has_method($method),
		'... Point has the method "' . $method . '"' );
}

foreach my $attr_name (@Point_attrs) {
	ok( Point->meta->has_attribute($attr_name),
		'... Point has the attribute "' . $attr_name . '"' );
	my $attr = Point->meta->get_attribute($attr_name);
	ok( $attr->has_type_constraint,
		'... Attribute ' . $attr_name . ' has a type constraint' );
	isa_ok( $attr->type_constraint, 'Moose::Meta::TypeConstraint' );
	if ( $attr_name eq 'id' )
	{
		is( $attr->type_constraint->name, 'Frost::UniqueStringId',
			'... Attribute ' . $attr_name . ' has a Frost::UniqueStringId type constraint' );
	}
	else
	{
		is( $attr->type_constraint->name, 'Int',
			'... Attribute ' . $attr_name . ' has an Int type constraint' );
	}
}

# poke at Point3D

eq_or_diff(
	[ Point3D->meta->superclasses ],
	['Point'],
	'... Point3D gets the parent given to it'
);

#	my @Point3D_methods	= qw( meta z clear );
my @Point3D_methods = qw(meta z clear DESTROY new );	#	x y id	don't show up here...
my @Point3D_attrs		= ('z');									#	x y id	don't show up here...

eq_or_diff(
	[ sort Point3D->meta->get_method_list() ],
	[ sort @Point3D_methods ],
	'... we match the method list for Point3D'
);

eq_or_diff(
	[ sort Point3D->meta->get_attribute_list() ],
	[ sort @Point3D_attrs ],
	'... we match the attribute list for Point3D'
);

foreach my $method (@Point3D_methods) {
	ok( Point3D->meta->has_method($method),
		'... Point3D has the method "' . $method . '"' );
}

foreach my $attr_name (@Point3D_attrs) {
	ok( Point3D->meta->has_attribute($attr_name),
		'... Point3D has the attribute "' . $attr_name . '"' );
	my $attr = Point3D->meta->get_attribute($attr_name);
	ok( $attr->has_type_constraint,
		'... Attribute ' . $attr_name . ' has a type constraint' );
	isa_ok( $attr->type_constraint, 'Moose::Meta::TypeConstraint' );
	if ( $attr_name eq 'id' )
	{
		is( $attr->type_constraint->name, 'Frost::UniqueStringId',
			'... Attribute ' . $attr_name . ' has a Frost::UniqueStringId type constraint' );
	}
	else
	{
		is( $attr->type_constraint->name, 'Int',
			'... Attribute ' . $attr_name . ' has an Int type constraint' );
	}
}

#DEBUG 'B4 DONE...', Dumper $CANVAS;

diag "DONE";

1;