Aion
view release on metacpan or search on metacpan
lib/Aion/Types.pm view on Meta::CPAN
$type->{test} = $where;
$type->{a_test} = $awhere;
$type->make_maybe_arg($pkg)
} elsif($is_arg || $init_where) {
$type->{test} = $where;
$type->make_arg($pkg, $is_arg? '$': '')
} else {
$type->{test} = $where // $TRUE;
$type->make($pkg)
}
}
}
sub as(@) { (as => @_) }
sub init_where(&@) { (init_where => @_) }
sub where(&@) { (where => @_) }
sub awhere(&@) { (awhere => @_) }
sub message(&@) { (message => @_) }
sub SELF() { $Aion::Type::SELF }
sub ARGS() { wantarray? @{$Aion::Type::SELF->{args}}: $Aion::Type::SELF->{args} }
sub A() { $Aion::Type::SELF->{args}[0] }
sub B() { $Aion::Type::SELF->{args}[1] }
sub C() { $Aion::Type::SELF->{args}[2] }
sub D() { $Aion::Type::SELF->{args}[3] }
sub M() :lvalue { $Aion::Type::SELF->{M} }
sub N() :lvalue { $Aion::Type::SELF->{N} }
# Создание транÑлÑтора. У типа может быть Ñколько угодно транÑлÑторов из других типов
# coerce Type, from OtherType, via {...}
sub coerce(@) {
my ($type, %o) = @_;
my ($from, $via) = delete @o{qw/from via/};
die "coerce $type unused keys left: " . join ", ", keys %o if keys %o;
die "coerce $type not Aion::Type!" unless UNIVERSAL::isa($type, "Aion::Type");
die "coerce $type: from is'nt Aion::Type!" unless UNIVERSAL::isa($from, "Aion::Type");
die "coerce $type: via is not subroutine!" unless ref $via eq "CODE";
push @{$type->{coerce}}, [$from, $via];
return;
}
sub from($) { (from => $_[0]) }
sub via(&) { (via => $_[0]) }
BEGIN {
subtype "Any";
subtype "Control", as &Any;
subtype "Union[A, B...]", as &Control,
where { my $val = $_; any { $_->include($val) } ARGS };
subtype "Intersection[A, B...]", as &Control,
where { my $val = $_; all { $_->include($val) } ARGS };
subtype "Exclude[A...]", as &Control,
where { my $val = $_; !any { $_->include($val) } ARGS };
subtype "Option[A]", as &Control,
init_where {
SELF->{is_option} = 1;
Tuple([Object(["Aion::Type"])])->validate(scalar ARGS, "Arguments Option[A]")
}
where { A->test };
subtype "Wantarray[A, S]", as &Control,
init_where {
SELF->{is_wantarray} = 1;
Tuple([Object(["Aion::Type"]), Object(["Aion::Type"])])->validate(scalar ARGS, "Arguments Wantarray[A, S]")
}
where { ... };
subtype "Item", as &Any;
sub External($) {
local $_ = $_[0][0];
UNIVERSAL::isa($_, 'Aion::Type')? $_:
defined($_) && ref $_ eq ""? Object([$_]): do {
CodeLike()->validate($_, "External type");
Aion::Type->new(
name => 'External',
as => &Item,
args => $_[0],
test => $_,
UNIVERSAL::can($_, 'coerce')
? (coerce => [[&Any, (sub { my ($ex) = @_; sub { $ex->coerce } })->($_)]])
: (),
)
}
}
subtype "Bool", as &Item, where { ref $_ eq "" and /^(1|0|)\z/ };
subtype "BoolLike", as &Item, where {
return 1 if overload::Method($_, 'bool');
my $m = overload::Method($_, '0+');
Bool()->include($m ? $m->($_) : $_) };
subtype "Enum[e...]", as &Item, where { $_ ~~ ARGS };
subtype "Maybe[A]", as &Item, where { !defined($_) || A->test };
subtype "Undef", as &Item, where { !defined $_ };
subtype "Defined", as &Item, where { defined $_ };
subtype "Value", as &Defined, where { "" eq ref $_ };
subtype "Version", as &Value, where { "VSTRING" eq ref \$_ };
subtype "Str", as &Value, where { "SCALAR" eq ref \$_ };
subtype "Uni", as &Str, where { utf8::is_utf8($_) || /[\x80-\xFF]/a };
subtype "Bin", as &Str, where { !utf8::is_utf8($_) && !/[\x80-\xFF]/a };
subtype "NonEmptyStr", as &Str, where { /\S/ };
subtype "StartsWith[start]", as &Str,
init_where { M = qr/^${\ quotemeta A}/ },
where { $_ =~ M };
subtype "EndsWith[end]", as &Str,
init_where { N = qr/${\ quotemeta A}$/ },
where { $_ =~ N };
subtype "Email", as &Str, where { /@/ };
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\s+html|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[regexp]", as &Str, where { $_ =~ A };
subtype "ClassName", as &Str, where { !!$_->can('new') };
subtype "RoleName", as &Str, where { !$_->can('new') && !!(@{"$_\::ISA"} || first { *{$_}{CODE} } values %{"$_\::"}) };
subtype "StrRat", as &Str, where { m!\s*/\s*!? &Num->include($`) && &Num->include($`): &Num->test };
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 "Ref", as &Defined, where { "" ne ref $_ };
subtype "Tied`[class]", as &Ref,
where { my $ref = reftype($_); !!(
$ref eq "HASH"? tied %$_:
$ref eq "ARRAY"? tied @$_:
$ref eq "SCALAR"? tied $$_:
0
) }
awhere { my $ref = reftype($_);
$ref eq "HASH"? A eq ref tied %$_:
lib/Aion/Types.pm view on Meta::CPAN
};
subtype "LValueRef", as &Ref, where { ref $_ eq "LVALUE" };
subtype "FormatRef", as &Ref, where { ref $_ eq "FORMAT" };
subtype "CodeRef", as &Ref, where { ref $_ eq "CODE" };
subtype "NamedCode[subname]", as &CodeRef, where { Sub::Util::subname($_) ~~ A };
subtype "ProtoCode[prototype]", as &CodeRef, where { Sub::Util::prototype($_) ~~ A };
subtype "ForwardRef", as &CodeRef, where { !subref_is_reachable($_) };
subtype "ImplementRef", as &CodeRef, where { subref_is_reachable($_) };
subtype "Isa[type...]", as &CodeRef,
init_where {
my $pkg = caller(2);
SELF->{args} = [ map { External([UNIVERSAL::isa($_, 'Aion::Type')? $_: $pkg->can($_)? $pkg->can($_)->(): $_]) } ARGS ]
}
where {
my $subroutine = $Aion::Isa{pack "J", refaddr $_} or return "";
my $signature = $subroutine->{signature};
my $args = ARGS;
return "" if @$signature != @$args;
my $i = 0;
for my $type (@$args) {
return "" unless $signature->[$i++] eq $type;
}
1
};
subtype "RegexpRef", as &Ref, where { ref $_ eq "Regexp" };
subtype "ValueRef`[A]", as &Ref,
where { ref($_) ~~ ["SCALAR", "REF"] }
awhere { ref($_) ~~ ["SCALAR", "REF"] && A->include($$_) };
subtype "ScalarRef`[A]", as &ValueRef,
where { ref $_ eq "SCALAR" }
awhere { ref $_ eq "SCALAR" && A->include($$_) };
subtype "RefRef`[A]", as &ValueRef,
where { ref $_ eq "REF" }
awhere { ref $_ eq "REF" && A->include($$_) };
subtype "GlobRef", as &Ref, where { ref $_ eq "GLOB" };
subtype "FileHandle", as &GlobRef,
where { !!*$_{IO} };
subtype "ArrayRef`[A]", as &Ref,
where { ref $_ eq "ARRAY" }
awhere { my $A = A; ref $_ eq "ARRAY" && all { $A->test } @$_ };
subtype "HashRef`[A]", as &Ref,
where { ref $_ eq "HASH" }
awhere { my $A = A; ref $_ eq "HASH" && all { $A->test } values %$_ };
subtype "Object`[class]", as &Ref,
where { blessed($_) ne "" }
awhere { blessed($_) && $_->isa(A) };
subtype "Me", as &Object,
init_where { SELF->{me} = caller(2) }
where { UNIVERSAL::isa($_, SELF->{me}) };
subtype "Map[K, V]", as &HashRef,
where {
my ($K, $V) = ARGS;
while(my ($k, $v) = each %$_) {
return "" unless $K->include($k) && $V->include($v);
}
return 1;
};
my $tuple_args = ArrayRef([Object(['Aion::Type'])]);
subtype "Tuple[A...]", as &ArrayRef,
init_where { $tuple_args->validate(scalar ARGS, "Arguments Tuple[A...]") }
where {
my $k = 0;
for my $A (ARGS) {
return "" if $A->exclude($_->[$k++]);
}
$k == @$_
};
subtype "CycleTuple[A...]", as &ArrayRef,
init_where { $tuple_args->validate(scalar ARGS, "Arguments CycleTuple[A...]") }
where {
my $k = 0;
while($k < @$_) {
for my $A (ARGS) {
return "" if $A->exclude($_->[$k++]);
}
}
$k == @$_
};
my $dict_args = CycleTuple([&Str, Object(['Aion::Type'])]);
subtype "Dict[k => A, ...]", as &HashRef,
init_where { $dict_args->validate(scalar ARGS, "Arguments Dict[k => A, ...]") }
where {
my $count = 0; my $k;
for my $A (ARGS) {
$k = $A, next unless ref $A;
if(exists $_->{$k}) {
return "" if $A->exclude($_->{$k});
$count++;
} else {
return "" if !exists $A->{is_option};
}
}
$count == keys %$_
};
subtype "RegexpLike", as &Ref,
where { reftype($_) eq "REGEXP" || !!overload::Method($_, 'qr') };
subtype "CodeLike", as &Ref,
where { reftype($_) eq "CODE" || !!overload::Method($_, '&{}') };
subtype "ArrayLike`[A]", as &Ref,
where { reftype($_) eq "ARRAY" || !!overload::Method($_, '@{}') }
awhere { &ArrayLike->test && do { my $A = A; all { $A->test } @$_ }};
my $init_limit = sub { if(@{&ARGS} == 1) { SELF->{min} = 0; SELF->{max} = A } else { SELF->{min} = A; SELF->{max} = B } };
subtype "Lim[from, to?]", as &ArrayLike,
init_where => $init_limit,
where { SELF->{min} <= @$_ && @$_ <= SELF->{max} };
subtype "HashLike`[A]", as &Ref,
where { reftype($_) eq "HASH" || !!overload::Method($_, "%{}") }
awhere { &HashLike->test && do { my $A = A; all { $A->test } values %$_ }};
subtype "HasProp[p...]", as &HashLike,
where { my $x = $_; all { exists $x->{$_} } ARGS };
subtype "LimKeys[from, to?]", as &HashLike,
init_where => $init_limit,
where { SELF->{min} <= scalar keys %$_ && scalar keys %$_ <= SELF->{max} };
subtype "Like", as (&Str | &Object);
subtype "HasMethods[m...]", as &Like,
where { my $x = $_; all { $x->can($_) } ARGS };
subtype "Overload`[m...]", as &Like,
where { !!overload::Overloaded($_) }
awhere { my $x = $_; all { overload::Method($x, $_) } ARGS };
subtype "InstanceOf[class...]", as &Like, where { my $x = $_; all { $x->isa($_) } ARGS };
subtype "ConsumerOf[role...]", as &Like, where { my $x = $_; all { $x->DOES($_) } ARGS };
subtype "StrLike", as &Like, where { !blessed($_) or !!overload::Method($_, '""') };
subtype "Len[from, to?]", as &StrLike,
init_where => $init_limit,
where { SELF->{min} <= length($_) && length($_) <= SELF->{max} };
subtype "NumLike", as &Like, 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 };
my $_8bits;
subtype "Bytes[n]", as &NumLike,
init_where {
my $bits = A < 8? 8: ($_8bits //= do {
require Math::BigInt;
Math::BigInt->new(8)
});
my $N = 1 << ($bits * A - 1);
N = -$N;
M = $N-1;
}
where { N <= $_ && $_ <= M };
subtype "PositiveBytes[n]", as &NumLike,
init_where {
my $bits = A < 8? 8: ($_8bits //= do {
require Math::BigInt;
Math::BigInt->new(8)
});
M = (1 << ($bits*A)) - 1;
}
where { 0 <= $_ && $_ <= M };
coerce &Str => from &Undef => via { "" };
coerce &Int => from &Num => via { int($_+($_ < 0? -.5: .5)) };
coerce &Bool => from &Any => via { !!$_ };
subtype 'Join[separator]', as &Str;
coerce &Join, from &ArrayRef, via { join A, @$_ };
subtype 'Split[separator]', as &ArrayRef;
coerce &Split, from &Str, via { [split A, $_] };
subtype "Rat", as 'Math::BigRat';
coerce &Rat => from &StrRat => via { Math::BigRat->new($_) };
};
1;
__END__
=encoding utf-8
=head1 NAME
Aion::Types - a library of standard validators and it is used to create new validators
=head1 SYNOPSIS
use Aion::Types;
BEGIN {
subtype SpeakOfKitty => as StrMatch[qr/\bkitty\b/i],
message { "Speak is'nt included kitty!" };
}
"Kitty!" ~~ SpeakOfKitty # -> 1
"abc" ~~ SpeakOfKitty # -> ""
SpeakOfKitty->validate("abc", "This") # @-> Speak is'nt included kitty!
BEGIN {
subtype IntOrArrayRef => as (Int | ArrayRef);
}
[] ~~ IntOrArrayRef # -> 1
35 ~~ IntOrArrayRef # -> 1
"" ~~ IntOrArrayRef # -> ""
coerce IntOrArrayRef, from Num, via { int($_ + .5) };
IntOrArrayRef->coerce(5.5) # => 6
=head1 DESCRIPTION
This module exports routines:
=over
=item * C<subtype>, C<as>, C<init_where>, C<where>, C<awhere>, C<message> - for creating validators.
=item * C<SELF>, C<ARGS>, C<A>, C<B>, C<C>, C<D>, C<M>, C<N> - for use in validators of a type and its arguments.
=item * C<coerce>, C<from>, C<via> - to create a value converter from one class to another.
=back
Validator hierarchy:
Any
Control
Union[A, B...]
Intersection[A, B...]
Exclude[A...]
Option[A]
Wantarray[A, B]
Item
External[type]
Bool
BoolLike
Enum[e...]
Maybe[A]
Undef
Defined
Value
Version
Str
Uni
Bin
NonEmptyStr
StartsWith[start]
EndsWith[end]
Email
Tel
Url
Path
Html
StrDate
lib/Aion/Types.pm view on Meta::CPAN
PositiveInt
Nat
Ref
Tied`[class]
LValueRef
FormatRef
CodeRef
NamedCode[subname]
ProtoCode[prototype]
ForwardRef
ImplementRef
Isa[A...]
RegexpRef
ValueRef`[A]
ScalarRef`[A]
RefRef`[A]
GlobRef
FileHandle
ArrayRef`[A]
HashRef`[A]
Object`[class]
Me
Rat
Map[A => B]
Tuple[A...]
CycleTuple[A...]
Dict[k => A, ...]
RegexpLike
CodeLike
ArrayLike`[A]
Lim[from, to?]
HashLike`[A]
HasProp[p...]
LimKeys[from, to?]
Like
HasMethods[m...]
Overload`[m...]
InstanceOf[class...]
ConsumerOf[role...]
StrLike
Len[from, to?]
NumLike
Float
Double
Range[from, to]
Bytes[n]
PositiveBytes[n]
=head1 SUBROUTINES
=head2 subtype ($name, @paraphernalia)
Creates a new type.
BEGIN {
subtype One => where { $_ == 1 } message { "Actual 1 only!" };
}
1 ~~ One # -> 1
0 ~~ One # -> ""
eval { One->validate(0) }; $@ # ~> Actual 1 only!
C<where> and C<message> are syntactic sugar, and C<subtype> can be used without them.
BEGIN {
subtype Many => (where => sub { $_ > 1 });
}
2 ~~ Many # -> 1
eval { subtype Many => (where1 => sub { $_ > 1 }) }; $@ # ~> subtype Many unused keys left: where1
eval { subtype 'Many' }; $@ # ~> subtype Many: main::Many exists!
=head2 as ($super_type)
Used with C<subtype> to extend the created C<$super_type> type.
=head2 init_where ($code)
Initializes a type with new arguments. Used with C<subtype>.
BEGIN {
subtype 'LessThen[n]',
init_where { Num->validate(A, "Argument LessThen[n]") }
where { $_ < A };
}
eval { LessThen["string"] }; $@ # ^=> Argument LessThen[n]
5 ~~ LessThen[5] # -> ""
=head2 where ($code)
Uses C<$code> as a test. The value for the test is passed to C<$_>.
BEGIN {
subtype 'Two',
where { $_ == 2 };
}
2 ~~ Two # -> 1
3 ~~ Two # -> ""
=head2 awhere ($code)
Used with C<subtype>.
If the type can be with or without arguments, then it is used to check the set with arguments, and C<where> - without.
BEGIN {
subtype 'GreatThen`[num]',
where { $_ > 0 }
awhere { $_ > A }
;
}
0 ~~ GreatThen # -> ""
1 ~~ GreatThen # -> 1
3 ~~ GreatThen[3] # -> ""
4 ~~ GreatThen[3] # -> 1
Required if arguments are optional.
subtype 'Ex`[a]', where {} # @-> subtype Ex`[a]: needs an awhere
subtype 'Ex', awhere {} # @-> subtype Ex: awhere is excess
BEGIN {
subtype 'MyEnum`[item...]',
as Str,
awhere { $_ ~~ scalar ARGS }
;
}
"ab" ~~ MyEnum[qw/ab cd/] # -> 1
=head2 SELF
Current type. C<SELF> is used in C<init_where>, C<where> and C<awhere>.
=head2 ARGS
Arguments of the current type. In a scalar context, it returns a reference to an array, and in an array context, it returns a list. Used in C<init_where>, C<where> and C<awhere>.
lib/Aion/Types.pm view on Meta::CPAN
sub code_ex { ... }
\&code_ex ~~ NamedCode['main::code_ex'] # -> 1
\&code_ex ~~ NamedCode['code_ex'] # -> ""
\&code_ex ~~ NamedCode[qr/_/] # -> 1
=head2 ProtoCode[prototype]
A subroutine with the specified prototype.
sub codex ($;$);
\&codex ~~ ProtoCode['@'] # -> ""
\&codex ~~ ProtoCode['$;$'] # -> 1
\&codex ~~ ProtoCode[qr/^\$/] # -> 1
=head2 ForwardRef
Subroutine without body.
sub code_ref {};
sub code_forward;
\&code_forward ~~ ForwardRef # -> 1
\&code_ref ~~ ForwardRef # -> ""
A subroutine without a body is usually used for pre-declaration, but XS functions also have no body:
\&UNIVERSAL::isa ~~ ForwardRef # -> 1
Calling an undeclared function using C<\&> creates a reference to the previously declared function:
main->can('nouname') ~~ ForwardRef # -> ""
\&nouname ~~ ForwardRef # -> 1
main->can('nouname') ~~ ForwardRef # -> 1
=head2 ImplementRef
Subroutine with body.
sub code_ref {};
sub code_forward;
\&code_ref ~~ ImplementRef # -> 1
\&code_forward ~~ ImplementRef # -> ""
=head2 Isa[A...]
A link to a subroutine with the corresponding signature.
sub sig_ex :Isa(Aion => Int => Str) {}
\&sig_ex ~~ Isa[Aion => Int => Str] # -> 1
\&sig_ex ~~ Isa[Object['Aion'] => Int => Str] # -> 1
\&sig_ex ~~ Isa[Aion => Str => Num] # -> ""
\&sig_ex ~~ Isa[Int => Num] # -> ""
Subroutines without a body are not wrapped in a signature handler, and the signature is remembered to validate the conformity of a subsequently declared subroutine with a body. Therefore the function has no signature.
sub unreachable_sig_ex :Isa(Int => Str);
\&unreachable_sig_ex ~~ Isa[Int => Str] # -> ""
=head2 RegexpRef
Regular expression.
qr// ~~ RegexpRef # -> 1
\1 ~~ RegexpRef # -> ""
=head2 ValueRef`[A]
A reference to a scalar or reference.
\12 ~~ ValueRef # -> 1
\12 ~~ ValueRef # -> 1
\-1.2 ~~ ValueRef[Num] # -> 1
\\-1.2 ~~ ValueRef[ValueRef[Num]] # -> 1
=head2 ScalarRef`[A]
Reference to a scalar.
\12 ~~ ScalarRef # -> 1
\\12 ~~ ScalarRef # -> ""
\-1.2 ~~ ScalarRef[Num] # -> 1
=head2 RefRef`[A]
Link to link.
\12 ~~ RefRef # -> ""
\\12 ~~ RefRef # -> 1
\-1.2 ~~ RefRef[Num] # -> ""
\\-1.2 ~~ RefRef[ScalarRef[Num]] # -> 1
=head2 GlobRef
Link to global
\*A::a ~~ GlobRef # -> 1
*A::a ~~ GlobRef # -> ""
=head2 FileHandle
File descriptor.
\*A::a ~~ FileHandle # -> ""
\*STDIN ~~ FileHandle # -> 1
open my $fh, "<", "/dev/null";
$fh ~~ FileHandle # -> 1
close $fh;
opendir my $dh, ".";
$dh ~~ FileHandle # -> 1
closedir $dh;
( run in 1.690 second using v1.01-cache-2.11-cpan-5837b0d9d2c )