#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 41;
use Test::Exception;
use InterMine::Model::TestModel;
use Webservice::InterMine::Path qw(:validate);

# internal functions we would like access to for testing
my $parse      = Webservice::InterMine::Path->can('_parse');
my $class_of   = Webservice::InterMine::Path->can('class_of');
my $next_class = Webservice::InterMine::Path->can('next_class');
my $last_bit   = Webservice::InterMine::Path->can('last_bit');

my $model = InterMine::Model::TestModel->instance;

my $good_path_string = 'Department.employees.name';
my $bad_class_string = 'Foo.bar.baz';
my $bad_ref_string   = 'Department.foo.baz';
my $bad_att_string   = 'Department.employees.wibble';
my $short_string     = 'Department';
my $two_bit_string   = 'Department.employees';

my $class = $model->get_classdescriptor_by_name('Department'); #Company -> Company
my $ref   = $class->get_field_by_name('employees');              #address -> Address
my $att   = $ref->referenced_classdescriptor->get_field_by_name('name');

is($class_of->($class), 'Department', 'Gets class of class');
is($class_of->($ref),   'Employee',   'Gets class of reference');
is($class_of->($att),   undef,       'Returns undef for attributes');


is($next_class->($class, $model), 'Department', 'Next class of a cd is the cd');
is($next_class->($ref, $model), 'Employee', 'Next class of a ref is the ref cd');
is($next_class->($att, $model), undef, 'Next class of an att is undef');
is($next_class->($ref, $model, 'Manager'), 'Manager', 
   'Next class of a subclassed path is the subclass');

throws_ok( sub {$next_class->($ref, $model, 'Foo')},
	   qr/Foo not in the model/,
	   'Catches bad next class');
dies_ok( sub {$next_class->($model, $ref)}, 'Dies on bad input');
my @parts;
lives_ok(sub {@parts = $parse->($model, $good_path_string)}, 
    'Can parse a good path');
is(scalar(@parts), 3, 'Gets the number of parts right');
like($parts[0]->name(), qr/Department$/, 'class name of start of path');
ok($parts[0]->isa('InterMine::Model::ClassDescriptor'), 
    'start of path is a class descriptor');
is($parts[1]->name(), 'employees', 'reference name of middle of path');
ok($parts[1]->isa('InterMine::Model::Reference'),
    'middle of path is a reference descriptor');
is($parts[2]->name(), 'name', 'attribute name of end of path');
ok($parts[2]->isa('InterMine::Model::Attribute'),
   'end of path is a reference descriptor');

throws_ok(sub {$parse->($model, $bad_class_string)},
        qr/Foo not in the model/,
        'Catches bad top class');
throws_ok(sub {$parse->($model, $bad_ref_string)},
        qr/illegal path \($bad_ref_string\): can't find field "foo"/,
        'Catches bad reference');
throws_ok(sub {$parse->($model, $bad_att_string)},
        qr/illegal path \($bad_att_string\): can't find field "wibble"/,
        'Catches bad attribute');

dies_ok(sub {validate_path($good_path_string)},
	 'Dies calling validate_path without model');
dies_ok(sub {validate_path($model, $good_path_string, [])},
	 'Dies calling validate_path with an arrayref');
dies_ok(sub {validate_path($model, {})},
	 'Dies calling validate_path with a typehash and no path');
is(validate_path($model, $good_path_string), undef, 'Returns undef to validate a good path');

like(validate_path($model, $bad_class_string), 
     qr/Foo not in the model/, 
     'Returns errors for top class');
like(validate_path($model, $bad_ref_string), 
     qr/illegal path \($bad_ref_string\): can't find field "foo"/,
     'Returns errors for bad reference');
like(validate_path($model, $bad_att_string), 
     qr/illegal path \($bad_att_string\): can't find field "wibble"/,
     'Returns errors for bad attribute');

is($last_bit->($model, $short_string), $class, 
   'Can get the last bit off a one bit name');
is($last_bit->($model, $two_bit_string), $ref, 
   'Can get the last bit off a two bit name');
is($last_bit->($model, $good_path_string), $att, 
   'Can get the last bit off a longer name');
dies_ok( sub {$last_bit->($good_path_string, $model)}, 
	 'last_bit dies on bad arguments');

is(end_is_class($model, $short_string), undef, 
   'end_is_class returns no errors for a class');
is(end_is_class($model, $two_bit_string), undef, 
   'end_is_class returns no errors for a class and ref');
like(end_is_class($model, $good_path_string),
     qr/$good_path_string: name is a .*String, not a class/,
     'end_is_class returns errors for a class and ref and attribute');
dies_ok( sub {$last_bit->($good_path_string, $model)}, 
	 'end_is_class dies on bad arguments');

is(b_is_subclass_of_a($model, 'Department.employees', 'Manager'), undef, 
   'No errors if b is a subclass of a');
like(b_is_subclass_of_a($model, 'Manager', 'Employee'),
      qr/Employee.*not a subclass of Manager/,
      'Errors if b is not a subclass of a');
is(b_is_subclass_of_a($model, 'Foo', 'Bar'), undef, 
   'Bad paths do not throw an error (they get validated by validate_path)');

is(a_is_subclass_of_b($model, 'Department.manager', 'Employee'), undef, 
   'No errors if b is a subclass of a');
like(a_is_subclass_of_b($model, 'Employee', 'Manager'),
      qr/Employee.*not a subclass of Manager/,
      'Errors if b is not a subclass of a');
is(a_is_subclass_of_b($model, 'Foo', 'Bar'), undef, 
   'Bad paths do not throw an error (they get validated by validate_path)');