Peler

: / usr / share / perl5 / Types / Common /
Filename : Numeric.pm
back
package Types::Common::Numeric;

use 5.006001;
use strict;
use warnings;

BEGIN {
	if ($] < 5.008) { require Devel::TypeTiny::Perl56Compat };
}

BEGIN {
	$Types::Common::Numeric::AUTHORITY = 'cpan:TOBYINK';
	$Types::Common::Numeric::VERSION   = '1.008001';
}

$Types::Common::Numeric::VERSION =~ tr/_//d;

use Type::Library -base, -declare => qw(
	PositiveNum PositiveOrZeroNum
	PositiveInt PositiveOrZeroInt
	NegativeNum NegativeOrZeroNum
	NegativeInt NegativeOrZeroInt
	SingleDigit
	NumRange IntRange
);

use Type::Tiny ();
use Types::Standard qw( Num Int Bool );

sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }

my $meta = __PACKAGE__->meta;

$meta->add_type(
	name       => 'PositiveNum',
	parent     => Num,
	constraint => sub { $_ > 0 },
	inlined    => sub { undef, qq($_ > 0) },
	message    => sub { "Must be a positive number" },
);

$meta->add_type(
	name       => 'PositiveOrZeroNum',
	parent     => Num,
	constraint => sub { $_ >= 0 },
	inlined    => sub { undef, qq($_ >= 0) },
	message    => sub { "Must be a number greater than or equal to zero" },
);

my ($pos_int, $posz_int);
if (Type::Tiny::_USE_XS) {
	$pos_int  = Type::Tiny::XS::get_coderef_for('PositiveInt')
		if Type::Tiny::XS->VERSION >= 0.013; # fixed bug with "00"
	$posz_int = Type::Tiny::XS::get_coderef_for('PositiveOrZeroInt');
}

$meta->add_type(
	name       => 'PositiveInt',
	parent     => Int,
	constraint => sub { $_ > 0 },
	inlined    => sub {
		if ($pos_int) {
			my $xsub = Type::Tiny::XS::get_subname_for($_[0]->name);
			return "$xsub($_[1])" if $xsub && !$Type::Tiny::AvoidCallbacks;
		}
		undef, qq($_ > 0);
	},
	message    => sub { "Must be a positive integer" },
	$pos_int ? ( compiled_type_constraint => $pos_int ) : (),
);

$meta->add_type(
	name       => 'PositiveOrZeroInt',
	parent     => Int,
	constraint => sub { $_ >= 0 },
	inlined    => sub {
		if ($posz_int) {
			my $xsub = Type::Tiny::XS::get_subname_for($_[0]->name);
			return "$xsub($_[1])" if $xsub && !$Type::Tiny::AvoidCallbacks;
		}
		undef, qq($_ >= 0);
	},
	message    => sub { "Must be an integer greater than or equal to zero" },
	$posz_int ? ( compiled_type_constraint => $posz_int ) : (),
);

$meta->add_type(
	name       => 'NegativeNum',
	parent     => Num,
	constraint => sub { $_ < 0 },
	inlined    => sub { undef, qq($_ < 0) },
	message    => sub { "Must be a negative number" },
);

$meta->add_type(
	name       => 'NegativeOrZeroNum',
	parent     => Num,
	constraint => sub { $_ <= 0 },
	inlined    => sub { undef, qq($_ <= 0) },
	message    => sub { "Must be a number less than or equal to zero" },
);

$meta->add_type(
	name       => 'NegativeInt',
	parent     => Int,
	constraint => sub { $_ < 0 },
	inlined    => sub { undef, qq($_ < 0) },
	message    => sub { "Must be a negative integer" },
);

$meta->add_type(
	name       => 'NegativeOrZeroInt',
	parent     => Int,
	constraint => sub { $_ <= 0 },
	inlined    => sub { undef, qq($_ <= 0) },
	message    => sub { "Must be an integer less than or equal to zero" },
);

$meta->add_type(
	name       => 'SingleDigit',
	parent     => Int,
	constraint => sub { $_ >= -9 and $_ <= 9 },
	inlined    => sub { undef, qq($_ >= -9), qq($_ <= 9) },
	message    => sub { "Must be a single digit" },
);

for my $base (qw/Num Int/) {
	$meta->add_type(
		name       => "${base}Range",
		parent     => Types::Standard->get_type($base),
		constraint_generator => sub {
			return $meta->get_type("${base}Range") unless @_;
			
			my $base_obj = Types::Standard->get_type($base);
			
			my ($min, $max, $min_excl, $max_excl) = @_;
			!defined($min) or $base_obj->check($min) or _croak("${base}Range min must be a %s; got %s", lc($base), $min);
			!defined($max) or $base_obj->check($max) or _croak("${base}Range max must be a %s; got %s", lc($base), $max);
			!defined($min_excl) or Bool->check($min_excl) or _croak("${base}Range minexcl must be a boolean; got $min_excl");
			!defined($max_excl) or Bool->check($max_excl) or _croak("${base}Range maxexcl must be a boolean; got $max_excl");
			
			# this is complicated so defer to the inline generator
			eval sprintf(
				'sub { %s }',
				join ' and ',
					grep defined,
					$meta->get_type("${base}Range")->inline_generator->(@_)->(undef, '$_[0]'),
			);
		},
		inline_generator => sub {
			my ($min, $max, $min_excl, $max_excl) = @_;
			
			my $gt = $min_excl ? '>' : '>=';
			my $lt = $max_excl ? '<' : '<=';
			
			return sub {
				my $v = $_[1];
				my @code = (undef); # parent constraint
				push @code, "$v $gt $min";
				push @code, "$v $lt $max" if defined $max;
				return @code;
			};
		},
		deep_explanation => sub {
			my ($type, $value, $varname) = @_;
			my ($min, $max, $min_excl, $max_excl) = @{ $type->parameters || [] };
			my @whines;
			if (defined $max) {
				push @whines, sprintf(
					'"%s" expects %s to be %s %d and %s %d',
					$type,
					$varname,
					$min_excl ? 'greater than' : 'at least',
					$min,
					$max_excl ? 'less than' : 'at most',
					$max,
				);
			}
			else {
				push @whines, sprintf(
					'"%s" expects %s to be %s %d',
					$type,
					$varname,
					$min_excl ? 'greater than' : 'at least',
					$min,
				);
			}
			push @whines, sprintf(
				"length(%s) is %d",
				$varname,
				length($value),
			);
			return \@whines;
		},
	);
}

__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Types::Common::Numeric - drop-in replacement for MooseX::Types::Common::Numeric

=head1 STATUS

This module is covered by the
L<Type-Tiny stability policy|Type::Tiny::Manual::Policies/"STABILITY">.

=head1 DESCRIPTION

A drop-in replacement for L<MooseX::Types::Common::Numeric>.

=head2 Types

The following types are similar to those described in
L<MooseX::Types::Common::Numeric>.

=over

=item *

B<PositiveNum>

=item *

B<PositiveOrZeroNum>

=item *

B<PositiveInt>

=item *

B<PositiveOrZeroInt>

=item *

B<NegativeNum>

=item *

B<NegativeOrZeroNum>

=item *

B<NegativeInt>

=item *

B<NegativeOrZeroInt>

=item *

B<SingleDigit>

C<SingleDigit> interestingly accepts the numbers -9 to -1; not
just 0 to 9. 

=back

This module also defines an extra pair of type constraints not found in
L<MooseX::Types::Common::Numeric>.

=over

=item *

B<< IntRange[`min, `max] >>

Type constraint for an integer between min and max. For example:

  IntRange[1, 10]

The maximum can be omitted.

  IntRange[10]   # at least 10

The minimum and maximum are inclusive.

=item *

B<< NumRange[`min, `max] >>

Type constraint for a number between min and max. For example:

  NumRange[0.1, 10.0]

As with IntRange, the maximum can be omitted, and the minimum and maximum
are inclusive.

Exclusive ranges can be useful for non-integer values, so additional parameters
can be given to make the minimum and maximum exclusive.

  NumRange[0.1, 10.0, 0, 0]  # both inclusive
  NumRange[0.1, 10.0, 0, 1]  # exclusive maximum, so 10.0 is invalid
  NumRange[0.1, 10.0, 1, 0]  # exclusive minimum, so 0.1 is invalid
  NumRange[0.1, 10.0, 1, 1]  # both exclusive

Making one of the limits exclusive means that a C<< < >> or C<< > >> operator
will be used instead of the usual C<< <= >> or C<< >= >> operators.

=back

=head1 BUGS

Please report any bugs to
L<http://rt.cpan.org/Dist/Display.html?Queue=Type-Tiny>.

=head1 SEE ALSO

L<Types::Standard>, L<Types::Common::String>.

L<MooseX::Types::Common>,
L<MooseX::Types::Common::Numeric>,
L<MooseX::Types::Common::String>.

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2013-2014, 2017-2019 by Toby Inkster.

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

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.