view release on metacpan or  search on metacpan

lib/Aion/Types.pm  view on Meta::CPAN

package Aion::Types;
# Типы-валидаторы для Aion

use common::sense;
use warnings FATAL => 'recursion';

use Aion::Meta::Util qw/subref_is_reachable val_to_str/;
use Aion::Type;
use Aion::Type::Lim;
use List::Util qw/all any first/;
use Exporter qw/import/;
require overload;
use POSIX qw//;
use Scalar::Util qw/looks_like_number reftype refaddr blessed/;
use Sub::Util qw//;

our @EXPORT = our @EXPORT_OK = grep {
	eval {*{$Aion::Types::{$_}}{CODE}}	&& !/^(_|(NaN|import|all|any|first|looks_like_number|reftype|refaddr|blessed|subref_is_reachable|val_to_str|DBL_MAX)\z)/n
} keys %Aion::Types::;

# Обрабатываем атрибут :Isa
sub MODIFY_CODE_ATTRIBUTES {
    my ($pkg, $referent, @attributes) = @_;

    grep { /^Isa\((.*)\)\z/s? do { _Isa($pkg, $referent, $1); 0 }: 1 } @attributes
}

sub _Isa {
	my ($pkg, $referent, $data) = @_;
	my $subname = Sub::Util::subname $referent;
	$subname =~ s/^.*:://;

	die "Anonymous subroutine cannot use :Isa!" if $subname eq '__ANON__';
	
	my @signature = eval "package $pkg; map { UNIVERSAL::isa(\$_, 'Aion::Type')? \$_: __PACKAGE__->can(\$_)? __PACKAGE__->can(\$_)->(): Aion::Types::External([\$_]) } ($data)";
	die if $@;

	die "$pkg\::$subname has no return type!" if @signature == 0;

	require Aion::Meta::Subroutine;
	my $subroutine = Aion::Meta::Subroutine->new(
		pkg => $pkg,
		subname => $subname,
		signature => \@signature,
		referent => $referent,
	);
	
	if(!subref_is_reachable($referent)) {
		$Aion::META{$pkg}{require}{$subname} = $subroutine;
	} else {
		my $require = delete $Aion::META{$pkg}{require}{$subname};
		$require->compare($subroutine) if $require;

		my $overload = $Aion::META{$pkg}{subroutine}{$subname};
		$overload->compare($subroutine) if $overload;
		
		$subroutine->wrap_sub;
	}	
}

BEGIN {
my $INIT_ARGS = sub { @{&ARGS} = map External([$_]), &ARGS };
my $INIT_KW_ARGS = sub { @{&ARGS} = List::Util::pairmap { $a => External([$b]) } &ARGS };

my $COMBINE_SUBS = sub {
    my ($f1, $f2) = @_;
    sub { $f1->(); $f2->() }
};

my $COMBINE_WHERE = sub {
    my ($f1, $f2) = @_;
    sub { $f1->() && $f2->() }
};

my $IS_PARAM = sub {
	my @S = @_;
	while(@S) {
		my $arg = pop @S;

lib/Aion/Types.pm  view on Meta::CPAN

	" <html1>" ~~ Html         # -> ""

=head2 StrDate

Date in C<yyyy-mm-dd> format.

	"2001-01-12" ~~ StrDate # -> 1
	"01-01-01" ~~ StrDate   # -> ""

=head2 StrDateTime

Date and time in the format C<yyyy-mm-dd HH:MM:SS>.

	"2012-12-01 00:00:00" ~~ StrDateTime  # -> 1
	"2012-12-01 00:00:00 " ~~ StrDateTime # -> ""

=head2 StrMatch[regexp]

Matches a string against a regular expression.

	' abc ' ~~ StrMatch[qr/abc/]  # -> 1
	' abbc ' ~~ StrMatch[qr/abc/] # -> ""

=head2 ClassName

The class name is a package with a C<new> method.

	'Aion::Type' ~~ ClassName  # -> 1
	'Aion::Types' ~~ ClassName # -> ""

=head2 RoleName

The role name is a package without the C<new> method, with C<@ISA>, or with any one method.

	package ExRole1 {
		sub any_method {}
	}
	
	package ExRole2 {
		our @ISA = qw/ExRole1/;
	}
	
	
	'ExRole1' ~~ RoleName    # -> 1
	'ExRole2' ~~ RoleName    # -> 1
	'Aion::Type' ~~ RoleName # -> ""
	'Nouname::Empty::Package' ~~ RoleName # -> ""

=head2 StrRat

String representation of rational numbers.

Since in perl rational numbers are supported using the C<bigrat> pragma, which turns all rational numbers into C<Math::BigRat>, it is used in a ghost to C<Rat>.

	"6/7" ~~ StrRat  # -> 1
	"-6/7" ~~ StrRat # -> 1
	"+6/7" ~~ StrRat # -> 1
	6 ~~ StrRat      # -> 1
	"inf" ~~ StrRat  # -> 1
	"+Inf" ~~ StrRat # -> 1
	"NaN" ~~ StrRat  # -> 1
	"-nan" ~~ StrRat # -> 1
	6.5 ~~ StrRat    # -> 1
	"6.5 " ~~ StrRat # -> ''

=head2 Rat

Rational numbers. Short for C<Object['Math::BigRat']>. Has a ghost.

	use Math::BigRat;
	use Math::BigFloat;
	use Math::BigInt;
	
	"6/7" ~~ Rat # -> ""
	Math::BigRat->new("6/7") ~~ Rat # -> 1

=head2 Num

Numbers.

	-6.5 ~~ Num   # -> 1
	6.5e-7 ~~ Num # -> 1
	"6.5 " ~~ Num # -> ""

=head2 PositiveNum

Positive numbers.

	0 ~~ PositiveNum    # -> 1
	0.1 ~~ PositiveNum  # -> 1
	-0.1 ~~ PositiveNum # -> ""
	-0 ~~ PositiveNum   # -> 1

=head2 Int

Whole numbers.

	123 ~~ Int	# -> 1
	-12 ~~ Int	# -> 1
	5.5 ~~ Int	# -> ""

=head2 Nat

Integers 1+.

	0 ~~ Nat # -> ""
	1 ~~ Nat # -> 1
	
	Nat->instanceof('Range')  # -> 1
	Nat->instanceof('Int')    # -> 1
	
	Nat <= Range[1, 'Inf']    # -> 1
	Nat <= Range[2, 'Inf']    # -> ""
	Nat <= Range[-100, 'Inf'] # -> 1

=head2 PositiveInt

Positive integers.

	+0 ~~ PositiveInt # -> 1
	-0 ~~ PositiveInt # -> 1