Aion
view release on metacpan or search on metacpan
lib/Aion/Types.pm view on Meta::CPAN
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,
init_where { M = +{ map {($_ => $_)} ARGS } }
where { exists M->{$_} };
subtype "Undef", as &Item, where { !defined $_ };
subtype "Maybe[A]", as &Undef | A;
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 "PackageName", as &Str, where { no utf8; use bytes; /^(?:[a-z]\w*(?:::[a-z]\w*)*)\z/ia };
subtype "ClassName", as &PackageName, where { !!$_->can('new') };
subtype "RoleName", as &PackageName, 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 "Int", as &Num, where { /^[-+]?\d+\z/ };
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 %$_:
$ref eq "ARRAY"? A eq ref tied @$_:
$ref eq "SCALAR"? A eq ref tied $$_:
""
};
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 "Tuple[A...]", as &ArrayRef,
where {
my $k = 0;
for my $A (ARGS) {
return "" if $A->exclude($_->[$k++]);
}
$k == @$_
};
subtype "CycleTuple[A...]", as &ArrayRef,
where {
my $k = 0;
while($k < @$_) {
for my $A (ARGS) {
return "" if $A->exclude($_->[$k++]);
}
}
$k == @$_
};
subtype "HashRef`[A]", as &Ref,
where { ref $_ eq "HASH" }
awhere { my $A = A; ref $_ eq "HASH" && all { $A->test } values %$_ };
subtype "Dict[k => A, ...]", as &HashRef,
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 "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;
};
subtype "Object`[class]", as &Ref,
where { blessed($_) ne "" }
awhere { blessed($_) && $_->isa(A) };
subtype "Me", as &Object,
init_where { SELF->{as} = Object([caller(2)]) };
subtype "Rat", as 'Math::BigRat';
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 } @$_ }};
subtype "Lim[from, to?]", as &ArrayLike,
init_where { unshift @{&ARGS}, 0 if @{&ARGS} == 1; }
where { A <= @$_ && @$_ <= B };
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 { unshift @{&ARGS}, 0 if @{&ARGS} == 1; }
where { A <= scalar keys %$_ && scalar keys %$_ <= B };
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 { unshift @{&ARGS}, 0 if @{&ARGS} == 1; }
where { A <= length($_) && length($_) <= B };
subtype "NumLike", as &Num | &Object & Overload(["0+"]);
sub Opened($) { Aion::Type::Lim->from(ref $_[0] eq "ARRAY"? $_[0][0]: $_[0]) };
subtype "Range[from, to]", as &NumLike,
init_where {
SELF->{args}[0] = A->inc if UNIVERSAL::isa(A, 'Aion::Type::Lim');
SELF->{args}[1] = B->dec if UNIVERSAL::isa(B, 'Aion::Type::Lim');
}
where { A <= $_ && $_ <= B };
subtype "Float", as Range([-(POSIX::FLT_MAX), POSIX::FLT_MAX]);
subtype "Double", as Range([-(DBL_MAX), DBL_MAX]);
subtype "Bytes[n]", as Range([]),
init_where {
my $_8bits = A < 8? 8: _8BITS;
my $N = 1 << ($_8bits * A - 1);
SELF->{as} = Range([-$N, $N-1]);
};
subtype "PositiveBytes[n]", as Range([]),
init_where {
my $_8bits = A < 8? 8: _8BITS;
my $M = 1 << ($_8bits*A);
SELF->{as} = Range([0, $M-1]);
};
coerce &Str => from &Undef => via { "" };
coerce &Int => from &Num => via { int($_+($_ < 0? -.5: .5)) };
coerce &Bool => from &Any => via { !!$_ };
( run in 1.759 second using v1.01-cache-2.11-cpan-6de40a662fe )