Aion
view release on metacpan or search on metacpan
lib/Aion/Type.pm view on Meta::CPAN
return 1 if Scalar::Util::refaddr $self == Scalar::Util::refaddr $type;
return "" unless UNIVERSAL::isa($type, __PACKAGE__);
return "" unless $self->{name} eq $type->{name};
return "" unless @{$self->{args}} == @{$type->{args}};
return "" unless $self->{as} && $self->{as}->equal($type->{as})
|| !$self->{as} && !$type->{as};
my $i = 0;
for my $arg (@{$self->{args}}) {
return "" unless $arg eq $type->{args}[$i++];
}
return 1;
}
sub nonequal {
my ($self, $type) = @_;
!$self->equal($type)
}
# ТеÑÑиÑоваÑÑ Ð·Ð½Ð°Ñение в $_
sub test {
my ($self) = @_;
local $Aion::Type::SELF = $self;
my $ok = $self->{test}->();
$ok
}
# ÐниÑиализиÑоваÑÑ Ñип
sub init {
my ($self) = @_;
local $Aion::Type::SELF = $self;
$self->{init}->();
$self
}
# ЯвлÑеÑÑÑ ÑлеменÑом множеÑÑва опиÑÑваемого Ñипом
sub include {
(my $self, local $_) = @_;
$self->test
}
# Ðе ÑвлÑеÑÑÑ ÑлеменÑом множеÑÑва опиÑÑваемого Ñипом
sub exclude {
(my $self, local $_) = @_;
!$self->test
}
# СообÑение об оÑибке
sub detail {
(my $self, local $_, my $name) = @_;
local $Aion::Type::SELF = $self;
local $Aion::Type::SELF->{N} = $name;
$self->{message}? $self->{message}->():
"$name must have the type $self. The it is ${\
Aion::Meta::Util::val_to_str($_)
}!"
}
# ÐалидиÑоваÑÑ Ð·Ð½Ð°Ñение в паÑамеÑÑе
sub validate {
(my $self, local $_, my $name) = @_;
die $self->detail($_, $name) if !$self->test;
$_
}
# ÐÑеобÑазоваÑÑ Ð·Ð½Ð°Ñение в ÑÑÑокÑ
sub val_to_str {
my ($self, $val) = @_;
Aion::Meta::Util::val_to_str($val)
}
# ÐÑеобÑазоваÑÑ Ð·Ð½Ð°Ñение в паÑамеÑÑе и веÑнÑÑÑ Ð¿ÑеобÑазованное
sub coerce {
(my $self, local $_) = @_;
local $Aion::Type::SELF = $self;
for my $coerce (@{$self->{coerce}}) {
return $coerce->[1]() if $coerce->[0]{test}();
}
$_
}
# ÐпÑеделÑеÑ, ÑÑо Ñип ÑвлÑеÑÑÑ Ð¿Ð¾Ð´Ñипом дÑÑгого Ñипа
sub instanceof {
my ($self, $name) = @_;
$name = $name->{name} if ref $name;
for(my $type = $self; $type; $type = $type->{as}) {
return 1 if $type->{name} eq $name;
}
""
}
# Ðаголовок
sub title {
my ($self, $title) = @_;
if(@_ == 1) {
$self->{title}
} else {
bless {%$self, title => $title}, ref $self
}
}
# ÐпиÑание
sub description {
my ($self, $description) = @_;
if(@_ == 1) {
$self->{description}
} else {
bless {%$self, description => $description}, ref $self
}
}
# ÐпиÑание
sub example {
my ($self, $description) = @_;
if(@_ == 1) {
$self->{example}
} else {
bless {%$self, example => $description}, ref $self
}
lib/Aion/Type.pm view on Meta::CPAN
# СоздаÑÑ ÑÑнкÑÐ¸Ñ Ð´Ð»Ñ Ñипа c аÑгÑменÑом или без
sub make_maybe_arg {
my ($self, $pkg) = @_;
my $var = "\$$self->{name}";
my $init = $self->{init}? "->init": "";
my $code = "package $pkg;
my $var = \$self;
sub $self->{name} (;\$) {
\@_==0? $var:
Aion::Type->new(
%$var,
args => \$_[0],
test => ${var}->{a_test},
)$init
}
1";
eval $code or die;
$self
}
1;
__END__
=encoding utf-8
=head1 NAME
Aion::Type - class of validators
=head1 SYNOPSIS
use Aion::Type;
my $Int = Aion::Type->new(name => "Int", test => sub { /^-?\d+$/ });
12 ~~ $Int # => 1
12.1 ~~ $Int # -> ""
my $Char = Aion::Type->new(name => "Char", test => sub { /^.\z/ });
$Char->include("a") # => 1
$Char->exclude("ab") # => 1
my $IntOrChar = $Int | $Char;
77 ~~ $IntOrChar # => 1
"a" ~~ $IntOrChar # => 1
"ab" ~~ $IntOrChar # -> ""
my $Digit = $Int & $Char;
7 ~~ $Digit # => 1
77 ~~ $Digit # -> ""
"a" ~~ ~$Int; # => 1
5 ~~ ~$Int; # -> ""
eval { $Int->validate("a", "..Eval..") }; $@ # ~> ..Eval.. must have the type Int. The it is 'a'
=head1 DESCRIPTION
Spawns validators. Used in C<Aion::Types::subtype>.
=head1 METHODS
=head2 new (%ARGUMENTS)
Constructor.
=head3 ARGUMENTS
=over
=item * name (Str) â Type name.
=item * args (ArrayRef) â List of type arguments.
=item * init (CodeRef) â Type initializer.
=item * test (CodeRef) - Checker.
=item * a_test (CodeRef) â Value checker for types with optional arguments.
=item * coerce (ArrayRef[Tuple[Aion::Type, CodeRef]]) - Array of pairs: type and transition.
=back
=head2 stringify
String conversion of object (name with arguments):
my $Char = Aion::Type->new(name => "Char");
$Char->stringify # => Char
my $Int = Aion::Type->new(
name => "Int",
args => [3, 5],
);
$Int->stringify #=> Int[3, 5]
Operations are also converted to a string:
($Int & $Char)->stringify # => ( Int[3, 5] & Char )
($Int | $Char)->stringify # => ( Int[3, 5] | Char )
(~$Int)->stringify # => ~Int[3, 5]
Operations are C<Aion::Type> objects with special names:
Aion::Type->new(name => "Exclude", args => [$Int, $Char])->stringify # => ~( Int[3, 5] | Char )
Aion::Type->new(name => "Union", args => [$Int, $Char])->stringify # => ( Int[3, 5] | Char )
Aion::Type->new(name => "Intersection", args => [$Int, $Char])->stringify # => ( Int[3, 5] & Char )
=head2 test
Tests that C<$_> belongs to a class.
lib/Aion/Type.pm view on Meta::CPAN
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} >>.
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->{N}!"
});
$Num->detail("x", "car") # => Error: x is'nt car!
C<< $Aion::Type::SELF-E<gt>{N} >> equivalent to C<N> in context of C<Aion::Types>.
=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)
Specifies that a type is a subtype of another C<$type>.
my $int = Aion::Type->new(name => "Int");
my $positiveInt = Aion::Type->new(name => "PositiveInt", as => $int);
$positiveInt->instanceof($int) # -> 1
$positiveInt->instanceof($positiveInt) # -> 1
$positiveInt->instanceof('Int') # -> 1
$positiveInt->instanceof('PositiveInt') # -> 1
$int->instanceof('PositiveInt') # -> ""
$int->instanceof('Int') # -> 1
=head2 make ($pkg)
Creates a subroutine with no arguments that returns a type.
BEGIN {
Aion::Type->new(name=>"Rim", test => sub { /^[IVXLCDM]+$/i })->make(__PACKAGE__);
}
"IX" ~~ Rim # => 1
The C<init> property cannot be used with C<make>.
eval { Aion::Type->new(name=>"Rim", init => sub {...})->make(__PACKAGE__) }; $@ # ~> init_where won't work in Rim
If the routine cannot be created, an exception is thrown.
eval { Aion::Type->new(name=>"Rim")->make }; $@ # ~> syntax error
=head2 make_arg ($pkg)
Creates a subroutine with arguments that returns a type.
BEGIN {
Aion::Type->new(name=>"Len", test => sub {
$Aion::Type::SELF->{args}[0] <= length($_) && length($_) <= $Aion::Type::SELF->{args}[1]
})->make_arg(__PACKAGE__);
}
"IX" ~~ Len[2,2] # => 1
If the routine cannot be created, an exception is thrown.
eval { Aion::Type->new(name=>"Rim")->make_arg }; $@ # ~> syntax error
=head2 make_maybe_arg ($pkg)
Creates a subroutine with arguments that returns a type.
( run in 0.972 second using v1.01-cache-2.11-cpan-5837b0d9d2c )