view release on metacpan or  search on metacpan

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

			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 %$_:
						$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 "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($_, "%{}") }