Aion

 view release on metacpan or  search on metacpan

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

package Aion::Type;
# Базовый класс для типов и преобразователей
use common::sense;

use Scalar::Util qw/looks_like_number/;
require DDP;

use overload
	"fallback" => 1,
	"&{}" => sub {
		my ($self) = @_;
		sub { $self->test }
	},	# Чтобы тип мог быть выполнен, как функция
	'""' => "stringify",									# Отображать тип в трейсбеке в строковом представлении
	"|" => sub {

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

# * coerce (HashRef) — Массив преобразователей в этот тип: TypeName => sub {}.
sub new {
	my $cls = shift;
	bless {@_}, $cls;
}

# Символьное представление значения
sub val_to_str {
	my ($self, $v) = @_;
	!defined($v)			? "undef":
	looks_like_number($v)	? $v:
	ref($v)					? DDP::np($v, max_depth => 2, array_max => 13, hash_max => 13, string_max => 255):
	do {
		$v =~ s/[\\']/\\$&/g;
		$v =~ s/^/'/;
		$v =~ s/\z/'/;
		$v
	}
}

# Строковое представление

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

# Типы-валидаторы для 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;

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

					subtype "Tel", as &Str, where { /^\+\d{7,}\z/ };
					subtype "Url", as &Str, where { /^https?:\/\// };
					subtype "Path", as &Str, where { /^\// };
					subtype "Html", as &Str, where { /^\s*<(!doctype|html)\b/i };
					subtype "StrDate", as &Str, where { /^\d{4}-\d{2}-\d{2}\z/ };
					subtype "StrDateTime", as &Str, where { /^\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}\z/ };
					subtype "StrMatch[qr/.../]", as &Str, where { $_ =~ A };
					subtype "ClassName", as &Str, where { !!$_->can('new') };
					subtype "RoleName", as &Str, where { !!$_->can('requires') };

					subtype "Num", as &Str, where { looks_like_number($_) && /[\dfn]\z/i };
						subtype "PositiveNum", as &Num, where { $_ >= 0 };
						subtype "Int", as &Num,	where { /^-?\d+\z/ };
							subtype "PositiveInt", as &Int, where { $_ >= 0 };
							subtype "Nat", as &Int, where { $_ > 0 };
					subtype "Rat", as &Str, where { &Num->test || /^(-?\d+(\/\d+)?)\z/in };


			subtype "Ref", as &Defined, where { "" ne ref $_ };
				subtype "Tied`[A]", as &Ref,
					where { my $ref = reftype($_); !!(

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

				subtype "Overload`[m...]", as &Like,
					where { !!overload::Overloaded($_) }
					awhere { my $x = $_; all { overload::Method($x, $_) } ARGS };
				subtype "InstanceOf[A...]", as &Like, where { my $x = $_; all { $x->isa($_) } ARGS };
				subtype "ConsumerOf[A...]", as &Like, where { my $x = $_; all { $x->can("does") && $x->does($_) } ARGS };
				subtype "StrLike", as (&Str | Overload(['""']));
					subtype "Len[A, B?]", as &StrLike,
						init_where => $init_limit,
						where { SELF->{min} <= length($_) && length($_) <= SELF->{max} };

				subtype "NumLike", where { looks_like_number($_) };
					subtype "Float", as &NumLike, where { -3.402823466E+38 <= $_ && $_ <= 3.402823466E+38 };
					
					my $_from; my $_to;
					subtype "Double", as &NumLike, where {
                        $_from //= do { require Math::BigFloat; Math::BigFloat->new('-1.7976931348623157e+308') };
                        $_to   //= do { require Math::BigFloat; Math::BigFloat->new( '1.7976931348623157e+308') };
                        $_from <= $_ && $_ <= $_to;
                    };
					subtype "Range[from, to]", as &NumLike, where { A <= $_ && $_ <= B };