Aion

 view release on metacpan or  search on metacpan

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

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

use 5.22.0;
no strict; no warnings; no diagnostics;
use common::sense;

use Aion::Type;
use Attribute::Handlers;
use List::Util qw/all any/;
use Exporter qw/import/;
use Scalar::Util qw/looks_like_number reftype blessed/;
use Sub::Util qw/prototype set_prototype subname set_subname/;

our @EXPORT = our @EXPORT_OK = grep {
	*{$Aion::Types::{$_}}{CODE}	&& !/^(_|(NaN|import|all|any|looks_like_number|reftype|blessed|prototype|set_prototype|subname|set_subname)\z)/n
} keys %Aion::Types::;

sub UNIVERSAL::Isa : ATTR(CODE) {
    my ($pkg, $symbol, $referent, $attr, $data, $phase, $file, $line) = @_;
    my $args_of_meth = "Arguments of method `" . *{$symbol}{NAME} . "`";
    my $returns_of_meth = "Returns of method `" . *{$symbol}{NAME} . "`";
    my $return_of_meth = "Return of method `" . *{$symbol}{NAME} . "`";

	my @signature = map { ref($_)? $_: $pkg->can($_)->() } @$data;

	my $ret = pop @signature;

    my ($ret_array, $ret_scalar) = exists $ret->{is_wantarray}? @{$ret->{args}}: (Tuple([$ret]), $ret);

    my $args = Tuple(\@signature);

    my $sub = sub {
        $args->validate(\@_, $args_of_meth);
        wantarray? do {
            my @returns = $referent->(@_);
            $ret_array->validate(\@returns, $returns_of_meth);
            @returns
        }: do {
            my $return = $referent->(@_);
            $ret_scalar->validate($return, $return_of_meth);
            $return
        }
    };

	set_prototype prototype($referent), $sub;
	set_subname subname($referent) . "__Isa", $sub;

	*$symbol = $sub
}

BEGIN {
my $TRUE = sub {1};

# Создание типа
sub subtype(@) {
	my $save = my $name = shift;
	my %o = @_;
	
	my ($as, $init_where, $where, $awhere, $message) = delete @o{qw/as init_where where awhere message/};

	die "subtype $save unused keys left: " . join ", ", keys %o if keys %o;

	my $is_maybe_arg; my $is_arg;
	$name =~ s/(`?)(\[.*)/ $is_maybe_arg = $1; $is_arg = $2; ''/e;

	my $pkg = scalar caller;
	die "subtype $save: ${pkg}::$name exists!" if *{"${pkg}::$name"}{CODE};

	if($is_maybe_arg) {
		die "subtype $save: needs a awhere" if !$awhere;
	} else {
		die "subtype $save: awhere is excess" if $awhere;
	}
	
	die "subtype $save: needs a where" if $is_arg && !($where || $awhere);

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

	"/a/b" ~~ Path  # -> 1
	"a/b" ~~ Path   # -> ""

=head2 Html

The html starts with a C<< E<lt>!doctype >> or C<< E<lt>html >>.

	"<HTML" ~~ Html            # -> 1
	" <html" ~~ Html           # -> 1
	" <!doctype html>" ~~ Html # -> 1
	" <html1>" ~~ Html         # -> ""

=head2 StrDate

The date is format C<yyyy-mm-dd>.

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

=head2 StrDateTime

The dateTime is 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[qr/.../]

Match value with regular expression.

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

=head2 ClassName

Classname is the package with method C<new>.

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

=head2 RoleName

Rolename is the package with subroutine C<requires>.

	package ExRole {
		sub requires {}
	}
	
	'ExRole' ~~ RoleName    	# -> 1
	'Aion::Type' ~~ RoleName    # -> ""

=head2 Rat

Rational numbers.

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

=head2 Num

The numbers.

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

=head2 PositiveNum

The positive numbers.

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

=head2 Float

The machine float number is 4 bytes.

	-4.8 ~~ Float    				# -> 1
	-3.402823466E+38 ~~ Float    	# -> 1
	+3.402823466E+38 ~~ Float    	# -> 1
	-3.402823467E+38 ~~ Float       # -> ""

=head2 Double

The machine float number is 8 bytes.

	use Scalar::Util qw//;
	
	-4.8 ~~ Double                     # -> 1
	'-1.7976931348623157e+308' ~~ Double # -> 1
	'+1.7976931348623157e+308' ~~ Double # -> 1
	'-1.7976931348623159e+308' ~~ Double # -> ""

=head2 Range[from, to]

Numbers between C<from> and C<to>.

	1 ~~ Range[1, 3]    # -> 1
	2.5 ~~ Range[1, 3]  # -> 1
	3 ~~ Range[1, 3]    # -> 1
	3.1 ~~ Range[1, 3]  # -> ""
	0.9 ~~ Range[1, 3]  # -> ""

=head2 Int

Integers.

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

=head2 Bytes[N]



( run in 0.367 second using v1.01-cache-2.11-cpan-00829025b61 )