package Grades::Types;
{
  $Grades::Types::VERSION = '0.15';
}

use List::MoreUtils qw/all/;

use MooseX::Types -declare =>
	[ qw/PlayerName PlayerNames AbsenteeNames PlayerId Member Members
		Results
		HomeworkResult
		HomeworkPoints Cutpoints HomeworkWork HomeworkWorks
		HomeworkRound HomeworkRounds RoundsResults
		Beancans Card TortCard
		Exam
		Weights/ ];

use MooseX::Types::Moose qw/Value Int Num Ref ArrayRef HashRef Str Maybe/;

=head1 NAME

Grades::Types - MooseX::Type checks for homework, classwork and exams data

=head1 SYNOPSIS

	use Grades;
	use Grades::Types qw/Beancans Card/;

	has 'beancanseries' => (is => 'ro', isa => Beancans, lazy_build => 1);
	method _build_beancanseries {
		my $series = $self->series;
		my $league = $self->league->id;
		+{ map { $_ => $self->inspect( "$league/$_/beancans.yaml" ) }
			@$series };
	}

	method card (Num $week) {
		my $card = $self->data->{$week};
		croak "Week $week card probably has undefined or non-numeric Merit, Absence, Tardy scores, or possibly illegal beancan."
		    unless is_Card( $card );
		return $card;
	}

=head1 DESCRIPTION

MooseX::Types extension of Moose::Util::TypeConstraint checking of user input.

=cut

=head1 TYPES

=cut

=head2 PlayerName

A string, where the first letter is upper case, there are some letters or spaces or hyphens, and there is an optional digit at the end to disambiguate same-named players.

=cut

subtype PlayerName, as Str;

=head2 PlayerNames

An array ref of PlayerName.

=cut

subtype PlayerNames, as ArrayRef[ PlayerName ], message
{ 'PlayerNames are letters, and apostrophes and dashes, and an optional digit to disambiguate students with same name,' };

=head2 AbsenteeNames

A possibly undefined PlayerNames list type.

=cut

subtype AbsenteeNames, as Maybe[ PlayerNames ], message
	{ 'AbsenteeNames is a possibly empty list of PlayerNames' };

=head2 PlayerId

A string of digits or underscore, with possibly a letter in front.

=cut

subtype PlayerId, as Str, where { $_ =~ m/^[a-zA-Z]?[0-9_]+$/ };

=head2 Member

A hashref with name and id keys.

=cut

subtype Member, as HashRef, where {
	PlayerName->check( $_->{name} )
	and PlayerId->check( $_->{id} )
};

=head2 Members

A possibly undefined list of Member.

=cut

subtype Members,
	as ArrayRef [Member],
	message { 'Probably undefined or illegal PlayerNames or PlayerIds,' };

=head2 Results

A number or the string 'transfer' for each playerId.

=cut

subtype Results,
	as HashRef,
	where {
	    my $results = $_;
	    all {
		my $player = $_;
		PlayerId->check( $player ) and (
		Num->check( $results->{$player} ) or
		$results->{$player} =~ m/transfer/i )
	    }
	    keys %$results;
	},
	message {
"Missing or non-numerical score or bad player id," };

=head2 HomeworkResult

A number or the string 'transfer'.

=cut

subtype HomeworkResult,
	as Value,
	where { Num->check( $_ ) or m/transfer/i },
	message {
"Missing or non-numerical score or value not 'transfer'," };

=head2 Cutpoints

'one', 'two' cutpoints with the numerical value

=cut

subtype Cutpoints,
	as HashRef,
	where {
	    my $cutpoint = $_;
	    all {
		( m/one/i or m/two/i ) and
		Num->check( $cutpoint->{$_} )
		} keys %$_
	      },
	message {
"Missing 'one', 'two' cutpoints with numerical value," };

=head2 HomeworkPoints

A number or undef.

=cut

subtype HomeworkPoints, as Maybe[Num];

=head2 HomeworkWork

'letters' and 'questions' and the number of each. But letters might be undef.

=cut

subtype HomeworkWork,
	as HashRef,
	where {
	    my $work = $_;
	    all {
		( m/letters/i or m/questions/i ) and
		HomeworkPoints->check( $work->{$_} )
		} keys %$work
	      },
	message {
"Missing 'letters', 'questions' and HomeworkPoints," };

=head2 HomeworkWorks

HomeworkWork of all players.

=cut

subtype HomeworkWorks,
	as HashRef,
	where {
	    my $points = $_;
	    all { 
		PlayerId->check( $_ ) and HomeworkWork->check( $points->{$_} )
		} keys %$points
	      },
	message {
"Missing players and their points," };

=head2 HomeworkRound

A hashref of PlayerId keys and HomeworkResult values.

=cut

subtype HomeworkRound,
	as HashRef,
	where { 
	    my $play = $_;
	    all {
		    my $value = $play->{$_};
		    m/exercise/i and Str->check( $value ) or
		    m/cutpoints/i and Cutpoints->check( $value ) or
		    m/grade/ and Results->check( $value ) or
		    m/points/ and HomeworkWorks->check( $value )
		}
	    keys %$play;
	},
	message {
"Problematic homework round file," };

=head2 RoundsResults

A hashref of the homework grades keyed on the round (an Int.) For each round, the keys are PlayerId, and the values are scores, or Num.

=cut

subtype RoundsResults,
	as HashRef,
	where { 
		my $results = $_;
		my $test = all {
			my $round = $_;
			Int->check( $round ) and
			    Results->check( $results->{$round} )
		    } keys %$results;
		return 1 if $test or not defined $test;
	},
	message {
"Impossible round number or PlayerId, or missing or non-numerical score," };

=head2 Beancans

A hashref of teams and their constituents, where the keys are the sessions (Str) and the keys for each session are teams, or beancans (ie Str) and the corresponding value is PlayerNames.

=cut

subtype Beancans,
	as HashRef,
	where {
		my $lineup = $_;
		all {
			my $session = $_;
			Str->check( $session ) and
			all {
				my $can = $_;
				Str->check( $can ) and
				PlayerNames->check($lineup->{$session}->{$can});
			}
			keys %{ $lineup->{$session} };
		}
		keys %$lineup;
	},
	message { 'Probably undefined or illegal PlayerName, or possibly illegal session or beancan name,' };

=head2 Card

A hashref of classwork results for the lesson, where the keys are beancan names (Str) and for each beancan there are 'merits', 'absences', and 'tardies' keys, with Int values for each key.

=cut

subtype Card,
	as HashRef,
	where {
		my %card = %$_;
		delete $card{Absent};
		all {
			my $can = $_;
			Str->check( $can ) and 
			Num->check( $card{$can}->{merits} ) and
			Int->check( $card{$can}->{absences} ) and
			Int->check( $card{$can}->{tardies} );
		}
		keys %card;
	},
	message { 'Probably undefined or non-numeric Merit, Absence, Tardy scores, or possibly illegal beancan on Card,' };

=head2 TortCard

A hashref of classwork results for the lesson, where the keys are beancan names (Str) and for each beancan there are 'merits', and 'absent' keys, with an Int value for the first and AbsenteeNames for the second key.

=cut

subtype TortCard,
	as HashRef,
	where {
		my %card = %$_;
		delete $card{Absent};
		for my $key ( keys %card ) {
		    delete $card{$key} unless $key =~ m/^[[:upper:]]/;
		}
		all {
			my $can = $_;
			Str->check( $can ) and 
			Num->check( $card{$can}->{merits} ) and
			AbsenteeNames->check( $card{$can}->{absent} )
		}
		keys %card;
	},
	message { 'Probably an undefined or non-numeric Merit, or invalid AbsenteeNames, or possibly illegal beancan on TortCard,' };

=head2 Exam

A hashref of the results for one exam, with PlayerId keys and Num values.

=cut

subtype Exam,
	as HashRef,
	where {
		my $exam = $_;
		all {
			my $id = $_;
			PlayerId->check( $id ) and
			Num->check( $exam->{$id} );
		}
		keys %$exam;
	},
	message { 'Probably undefined or non-numeric Exam score, or possibly illegal PlayerId,' };

=head2 Weights

A hashref of weights for the components making up the grade, where the keys are 'classwork', 'homework', and 'exams', and the corresponding Num value is the weight accorded the component in the grade.

=cut

subtype Weights, 
	as HashRef[Int],
	where {
		Num->check( $_->{classwork} ) and
			Num->check( $_->{homework} ) and
			Num->check( $_->{exams} ) and 
			$_->{classwork} + $_->{homework} + $_->{exams} == 100;
		},
	message{ "Classwork, homework, exam weights not defined, or don't sum to 100 percent," };

no MooseX::Types::Moose;
no MooseX::Types;

1;

=head1 AUTHOR

Dr Bean, C<< <drbean, followed by the at mark (@), cpan, then a dot, and finally, org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-grades at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Grades>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Grades::Types

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Grades>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Grades>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Grades>

=item * Search CPAN

L<http://search.cpan.org/dist/Grades>

=back

=head1 COPYRIGHT & LICENSE

Copyright 2006 Dr Bean, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

# vim: set ts=8 sts=4 sw=4 noet:
