Aion
view release on metacpan or search on metacpan
lib/Aion/Type.pm view on Meta::CPAN
# Ðе ÑвлÑеÑÑÑ ÑлеменÑом множеÑÑва опиÑÑваемого Ñипом
sub exclude {
(my $self, local $_) = @_;
!$self->test
}
# ÐалидиÑоваÑÑ Ð·Ð½Ð°Ñение в паÑамеÑÑе
sub validate {
(my $self, local $_, my $name) = @_;
die $self->detail($_, $name) unless $self->test;
$_
}
# ÐÑеобÑазоваÑÑ Ð·Ð½Ð°Ñение в паÑамеÑÑе и веÑнÑÑÑ Ð¿ÑеобÑазованное
sub coerce {
local ($Aion::Type::SELF, $_) = @_;
for my $coerce (@{$Aion::Type::SELF->{coerce}}) {
return $coerce->[1]() if $coerce->[0]->test;
}
$_
}
#@category compare
#my $_any; my $_none;
sub Any() { *Any = \&Aion::Types::Any; &Any }
sub None() { *None = \&Aion::Types::None; &None }
# refaddr coerce => минималÑÐ½Ð°Ñ Ð½Ð¸Ð¶Ð½ÑÑ Ð³ÑаниÑа. У Range она -Inf, а Ñ Ð¾ÑÑалÑнÑÑ
â 0
our %range_lbound;
# ÐпÑеделÑеÑ, ÑÑо Ñип â множеÑÑвенно-ÑеоÑеÑиÑеÑкий опеÑаÑоÑ
my $set_theoretic = [qw/Union Intersection Exclude/];
sub is_set_theoretic { shift->{name} ~~ $set_theoretic }
sub is_union { shift->{name} eq 'Union' }
sub is_intersection { shift->{name} eq 'Intersection' }
sub is_exclude { shift->{name} eq 'Exclude' }
sub is_enum { shift->{name} eq 'Enum' }
sub is_range_type { exists $range_lbound{Scalar::Util::refaddr shift->{coerce}} }
sub range_lbound { $range_lbound{Scalar::Util::refaddr shift->{coerce}} }
sub is_range { shift->range_lbound == '-Inf' }
# ФоÑмиÑÑÐµÑ ÐºÐ»ÑÑ Ñ Ð¾ÑÑоÑÑиÑованнÑми ÑипизиÑованнÑми паÑамеÑÑами
sub typed_sorted_args_key {
my ($self) = @_;
my $coerceaddr = Scalar::Util::refaddr $self->{coerce};
join "-", $coerceaddr, join(",", map { join ":", length($_), $_ } sort map $_->key, @{$self->{args}});
}
# ФоÑмиÑÑÐµÑ ÐºÐ»ÑÑ Ñ Ð¾ÑÑоÑÑиÑованнÑми неÑипизиÑованнÑми паÑамеÑÑами
sub sorted_args_key {
my ($self) = @_;
my $coerceaddr = Scalar::Util::refaddr $self->{coerce};
join "-", $coerceaddr, join(",", map { join ":", length($_), $_ } sort @{$self->{args}});
}
# ÐозвÑаÑÐ°ÐµÑ ÑникалÑнÑй клÑÑ Ð´Ð»Ñ Ñипа, иÑполÑзÑÑÑийÑÑ Ð² Ñ
еÑаÑ
и ÑÑавнениÑ
# Ðолжен бÑÑÑ Ð·Ð°Ð¼ÐµÐ½Ñн на ÑозданнÑе ÑипÑ
my %keyfn;
my $undefined = [];
sub key {
my ($self) = @_;
$self->{key} //= do {
my $coerceaddr = Scalar::Util::refaddr $self->{coerce};
my $keyfn = $keyfn{$coerceaddr};
$keyfn
? $keyfn->($self)
: join "-", $coerceaddr, exists $self->{args} && @{$self->{args}} || exists $self->{N} || exists $self->{M}
? join(",", map {
my $key = UNIVERSAL::isa($_, __PACKAGE__)? $_->key: "" . ($_ // $undefined);
join ":", length($key), $key
} @{$self->{args}})
: ();
};
}
# УÑÑанавливаеÑ/возвÑаÑÐ°ÐµÑ ÑÑнкÑÐ¸Ñ Ð¿Ð¾ÑÑÑÐ¾ÐµÐ½Ð¸Ñ ÐºÐ»ÑÑа Ð´Ð»Ñ Ñипа как клаÑÑа
sub keyfn {
my ($self, $fn) = @_;
if(@_>1) {
$keyfn{Scalar::Util::refaddr $self->{coerce}} = $fn;
$self
} else {
$keyfn{Scalar::Util::refaddr $self->{coerce}};
}
}
# ÐозвÑаÑÐ°ÐµÑ ÑепоÑÐºÑ Ð¿Ñедков
sub asen {
my ($self) = @_;
my @as;
for(my $i=$self->{as}; $i; $i = $i->{as}) { unshift @as, $i }
unshift @as, Any unless @as && $as[0] eq Any;
@as
}
# ÐлÑÑ Ð´Ð»Ñ ÑÑÐ°Ð²Ð½ÐµÐ½Ð¸Ñ Ñипов в <=> и cmp
sub ckey {
my ($self) = @_;
$self->{ckey} //= join " <- ", map $_->stringify, $self->asen, $self;
}
# СÑавнение Ð´Ð»Ñ ÑоÑÑиÑовки
sub compare {
my ($self, $other) = @_;
$self->ckey cmp $other->ckey;
}
# A поÑомок B
sub instanceof {
my ($self, $name) = @_;
my @S = $self;
while(@S) {
my $x = pop @S;
return 1 if $x->{name} eq $name;
if($x->is_intersection) { push @S, @{$x->{args}} }
elsif($x->is_set_theoretic) {}
else { push @S, $x->{as} if $x->{as} }
}
""
}
# A поÑомок B
sub is_descendant {
my ($self, $other, $is_strict) = @_;
return 1 if $is_strict && $self eq $other
|| !$is_strict && $self->like($other);
lib/Aion/Type.pm view on Meta::CPAN
=head2 init
Validator initializer.
my $Range = Aion::Type->new(
name => "Range",
args => [3, 5],
init => [sub {
@{$Aion::Type::SELF}{qw/min max/} = @{$Aion::Type::SELF->{args}};
}],
test => sub { $Aion::Type::SELF->{min} <= $_ && $_ <= $Aion::Type::SELF->{max} },
);
$Range->init;
3 ~~ $Range # -> 1
4 ~~ $Range # -> 1
5 ~~ $Range # -> 1
2 ~~ $Range # -> ""
6 ~~ $Range # -> ""
=head2 include ($element)
Checks whether the argument belongs to the class.
my $PositiveInt = Aion::Type->new(
name => "PositiveInt",
test => sub { /^\d+$/ },
);
$PositiveInt->include(5) # -> 1
$PositiveInt->include(-6) # -> ""
=head2 exclude ($element)
Checks that the argument does not belong to the class.
my $PositiveInt = Aion::Type->new(
name => "PositiveInt",
test => sub { /^\d+$/ },
);
$PositiveInt->exclude(5) # -> ""
$PositiveInt->exclude(-6) # -> 1
=head2 coerce ($value)
Cast C<$value> to type if the cast from type and function is in C<< $self-E<gt>{coerce} >>.
Corresponds to the C<< E<gt>E<gt> >> operator.
my $Int = Aion::Type->new(name => "Int", test => sub { /^-?\d+\z/ });
my $Num = Aion::Type->new(name => "Num", test => sub { /^-?\d+(\.\d+)?\z/ });
my $Bool = Aion::Type->new(name => "Bool", test => sub { /^(1|0|)\z/ });
push @{$Int->{coerce}}, [$Bool, sub { 0+$_ }];
push @{$Int->{coerce}}, [$Num, sub { int($_+.5) }];
$Int->coerce(5.5) # => 6
$Int->coerce(undef) # => 0
$Int->coerce("abc") # => abc
=head2 detail ($element, $feature)
Generates an error message.
my $Int = Aion::Type->new(name => "Int");
$Int->detail(-5, "Feature car") # => Feature car must have the type Int. The it is -5!
my $Num = Aion::Type->new(name => "Num", message => sub {
"Error: $_ is'nt $Aion::Type::SELF->{property}!"
});
$Num->detail("x", "car") # => Error: x is'nt car!
=head2 validate ($element, $feature)
Checks C<$element> and throws a C<detail> message if the element does not belong to the class.
my $PositiveInt = Aion::Type->new(
name => "PositiveInt",
test => sub { /^\d+$/ },
);
eval {
$PositiveInt->validate(-1, "Neg")
};
$@ # ~> Neg must have the type PositiveInt. The it is -1
=head2 val_to_str ($val)
Converts C<$val> to a string.
Aion::Type->new->val_to_str([1,2,{x=>6}]) # => [1, 2, {x => 6}]
=head2 instanceof ($type)
Determines that a type is a subtype of another C<$type> by type name.
Doesn't work in C<|> and C<~>. Doesn't check arguments.
my $Int = Aion::Type->new(name => "Int");
my $PositiveInt = Aion::Type->new(name => "PositiveInt", as => $Int);
$PositiveInt->instanceof('Int'); # -> 1
$PositiveInt->instanceof('PositiveInt'); # -> 1
$Int->instanceof('PositiveInt'); # -> ""
my $MyEnum = Aion::Type->new(name => "MyEnum", args => [3, 5, 'car']);
($MyEnum & $PositiveInt)->instanceof('Int'); # -> 1
=head2 is_set_theoretic
Checks that the type is set-theoretic (ie - the C<|>, C<&> or C<~> operator).
=head2 simplify
If the expression has no values, it will return C<~Any>, otherwise it will return the expression.
lib/Aion/Type.pm view on Meta::CPAN
Always returns C<1>. Needed to specify a test for a type without C<where>.
=head2 clone ()
Clone type.
my $type = Aion::Type->new(name => 'New');
my $type10 = $type->clone(args => [10]);
$type->stringify # => New
$type10->stringify # => New[10]
=head2 is_primitive ()
This is a primitive type, that is, one in whose hierarchy there are no set-theoretic operators.
Aion::Types::Int->is_primitive # -> 1
Aion::Types::Like->is_primitive # -> ""
=head2 is_union ()
This is a union of types.
Aion::Types::Int->is_union # -> ""
(Aion::Types::Int | Aion::Types::Int)->is_union # -> 1
=head2 is_intersection ()
This is the intersection of types.
Aion::Types::Int->is_intersection # -> ""
(Aion::Types::Int & Aion::Types::Int)->is_intersection # -> 1
=head2 is_exclude ()
This is a type exception.
Aion::Types::Any->is_exclude # -> ""
(~Aion::Types::Any)->is_exclude # -> 1
Aion::Types::None->is_exclude # -> 1
~Aion::Types::Any eq Aion::Types::None # -> 1
=head2 is_enum ()
This is an enumeration.
Aion::Types::Int->is_enum # -> ""
Aion::Types::Enum([1])->is_enum # -> 1
=head2 is_range_type ()
This is an interval type.
Aion::Types::Int->is_range_type # -> ""
Aion::Types::Len([10])->is_range_type # -> 1
=head2 range_lbound ()
Lower limit of the interval.
Aion::Types::Int->range_lbound # -> undef
Aion::Types::Len([10])->range_lbound # -> 0
Aion::Types::Range([0, 10])->range_lbound # -> '-Inf'
=head2 is_range ()
This is an interval.
Aion::Types::Int->is_range # -> ""
Aion::Types::Len([10])->is_range # -> ""
Aion::Types::Range([1, 10])->is_range # -> 1
=head2 typed_sorted_args_key ()
Generates a key with sorted typed parameters.
(Aion::Types::Int & Aion::Types::Num)->typed_sorted_args_key # -> (Aion::Types::Num & Aion::Types::Int)->typed_sorted_args_key
=head2 sorted_args_key ()
Generates a key with sorted untyped parameters.
Aion::Types::Enum([10, 20])->sorted_args_key # -> Aion::Types::Enum([20, 10])->sorted_args_key
=head2 key ()
A unique key from the type prototype and its parameters.
=head2 keyfn ($fn)
Sets/returns the key construction function for the type as a class.
my $type = Aion::Type->new(name => 'New', args => [10, 20]);
$type->keyfn($type->can('sorted_args_key'));
my $type2 = Aion::Type->new(name => 'New', args => [20, 10], coerce => $type->{coerce});
$type->key # -> $type2->key
=head2 asen ()
Returns the chain of ancestors.
[Aion::Types::Num->asen] # --> [Aion::Types::Any, Aion::Types::Item, Aion::Types::Defined, Aion::Types::Value, Aion::Types::Str]
=head2 ckey ()
Key for comparing types in <=> and cmp.
=head2 compare ($other)
Comparison for sorting. Used in the C<< E<lt>=E<gt> >> and C<cmp> operators.
=head2 is_descendant ($other, $is_strict)
A is a child of B. The prototype is compared, but if C<$is_strict> is specified, then the C<eq> operator is used.
Aion::Types::Range([1, 10])->is_descendant(Aion::Types::Defined) # -> 1
Aion::Types::Range([1, 10])->is_descendant(Aion::Types::Value) # -> ""
=head2 like ($other)
( run in 1.588 second using v1.01-cache-2.11-cpan-d80b1682f3f )