view release on metacpan or  search on metacpan

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

		return "" if $self->{as} && !$self->{as}->test;
	}

	local $Aion::Type::SELF = $self;
	$self->{test}->();
}

# Является элементом множества описываемого типом
sub include {
	(my $self, local $_) = @_;
	$self->test
}

# Не является элементом множества описываемого типом
sub exclude {
	(my $self, local $_) = @_;
	!$self->test
}

# Валидировать значение в параметре
sub validate {
	(my $self, local $_, my $name) = @_;
	die $self->detail($_, $name) unless $self->test;
	$_
}

# Преобразовать значение в параметре и вернуть преобразованное
sub coerce {
	local ($Aion::Type::SELF, $_) = @_;

	for my $coerce (@{$Aion::Type::SELF->{coerce}}) {
		return $coerce->[1]() if $coerce->[0]->test;
	}
	$_
}

#@category compare

#my $_any; my $_none;
sub Any() { *Any = \&Aion::Types::Any; &Any }
sub None() { *None = \&Aion::Types::None; &None }

# refaddr coerce => минимальная нижняя граница. У Range она -Inf, а у остальных – 0
our %range_lbound;

# Определяет, что тип – множественно-теоретический оператор
my $set_theoretic = [qw/Union Intersection Exclude/];
sub is_set_theoretic { shift->{name} ~~ $set_theoretic }
sub is_union { shift->{name} eq 'Union' }
sub is_intersection { shift->{name} eq 'Intersection' }
sub is_exclude { shift->{name} eq 'Exclude' }
sub is_enum { shift->{name} eq 'Enum' }
sub is_range_type { exists $range_lbound{Scalar::Util::refaddr shift->{coerce}} }
sub range_lbound { $range_lbound{Scalar::Util::refaddr shift->{coerce}} }
sub is_range { shift->range_lbound == '-Inf' }

# Формирует ключ с отсортированными типизированными параметрами
sub typed_sorted_args_key {
	my ($self) = @_;
	my $coerceaddr = Scalar::Util::refaddr $self->{coerce};
	join "-", $coerceaddr, join(",", map { join ":", length($_), $_ } sort map $_->key, @{$self->{args}});
}

# Формирует ключ с отсортированными нетипизированными параметрами
sub sorted_args_key {
	my ($self) = @_;
	my $coerceaddr = Scalar::Util::refaddr $self->{coerce};
	join "-", $coerceaddr, join(",", map { join ":", length($_), $_ } sort @{$self->{args}});
}

# Возвращает уникальный ключ для типа, использующийся в хешах и сравнения
# Должен быть заменён на созданные типы
my %keyfn;
my $undefined = [];
sub key {
	my ($self) = @_;
	$self->{key} //= do {
		my $coerceaddr = Scalar::Util::refaddr $self->{coerce};
		my $keyfn = $keyfn{$coerceaddr};
		$keyfn
			? $keyfn->($self)
			: join "-", $coerceaddr, exists $self->{args} && @{$self->{args}} || exists $self->{N} || exists $self->{M}
				? join(",", map {
					my $key = UNIVERSAL::isa($_, __PACKAGE__)? $_->key: "" . ($_ // $undefined);
					join ":", length($key), $key 
				} @{$self->{args}})
				: ();
	};
}

# Устанавливает/возвращает функцию построения ключа для типа как класса
sub keyfn {
	my ($self, $fn) = @_;
	if(@_>1) {
		$keyfn{Scalar::Util::refaddr $self->{coerce}} = $fn;
		$self
	} else {
		$keyfn{Scalar::Util::refaddr $self->{coerce}};
	}
}

# Возвращает цепочку предков
sub asen {
	my ($self) = @_;
	my @as;
	for(my $i=$self->{as}; $i; $i = $i->{as}) { unshift @as, $i }
	unshift @as, Any unless @as && $as[0] eq Any;
	@as
}

# Ключ для сравнения типов в <=> и cmp
sub ckey {
	my ($self) = @_;
	$self->{ckey} //= join " <- ", map $_->stringify, $self->asen, $self;
}

# Сравнение для сортировки
sub compare {
	my ($self, $other) = @_;
	$self->ckey cmp $other->ckey;
}

# A потомок B
sub instanceof {
	my ($self, $name) = @_;

	my @S = $self;
	while(@S) {
		my $x = pop @S;
		return 1 if $x->{name} eq $name;
		if($x->is_intersection) { push @S, @{$x->{args}} }
		elsif($x->is_set_theoretic) {}
		else { push @S, $x->{as} if $x->{as} }
    }

    ""
}

# A потомок B
sub is_descendant {
	my ($self, $other, $is_strict) = @_;
	
	return 1 if $is_strict && $self eq $other
	    || !$is_strict && $self->like($other);

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

=head2 disjoint ($other)

A type does not overlap with another type.

=head2 subset ($type)

Specifies that it is a subset of the specified type.

=head2 superset ($type)

Specifies that it is a superset of the specified type.

=head2 subproper ($other)

A type is a strict subset of another.

=head2 superproper ($other)

A type is a strict superset of another.

=head2 equals ($other)

A type is equivalent to another type.

=head2 differs ($other)

A type is not equivalent to another type.

=head2 disjoint ($other)

A type has no overlap with another type.

=head2 intersects ($other)

A type has an intersection or intersections with another type.

=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

If C<init> is specified, then each time the subroutine is used, a type will be created and initialized.

	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__, 1);
	}
	
	"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 or without arguments.

	BEGIN {
		Aion::Type->new(
			name => "Enum123",
			test => sub { $_ ~~ [1,2,3] },
			a_test => sub { $_ ~~ $Aion::Type::SELF->{args} },
		)->make_maybe_arg(__PACKAGE__);
	}
	
	3 ~~ Enum123        # -> 1
	3 ~~ Enum123[4,5,6] # -> ""
	5 ~~ Enum123[4,5,6] # -> 1

If the routine cannot be created, an exception is thrown.

	eval { Aion::Type->new(name=>"Rim")->make_maybe_arg }; $@ # ~> syntax error

=head2 args ()

List of arguments.

=head2 name ()

Type name.

=head2 as ()

Parent type.

=head2 message (;&message)

Message accessor. Uses C<&message> to generate an error message.

=head2 title (;$title)

Header accessor (used to create the B<swagger> schema).

=head2 description (;$description)

Description accessor (used to create a B<swagger> schema).

=head2 example (;$example)

Example accessor (used to create the B<swagger> schema).

=head2 true ()

Always returns C<1>. Needed to specify a test for a type without C<where>.