Aion

 view release on metacpan or  search on metacpan

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

# Не является элементом множества описываемого типом
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 init

Validator initializer.

	my $Range = Aion::Type->new(
		name => "Range",
		args => [3, 5],
		init => [sub {
			@{$Aion::Type::SELF}{qw/min max/} = @{$Aion::Type::SELF->{args}};
		}],
		test => sub { $Aion::Type::SELF->{min} <= $_ && $_ <= $Aion::Type::SELF->{max} },
	);
	
	$Range->init;
	
	3 ~~ $Range  # -> 1
	4 ~~ $Range  # -> 1
	5 ~~ $Range  # -> 1
	
	2 ~~ $Range  # -> ""
	6 ~~ $Range  # -> ""

=head2 include ($element)

Checks whether the argument belongs to the class.

	my $PositiveInt = Aion::Type->new(
		name => "PositiveInt",
		test => sub { /^\d+$/ },
	);
	
	$PositiveInt->include(5) # -> 1
	$PositiveInt->include(-6) # -> ""

=head2 exclude ($element)

Checks that the argument does not belong to the class.

	my $PositiveInt = Aion::Type->new(
		name => "PositiveInt",
		test => sub { /^\d+$/ },
	);
	
	$PositiveInt->exclude(5)  # -> ""
	$PositiveInt->exclude(-6) # -> 1

=head2 coerce ($value)

Cast C<$value> to type if the cast from type and function is in C<< $self-E<gt>{coerce} >>.

Corresponds to the C<< E<gt>E<gt> >> operator.

	my $Int = Aion::Type->new(name => "Int", test => sub { /^-?\d+\z/ });
	my $Num = Aion::Type->new(name => "Num", test => sub { /^-?\d+(\.\d+)?\z/ });
	my $Bool = Aion::Type->new(name => "Bool", test => sub { /^(1|0|)\z/ });
	
	push @{$Int->{coerce}}, [$Bool, sub { 0+$_ }];
	push @{$Int->{coerce}}, [$Num, sub { int($_+.5) }];
	
	$Int->coerce(5.5)	 # => 6
	$Int->coerce(undef)  # => 0
	$Int->coerce("abc")  # => abc

=head2 detail ($element, $feature)

Generates an error message.

	my $Int = Aion::Type->new(name => "Int");
	
	$Int->detail(-5, "Feature car") # => Feature car must have the type Int. The it is -5!
	
	my $Num = Aion::Type->new(name => "Num", message => sub {
		"Error: $_ is'nt $Aion::Type::SELF->{property}!"
	});
	
	$Num->detail("x", "car") # => Error: x is'nt car!

=head2 validate ($element, $feature)

Checks C<$element> and throws a C<detail> message if the element does not belong to the class.

	my $PositiveInt = Aion::Type->new(
		name => "PositiveInt",
		test => sub { /^\d+$/ },
	);
	
	eval {
		$PositiveInt->validate(-1, "Neg")
	};
	$@ # ~> Neg must have the type PositiveInt. The it is -1

=head2 val_to_str ($val)

Converts C<$val> to a string.

	Aion::Type->new->val_to_str([1,2,{x=>6}]) # => [1, 2, {x => 6}]

=head2 instanceof ($type)

Determines that a type is a subtype of another C<$type> by type name.

Doesn't work in C<|> and C<~>. Doesn't check arguments.

	my $Int = Aion::Type->new(name => "Int");
	my $PositiveInt = Aion::Type->new(name => "PositiveInt", as => $Int);
	
	$PositiveInt->instanceof('Int');          # -> 1
	$PositiveInt->instanceof('PositiveInt');  # -> 1
	$Int->instanceof('PositiveInt');          # -> ""
	
	my $MyEnum = Aion::Type->new(name => "MyEnum", args => [3, 5, 'car']);
	($MyEnum & $PositiveInt)->instanceof('Int'); # -> 1

=head2 is_set_theoretic

Checks that the type is set-theoretic (ie - the C<|>, C<&> or C<~> operator).

=head2 simplify

If the expression has no values, it will return C<~Any>, otherwise it will return the expression.

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


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

=head2 clone ()

Clone type.

	my $type = Aion::Type->new(name => 'New');
	my $type10 = $type->clone(args => [10]);
	$type->stringify # => New
	$type10->stringify # => New[10]

=head2 is_primitive ()

This is a primitive type, that is, one in whose hierarchy there are no set-theoretic operators.

	Aion::Types::Int->is_primitive  # -> 1
	Aion::Types::Like->is_primitive # -> ""

=head2 is_union ()

This is a union of types.

	Aion::Types::Int->is_union # -> ""
	(Aion::Types::Int | Aion::Types::Int)->is_union  # -> 1

=head2 is_intersection ()

This is the intersection of types.

	Aion::Types::Int->is_intersection # -> ""
	(Aion::Types::Int & Aion::Types::Int)->is_intersection  # -> 1

=head2 is_exclude ()

This is a type exception.

	Aion::Types::Any->is_exclude # -> ""
	(~Aion::Types::Any)->is_exclude # -> 1
	Aion::Types::None->is_exclude # -> 1
	~Aion::Types::Any eq Aion::Types::None # -> 1

=head2 is_enum ()

This is an enumeration.

	Aion::Types::Int->is_enum  # -> ""
	Aion::Types::Enum([1])->is_enum  # -> 1

=head2 is_range_type ()

This is an interval type.

	Aion::Types::Int->is_range_type  # -> ""
	Aion::Types::Len([10])->is_range_type  # -> 1

=head2 range_lbound ()

Lower limit of the interval.

	Aion::Types::Int->range_lbound  # -> undef
	Aion::Types::Len([10])->range_lbound  # -> 0
	Aion::Types::Range([0, 10])->range_lbound  # -> '-Inf'

=head2 is_range ()

This is an interval.

	Aion::Types::Int->is_range  # -> ""
	Aion::Types::Len([10])->is_range  # -> ""
	Aion::Types::Range([1, 10])->is_range  # -> 1

=head2 typed_sorted_args_key ()

Generates a key with sorted typed parameters.

	(Aion::Types::Int & Aion::Types::Num)->typed_sorted_args_key  # -> (Aion::Types::Num & Aion::Types::Int)->typed_sorted_args_key

=head2 sorted_args_key ()

Generates a key with sorted untyped parameters.

	Aion::Types::Enum([10, 20])->sorted_args_key # -> Aion::Types::Enum([20, 10])->sorted_args_key

=head2 key ()

A unique key from the type prototype and its parameters.

=head2 keyfn ($fn)

Sets/returns the key construction function for the type as a class.

	my $type = Aion::Type->new(name => 'New', args => [10, 20]);
	$type->keyfn($type->can('sorted_args_key'));
	
	my $type2 = Aion::Type->new(name => 'New', args => [20, 10], coerce => $type->{coerce});
	$type->key # -> $type2->key

=head2 asen ()

Returns the chain of ancestors.

	[Aion::Types::Num->asen]  # --> [Aion::Types::Any, Aion::Types::Item, Aion::Types::Defined, Aion::Types::Value, Aion::Types::Str]

=head2 ckey ()

Key for comparing types in <=> and cmp.

=head2 compare ($other)

Comparison for sorting. Used in the C<< E<lt>=E<gt> >> and C<cmp> operators.

=head2 is_descendant ($other, $is_strict)

A is a child of B. The prototype is compared, but if C<$is_strict> is specified, then the C<eq> operator is used.

	Aion::Types::Range([1, 10])->is_descendant(Aion::Types::Defined)  # -> 1
	Aion::Types::Range([1, 10])->is_descendant(Aion::Types::Value)    # -> ""

=head2 like ($other)



( run in 1.588 second using v1.01-cache-2.11-cpan-d80b1682f3f )