#!/usr/bin/perl

use Test::More;

use_ok( 'Brick' );
use_ok( 'Brick::Bucket' );

package Brick::Bucket;
use strict;
use warnings;

use Test::More 'no_plan';

=head1 NAME


=head1 SYNOPSIS


=head1 DESCRIPTION

This use case considers the complicated decision of trying to validate
the employment start date in a complicated situation. There are different
employee types, and within each type there are different pay bases. Some
pay bases have additional criteria. Here's the tree for this situation:

                                    Worker
                                    /   \
                    Faculty        /     \    Professional
               +------+------------       +-------+---------+----------+
              /        \                  |       |         |          |                               
             /          \               Hourly  Salary  Contractor   Extra                              
         Fall &        Fall,              /      /          |          |                                            
         Spring      Spring, &           /      /          /           |                   
          /           Summer            /      /          /            |                       
         /              \              /      /          /            /                
        /                \            /      /          /            /       
   Semester     	      \    Any valid    /          /            /                                   
    Start                  +---   Date ----+----------+            /                                          
    Date                                  \                       /                       
                                           \                     /                          
                                            \                +---+                           
                                             \              /                                                                                                                                                                                            
                                              \            /                                                                                                                                                                                               
                                               \           |                                                                                                                                                                                               
                                                |          |                                                                                                                                                                                                
                                            One-shot       |                                                                                                                                                                                                        
                                                |          |                                                                                                                                                                                               
                             -+-------+---------+----------+                           
                             /        \                                                    
                            /          \                                                   
                           /            \                                                  
                       Quarterly        Semi                                               
                        /              Annual                                           
                       /                   \                                          
                      /                     \                                          
                 Quarterly                   \                                         
                  Payroll                 Semi-Annual                                        
                   Date                     Payroll                                        
                                              date                                        


The input is the worker type, their pay basis, and a date. From there
the validator has to give a yes-or-no answer about the validity of the
date for that combination.


=head2 Writing the building block validators




=cut

my $bucket = Brick::Bucket->new;

=head3 Payroll dates

You have to start your job on the boundary of a payroll period. For
teachers that's a valid date for the start of a school term, although
there are three periods: Fall, Spring, and Summer. Some teachers get
paid just for Fall and Spring and some get paid for all three. For
full-time professionals that's any valid date, and for contractors
that's one of the semiannual or quarterly payroll dates. Contractors
who only get one check can start on any valid date. Some professional
workers can also be contractors by taking on extra projects.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_valid_semester_date {
	my( $bucket, $setup ) = @_;
	
	$bucket->add_to_bucket( {
		name        => '_is_valid_semester_date',
		description => 'Semester date validator',
		code        => sub {
			print STDERR "Running _is_valid_semester_date with $_[0]->{effective_date}\n" if $ENV{DEBUG};  
			$_[0]->{effective_date} =~ m/\d\d\d\d0(1|6|9)01/ 
				or die { message => 'Not a valid semester date' };
			}
		} );
	}

{
my $sub = $bucket->_is_valid_semester_date( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { effective_date => 19700101 } ), "valid semester works" );
ok(   $sub->( { effective_date => 19700601 } ), "valid semester works" );
ok(   $sub->( { effective_date => 19700901 } ), "valid semester works" );
ok( ! eval { $sub->( { effective_date => 19700801 } ) }, "invalid semester doesn't work" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_valid_fall_or_spring_date {
	my( $bucket, $setup ) = @_;
	
	$bucket->add_to_bucket( {
		name        => '_is_valid_fall_or_spring_date',
		description => 'Spring or Fall semester date validator',
		handler     => '_is_valid_fall_or_spring_date',
		code        => sub {
			print STDERR "Running _is_valid_fall_or_spring_date with $_[0]->{effective_date}\n" if $ENV{DEBUG};  
			$_[0]->{effective_date} =~ m/\d\d\d\d0(1|9)01/ 
				or die { message => 'Not a valid semester date' };
			}
		} );
	}

{
my $sub = $bucket->_is_valid_fall_or_spring_date( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { effective_date => 19700101 } ), "valid semester works" );
ok(   $sub->( { effective_date => 19700901 } ), "valid semester works" );
ok( ! eval { $sub->( { effective_date => 19700601 } ) }, "Summer isn't Fall or Spring" );
ok( ! eval { $sub->( { effective_date => 19700801 } ) }, "August isn't Fall or Spring" );
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_valid_paydate {
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => '_is_valid_paydate',
		description => 'Paydate validator',
		code        => sub {
			print STDERR "Running _is_valid_semester_date with $_[0]->{effective_date}\n" if $ENV{DEBUG};  
			$_[0]->{effective_date} =~ m/\d\d\d\d(0[1-9]|1[0-2])\d\d/
				or die { message => 'Not a valid pay date' };
			}
		} );
	}

{
my $sub = $bucket->_is_valid_paydate( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { effective_date => 19700101 } ), "valid paydate works" );
ok(   $sub->( { effective_date => 19700615 } ), "valid paydate works" );
ok(   $sub->( { effective_date => 19700801 } ), "valid paydate works" );
ok( ! eval { $sub->( { effective_date => 1970080 } ) },  "invalid paydate doesn't work" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_semiannual_payroll_date {
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => '_is_semiannual_payroll_date',
		description => 'Semiannual date selector',
		code        => sub {
			print STDERR "Running _is_semiannual_payroll_date with $_[0]->{effective_date}\n" if $ENV{DEBUG};  
			$_[0]->{effective_date} =~ m/\d\d\d\d0(1|6)01/
				or die { message => 'Not a valid semiannual pay date' };
			}
		} );
	}

{
my $sub = $bucket->_is_semiannual_payroll_date( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { effective_date => 19700101 } ), "valid semiannual works" );
ok(   $sub->( { effective_date => 19700601 } ), "valid semiannual works" );
ok( ! eval { $sub->( { effective_date => 19700801 } ) },  "invalid semiannual doesn't work" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_quarterly_payroll_date {
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => '_is_quarterly_payroll_date',
		description => 'Quarterly date selector',
		code        => sub {
			print STDERR "Running _is_quarterly_payroll_date with $_[0]->{effective_date}\n" if $ENV{DEBUG};  
			$_[0]->{effective_date} =~ m/\d\d\d\d(01|04|07|10)01/
				or die { message => 'Not a valid quarterly pay date' };
			}
		} );
	}

{
my $sub = $bucket->_is_quarterly_payroll_date( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { effective_date => 19700101 } ), "valid quarterly works" );
ok(   $sub->( { effective_date => 19700401 } ), "valid quarterly works" );
ok(   $sub->( { effective_date => 19700701 } ), "valid quarterly works" );
ok(   $sub->( { effective_date => 19701001 } ), "valid quarterly works" );
ok( ! eval { $sub->( { effective_date => 19700801 } ) },  "invalid semiannual doesn't work" );
}

=head3 Worker type selectors

These validation routines return true if they match the pay basis and
undef otherwise. When they return undef, they can prune the traversal
of the tree.

Selectors should never return 0, which would indicate a hard failure
of the validation instead of a "don't go this way" failure.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_faculty
	{
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => 'is_faculty',
		description => 'Faculty selector',
		code        => sub  { $_[0]->{worker_type} eq "Faculty" ? 1 : () },
		} );
	}

{
my $sub = $bucket->_is_faculty( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { worker_type => 'Faculty'      } ), "valid worker type works" );
ok( ! $sub->( { worker_type => 'Professional' } ), "invalid worker type doesn't work" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_professional
	{
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => 'is_professional',
		description => 'Faculty selector',
		code        =>  sub { $_[0]->{worker_type} eq "Professional" ? 1 : () },
		} );
	}

{
my $sub = $bucket->_is_professional( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { worker_type => 'Professional' } ), "valid worker type works" );
ok( ! $sub->( { worker_type => 'Faculty'      } ), "invalid worker type doesn't work" );
}
	
=head3 Pay basis type selectors

These validation routines return true if they match the pay basis and
undef otherwise.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_faculty_21
	{
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => 'is_faculty_21',
		description => 'Faculty 21 selector',
		code        => sub { $_[0]->{pay_basis} eq "Faculty 21" ? 1 : () },
		} );
	}

{
my $sub = $bucket->_is_faculty_21( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { pay_basis => 'Faculty 21'      } ), "valid pay basis works" );
ok( ! $sub->( { pay_basis => 'Faculty 26' }      ), "invalid pay basis doesn't work" );
ok( ! $sub->( { pay_basis => 'Faculty' }         ), "invalid pay basis doesn't work" );
}
	
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_faculty_26
	{
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => 'is_faculty_26',
		description => 'Faculty 26 selector',
		code        => sub { $_[0]->{pay_basis} eq "Faculty 26" ? 1 : () },
		} );
	}

{
my $sub = $bucket->_is_faculty_26( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { pay_basis => 'Faculty 26'      } ), "valid pay basis works" );
ok( ! $sub->( { pay_basis => 'Faculty 21' }      ), "invalid pay basis doesn't work" );
ok( ! $sub->( { pay_basis => 'Faculty' }         ), "invalid pay basis doesn't work" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_hourly
	{
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => 'is_hourly',
		description => 'Hourly selector',
		code        => sub { $_[0]->{pay_basis} eq "Hourly"     ? 1 : () },
		} );
	}

{
my $sub = $bucket->_is_hourly( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { pay_basis => 'Hourly'     } ), "valid pay basis works" );
ok( ! $sub->( { pay_basis => 'Faculty 21' } ), "invalid pay basis doesn't work" );
ok( ! $sub->( { pay_basis => 'Salary'     } ), "invalid pay basis doesn't work" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_salary
	{
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => 'is_salary',
		description => 'Salary selector',
		code        => sub { $_[0]->{pay_basis} eq "Salary"     ? 1 : () },
		} );
	}

{
my $sub = $bucket->_is_salary( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { pay_basis => 'Salary'     } ), "valid pay basis works" );
ok( ! $sub->( { pay_basis => 'Faculty 21' } ), "invalid pay basis doesn't work" );
ok( ! $sub->( { pay_basis => 'Fee'        } ), "invalid pay basis doesn't work" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_fee_based
	{
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => 'is_fee_based',
		description => 'Fee selector',
		code        => sub { $_[0]->{pay_basis} eq "Fee"        ? 1 : () },
		} );
	}

{
my $sub = $bucket->_is_fee_based( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { pay_basis => 'Fee'        } ), "valid pay basis works" );
ok( ! $sub->( { pay_basis => 'Hourly'     } ), "invalid pay basis doesn't work" );
ok( ! $sub->( { pay_basis => 'Extra'      } ), "invalid pay basis doesn't work" );
}
	
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_extra_service
	{
	my( $bucket, $setup ) = @_;

	$bucket->add_to_bucket( {
		name        => 'is_extra_service',
		description => 'Extra service selector',
		code        => sub { $_[0]->{pay_basis} eq "Extra"      ? 1 : () },
		} );
	}

{
my $sub = $bucket->_is_extra_service( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { pay_basis => 'Extra'      } ), "valid pay basis works" );
ok( ! $sub->( { pay_basis => 'Faculty 26' } ), "invalid pay basis doesn't work" );
ok( ! $sub->( { pay_basis => 'Fee'        } ), "invalid pay basis doesn't work" );
}
	
=head3 Pay frequency selectors

These validation routines return true if they match the pay frequnecy
and undef otherwise.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_quarterly
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->add_to_bucket( {
		name        => 'is_quarterly',
		description => 'Quarterly selector',
		code   => sub { $_[0]->{payments} eq "Quarterly" ? 1 : () },
		} );	
	}

{
my $sub = $bucket->_is_quarterly( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { payments => 'Quarterly'     } ), "valid payment frequency works" );
ok( ! $sub->( { payments => 'Semi-annually' } ), "invalid payment frequency doesn't work" );
ok( ! $sub->( { payments => 'Single'        } ), "invalid payment frequency doesn't work" );
}
	
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_semiannually
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->add_to_bucket( {
		name        => 'is_semiannually',
		description => 'Semiannually selector',
		code        => sub { $_[0]->{payments} eq "Semi-annually"  ? 1 : () },
		} );
	}

{
my $sub = $bucket->_is_semiannually( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { payments => 'Semi-annually' } ), "valid payment frequency works" );
ok( ! $sub->( { payments => 'Quarterly'     } ), "invalid payment frequency doesn't work" );
ok( ! $sub->( { payments => 'Single'        } ), "invalid payment frequency doesn't work" );
}
	
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _is_single_payment
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->add_to_bucket( {
		name        => 'is_single_payment',
		description => 'Single payment selector',
		code        => sub { $_[0]->{payments} eq "Single" ? 1 : () },
		} );
	}

{
my $sub = $bucket->_is_single_payment( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( { payments => 'Single'        } ), "valid payment frequency works" );
ok( ! $sub->( { payments => 'Semi-annually' } ), "invalid payment frequency doesn't work" );
ok( ! $sub->( { payments => 'Quarterly'     } ), "invalid payment frequency doesn't work" );
}

=head2 Composing the selectors and validators

First, I compose the lowest level selectors and their date validators. These
will become part of the larger traversal tree and the selector will be able
to signal the traverser to not follow a branch. Use __compose_pass_or_stop
as the composer, which stops evaluating its subroutines at the first failure.
Since the selector does not die and simply returns undef, it won't stop the
validation. Instead, it allows the next higher level to continue with its
work.

I use __compose_pass_or_stop when I want to ignore the rest of the subroutines
in the composition if one of them doesn't pass (but without die-ing).

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _faculty_21_pass_or_stop
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_stop( 
		$bucket->_is_faculty_21( $setup ), 
		$bucket->_is_valid_fall_or_spring_date( $setup ),
		);
	}

{
my $sub = $bucket->_faculty_21_pass_or_stop( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( 
	{ 
	worker_type    => 'Faculty',
	pay_basis      => 'Faculty 21', 
	effective_date => '19700101', 
	} ), 
	"Faculty 21 valid effective date works" 
	);

my $result = eval { $sub->( 
	{ 
	worker_type    => 'Faculty',
	pay_basis      => 'Faculty 21', 
	effective_date => '19700201', 
	} ) };
my $at = $@;

ok( ! $result, "Faculty 21 invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _faculty_26_pass_or_stop
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_stop( 
		$bucket->_is_faculty_26( $setup ), 
		$bucket->_is_valid_paydate( $setup ),
		);
	}

{
my $sub = $bucket->_faculty_26_pass_or_stop( {} );
isa_ok( $sub, ref sub {} );
ok( $sub->( 
	{ 
	worker_type    => 'Faculty',
	pay_basis      => 'Faculty 26', 
	effective_date => '19700515', 
	} ), 
	"Faculty 26 valid effective date works" 
	);

my $result = eval { $sub->( 
	{ 
	worker_type    => 'Faculty',
	pay_basis      => 'Faculty 26', 
	effective_date => '1970020', 
	} ) };
my $at = $@;
	
ok( ! $result, "Faculty 26 invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _hourly_pass_or_stop
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_stop( 
		$bucket->_is_hourly( $setup ), 
		$bucket->_is_valid_paydate( $setup ),
		);
	}

{
my $sub = $bucket->_hourly_pass_or_stop( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( 
	{ 
	worker_type    => 'Professional',
	pay_basis      => 'Hourly', 
	effective_date => '19700515', 
	} ), 
	"Hourly valid effective date works" 
	);

my $result = eval { $sub->( 
	{ 
	worker_type    => 'Professional',
	pay_basis      => 'Hourly', 
	effective_date => '1970020', 
	} ) };
my $at = $@;
	
ok( ! $result, "Hourly invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}


# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _salary_pass_or_stop
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_stop( 
		$bucket->_is_salary( $setup ), 
		$bucket->_is_valid_paydate( $setup ),
		);
	}

{
my $sub = $bucket->_salary_pass_or_stop( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( 
	{ 
	worker_type    => 'Professional',
	pay_basis      => 'Salary', 
	effective_date => '19700515', 
	} ), 
	"Hourly valid effective date works" 
	);

my $result = eval { $sub->( 
	{ 
	worker_type    => 'Professional',
	pay_basis      => 'Salary', 
	effective_date => '1970020', 
	} ) };
my $at = $@;
	
ok( ! $result, "Salary invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _fee_based_pass_or_stop
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_stop( 
		$bucket->_is_fee_based( $setup ), 
		$bucket->_is_valid_paydate( $setup ),
		);
	}

{
my $sub = $bucket->_fee_based_pass_or_stop( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( 
	{ 
	worker_type    => 'Professional',
	pay_basis      => 'Fee', 
	effective_date => '19700515', 
	} ), 
	"Hourly valid effective date works" 
	);

my $result = eval { $sub->( 
	{ 
	worker_type    => 'Professional',
	pay_basis      => 'Fee', 
	effective_date => '1970020', 
	} ) };
my $at = $@;
	
ok( ! $result, "Fee invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}


=pod

The extra service fee based ones are special and require an extra level. Once
I compose the pay frequency with the date validator for it, I compose all of
those with the __compose_pass_or_skip.

I use __compose_pass_or_skip when I want to try several subroutines until I
find one that works.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _quarterly_pass_or_stop
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_stop( 
		$bucket->_is_quarterly( $setup ), 
		$bucket->_is_quarterly_payroll_date( $setup ),
		);
	}

{
my $sub = $bucket->_quarterly_pass_or_stop( {} );
isa_ok( $sub, ref sub {} );
ok(  $sub->( 
	{ 
	payments	   => 'Quarterly',
	effective_date => '19700101', 
	} ), 
	"Quarterly valid effective date works" 
	);

#print Data::Dumper->Dump( [$@], [qw(@)] );
#print Data::Dumper->Dump( [$result], [qw(result)] );

my $result = eval { $sub->( 
	{ 
	payments	   => 'Quarterly',
	effective_date => '19700201', 
	} ) };
my $at = $@;
	
ok( ! $result, "Quarterly invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _semi_pass_or_stop
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_stop( 
		$bucket->_is_semiannually( $setup ), 
		$bucket->_is_semiannual_payroll_date( $setup ), 
		);
	}

{
my $sub = $bucket->_semi_pass_or_stop( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( 
	{ 
	payments       => 'Semi-annually',
	effective_date => '19700601', 
	} ), 
	"Semi-annually valid effective date works" 
	);

my $result = eval { $sub->( 
	{ 
	payments       => 'Semi-annually',
	effective_date => '19700201', 
	} ) };
my $at = $@;
	
ok( ! $result, "Semi-annually invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _single_pass_or_stop
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_stop( 
		$bucket->_is_single_payment( $setup ), 
		$bucket->_is_valid_paydate( $setup ),
		);
	}

{
my $sub = $bucket->_single_pass_or_stop( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( 
	{ 
	payments       => 'Single',
	effective_date => '19700714', 
	} ), 
	"Single valid effective date works" 
	);

my $result = eval { $sub->( 
	{ 
	payments       => 'Single',
	effective_date => '1700201', 
	} ) };
my $at = $@;
	
ok( ! $result, "Single invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _extra_pass_or_skip
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_skip( 
		$bucket->_quarterly_pass_or_stop( $setup ),
		$bucket->_semi_pass_or_stop( $setup ),
		$bucket->_single_pass_or_stop( $setup ),	
		);
	}

{
my $sub = $bucket->_extra_pass_or_skip( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( 
	{ 
	pay_basis      => 'Extra',
	payments       => 'Single',
	effective_date => '19700714', 
	} ), 
	"Extra, Single valid effective date works" 
	);

ok(   $sub->( 
	{ 
	pay_basis      => 'Extra',
	payments       => 'Quarterly',
	effective_date => '197000401', 
	} ), 
	"Extra, Quarterly valid effective date works" 
	);
	
ok(   $sub->( 
	{ 
	pay_basis      => 'Extra',
	payments       => 'Semi-annually',
	effective_date => '19700601', 
	} ), 
	"Extra, Semi-annually valid effective date works" 
	);
	
my $result = eval { $sub->( 
	{ 
	pay_basis      => 'Extra',
	payments       => 'Single',
	effective_date => '1700201', 
	} ) };
my $at = $@;
	
ok( ! $result, "Single invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _extra_pass_or_stop
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_stop(
		$bucket->_is_extra_service( $setup ),
		$bucket->_extra_pass_or_skip( $setup ),
		);
	}

{
my $sub = $bucket->_extra_pass_or_stop( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( 
	{
	pay_basis      => 'Extra',
	payments       => 'Single',
	effective_date => '19700714', 
	} ), 
	"Single valid effective date works" 
	);

ok( ! $sub->( 
	{
	pay_basis      => 'Hourly',
	payments       => 'Single',
	effective_date => '19700714', 
	} ), 
	"hourly pay_basis doesn't work for Extra type" 
	);
	
my $result = eval { $sub->( 
	{ 
	pay_basis      => 'Extra',
	payments       => 'Quarterly',
	effective_date => '1700201', 
	} ) };
my $at = $@;
	
ok( ! $result, "Single invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}

=head3 Composing the pay basis types

Next, I take all of the composed subs for each pay basis type and compose
them into a single subroutine for that worker type.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _faculty_composed
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_skip(
		$bucket->_faculty_21_pass_or_stop( $setup ),
		$bucket->_faculty_26_pass_or_stop( $setup ),
		);
	}

{
my $sub = $bucket->_faculty_composed( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( 
	{
	pay_basis      => 'Faculty 21',
	effective_date => '19700901', 
	} ), 
	"Faculty 21 Fall semester date works" 
	);

ok(   $sub->( 
	{
	pay_basis      => 'Faculty 26',
	effective_date => '19700601', 
	} ), 
	"Faculty 26 Summer semester date works" 
	);

ok( ! eval {  $sub->( 
	{
	pay_basis      => 'Faculty 21',
	effective_date => '19700601', 
	} ) }, 
	"Faculty 21 Summer semester date doesn't work" 
	);
	
ok( ! eval { $sub->( 
	{
	pay_basis      => 'Hourly',
	payments       => 'Single',
	effective_date => '19700714', 
	} ) }, 
	"hourly pay_basis doesn't work for Extra type" 
	);
	
my $result = eval { $sub->( 
	{ 
	pay_basis      => 'Extra',
	payments       => 'Quarterly',
	effective_date => '1700201', 
	} ) };
my $at = $@;
	
ok( ! $result, "Single invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}


# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _professional_composed
	{
	my( $bucket, $setup ) = @_;
	
	$bucket->__compose_pass_or_skip(
		$bucket->_hourly_pass_or_stop( $setup ),
		$bucket->_salary_pass_or_stop( $setup ),
		$bucket->_extra_pass_or_stop( $setup ),
		$bucket->_fee_based_pass_or_stop( $setup ),
		);
	}


{
my $sub = $bucket->_professional_composed( {} );
isa_ok( $sub, ref sub {} );
ok(   $sub->( 
	{
	pay_basis      => 'Hourly',
	effective_date => '19700901', 
	} ), 
	"Hourly Fall semester date works" 
	);

ok(  $sub->( 
	{
	pay_basis      => 'Hourly',
	effective_date => '19700714', 
	} ), 
	"Hourly Bastille Day date works" 
	);

ok(  $sub->( 
	{
	pay_basis      => 'Salary',
	effective_date => '19700704', 
	} ), 
	"Salary 4th of July date works" 
	);

ok(  ! eval { $sub->( 
	{
	pay_basis      => 'Extra',
	payments       => 'Quarterly',
	effective_date => '19411207', 
	} ) }, 
	"Extra Pearl Harbor Day doesn't work" 
	);
	
my $result = eval { $sub->( 
	{ 
	pay_basis      => 'Extra',
	payments       => 'Quarterly',
	effective_date => '1700201', 
	} ) };
my $at = $@;
	
ok( ! $result, "Single invalid effective date doesn't work" );
isa_ok( $at, ref {} );
ok( exists $at->{message}, "Key 'message' exists in error hash" );
}

=head3 Composing the worker types

Next, I take all of the composed subs for each worke type and compose
them into a single subroutine for that for a grand subroutine.

=cut

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub effective_date
	{
	my( $bucket, $setup ) = @_;
	
	my $grand_composed = $bucket->__compose_pass_or_skip(
		$bucket->_faculty_composed( $setup ),
		$bucket->_professional_composed( $setup ),
		);

	$bucket->__make_constraint( $grand_composed, $setup );
	}
	
{
my $sub = $bucket->effective_date( {} );
isa_ok( $sub, ref sub {} );
}

my $brick = Brick->new;

my $Input   = {
	worker_type    => 'Faculty',
	pay_basis      => 'Faculty 21',
	effective_date => 1970091,
	};
	
my $setup    = {
	required_fields => [ qw(worker_type pay_basis effective_date) ],
	};

my $Profile = [
	[ required_input => required_fields => $setup ],
	[ effective_date => effective_date  => $setup ],
	];
	
my $lint = $brick->lint( $Profile );
is( $lint, 0, "Profile passes lint" );

print STDERR $brick->explain( $Profile ) if $ENV{DEBUG};


my $results = $brick->apply( $Profile, $Input );
print STDERR Data::Dumper->Dump( [$results], [qw(results)] ) if $ENV{DEBUG};

isa_ok( $results, ref [], "Results is an array reference" );
is( scalar @$results, scalar @$Profile, 
	"Results has same number of elements as profile" );
