view release on metacpan or  search on metacpan

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

	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 %$_:
						$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;
							}

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

	undef ~~ Maybe[Int] # -> 1
	4 ~~ Maybe[Int]     # -> 1
	"" ~~ Maybe[Int]    # -> ""

=head2 Undef

Only C<undef>.

	undef ~~ Undef # -> 1
	0 ~~ Undef     # -> ""

=head2 Defined

Everything except C<undef>.

	\0 ~~ Defined    # -> 1
	undef ~~ Defined # -> ""

=head2 Value

Defined values without references.

	3 ~~ Value  # -> 1
	\3 ~~ Value    # -> ""
	undef ~~ Value # -> ""

=head2 Len[from, to?]

Specifies a length value from C<from> to C<to>, or from 0 to C<from> if C<to> is missing.

	"1234" ~~ Len[3]   # -> ""
	"123" ~~ Len[3]    # -> 1
	"12" ~~ Len[3]     # -> 1
	"" ~~ Len[1, 2]    # -> ""
	"1" ~~ Len[1, 2]   # -> 1
	"12" ~~ Len[1, 2]  # -> 1
	"123" ~~ Len[1, 2] # -> ""

=head2 Version

Perl version.

	1.1.0 ~~ Version   # -> 1
	v1.1.0 ~~ Version  # -> 1
	v1.1 ~~ Version    # -> 1
	v1 ~~ Version      # -> 1
	1.1 ~~ Version     # -> ""
	"1.1.0" ~~ Version # -> ""

=head2 Str

Strings, including numbers.

	1.1 ~~ Str   # -> 1
	"" ~~ Str    # -> 1
	1.1.0 ~~ Str # -> ""

=head2 Uni

Unicode strings with the utf8 flag or if decoding to utf8 occurs without errors.

	"↭" ~~ Uni # -> 1
	123 ~~ Uni # -> ""
	do {no utf8; "↭" ~~ Uni} # -> 1

=head2 Bin

Binary strings without the utf8 flag and octets with numbers less than 128.

	123 ~~ Bin # -> 1
	"z" ~~ Bin # -> 1
	"↭" ~~ Bin # -> ""
	do {no utf8; "↭" ~~ Bin }   # -> ""

=head2 StartsWith[begin]

The line starts with C<begin>.

	"Hi, world!" ~~ StartsWith["Hi,"]; # -> 1
	"Hi world!" ~~ StartsWith["Hi,"];  # -> ""

=head2 EndsWith[end]

The line ends with C<end>.

	"Hi, world!" ~~ EndsWith["world!"]; # -> 1
	"Hi, world" ~~ EndsWith["world!"];  # -> ""

=head2 NonEmptyStr

A string containing one or more non-blank characters.

	" " ~~ NonEmptyStr              # -> ""
	" S " ~~ NonEmptyStr            # -> 1
	" S " ~~ (NonEmptyStr & Len[2]) # -> ""

=head2 Email

Lines with C<@>.

	'@' ~~ Email     # -> 1
	'a@a.a' ~~ Email # -> 1
	'a.a' ~~ Email   # -> ""

=head2 Tel

The telephone format is a plus sign and seven or more digits.

	"+1234567" ~~ Tel  # -> 1
	"+1234568" ~~ Tel  # -> 1
	"+ 1234567" ~~ Tel # -> ""
	"+1234567 " ~~ Tel # -> ""

=head2 Url

Website URLs are a string prefixed with http:// or https://.

	"http://" ~~ Url # -> 1
	"http:/" ~~ Url  # -> ""

=head2 Path

Paths start with a slash.

	"/" ~~ Path  # -> 1
	"/a/b" ~~ Path  # -> 1
	"a/b" ~~ Path   # -> ""

=head2 Html

HTML starts with C<< E<lt>!doctype html >> or C<< E<lt>html >>.

	"<HTML" ~~ Html            # -> 1