Aion

 view release on metacpan or  search on metacpan

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

		}!"
}

# Преобразовать значение в строку
sub val_to_str {
	my ($self, $val) = @_;
	Aion::Meta::Util::val_to_str($val)
}

#@category test

# Строит кеш для вызова только для примитивного типа
sub _build_as_test_cache {
	my ($self) = @_;

	my @as;
	for(my $i = $self->{as}; $i; $i = $i->{as}) {
		return "" if $i->is_set_theoretic;
		unshift @as, $i if $i->{test} != \&true;
	}
	
	\@as;
}

# Это - примитивный тип, то есть тот, в иерархии которого нет множественно-теоритических операторов
sub is_primitive {
	my ($self) = @_;
	!!($self->{as_test_cache} //= $self->_build_as_test_cache);
}

# Тестировать значение в $_
sub test {
	my ($self) = @_;

	if($self->{as_test_cache} //= $self->_build_as_test_cache) {
		local $Aion::Type::SELF;
		for $Aion::Type::SELF (@{$self->{as_test_cache}}) {
			return "" unless $Aion::Type::SELF->{test}->();
		}
	} else {
		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)

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


	my $var = "\$$self->{name}";
	my $hash = "%$self->{name}";
	my $init = $self->{init}? '->init': '';

	my $code = "package $pkg;

	my $var = \$self;
	my $hash = %\$self;

	sub $self->{name} (;\$) {
		\@_==0? $var:
		Aion::Type->new(
			$hash,
			args => \$_[0],
			test => ${var}->{a_test},
		)$init
	}
";
	eval $code or die;
	
	$self
}


1;

__END__

=encoding utf-8

=head1 NAME

Aion::Type - class of validators

=head1 SYNOPSIS

	use Aion::Type;
	use Aion::Types qw//;
	
	my $Int = Aion::Type->new(name => "Int", test => sub { /^-?\d+$/ });
	12   ~~ $Int # => 1
	12.1 ~~ $Int # -> ""
	
	my $Char = Aion::Type->new(name => "Char", test => sub { /^.\z/ });
	$Char->include("a")	 # => 1
	$Char->exclude("ab") # => 1
	
	my $IntOrChar = $Int | $Char;
	77   ~~ $IntOrChar # => 1
	"a"  ~~ $IntOrChar # => 1
	"ab" ~~ $IntOrChar # -> ""
	
	my $Digit = $Int & $Char;
	7  ~~ $Digit # => 1
	77 ~~ $Digit # -> ""
	
	"a" ~~ ~$Int; # => 1
	5   ~~ ~$Int; # -> ""
	
	eval { $Int->validate("a", "..Eval..") }; $@ # ~> ..Eval.. must have the type Int. The it is 'a'

=head1 DESCRIPTION

Spawns validators. Used in C<Aion::Types::subtype>.

=head1 METHODS

=head2 new (%ARGUMENTS)

Constructor.

=head3 ARGUMENTS

=over

=item * name (Str) — Type name.

=item * args (ArrayRef) — List of type arguments.

=item * init (CodeRef) — Type initializer.

=item * test (CodeRef) - Checker.

=item * a_test (CodeRef) — Value checker for types with optional arguments.

=item * coerce (ArrayRef[Tuple[Aion::Type, CodeRef]]) - Array of pairs: type and transition.

=back

=head2 stringify

String conversion of object (name with arguments):

	my $Char = Aion::Type->new(name => "Char");
	
	$Char->stringify # => Char
	
	my $Int = Aion::Type->new(
		name => "Int",
		args => [3, 5],
	);
	
	$Int->stringify  #=> Int[3, 5]

Operations are also converted to a string:

	($Int & $Char)->stringify   # => ( Int[3, 5] & Char )
	($Int | $Char)->stringify   # => ( Int[3, 5] | Char )
	(~$Int)->stringify		  # => ~Int[3, 5]

Operations are C<Aion::Type> objects with special names:

	Aion::Type->new(name => "Exclude", args => [$Char])->stringify   # => ~Char
	Aion::Type->new(name => "Union", args => [$Int, $Char])->stringify   # => ( Int[3, 5] | Char )
	Aion::Type->new(name => "Intersection", args => [$Int, $Char])->stringify   # => ( Int[3, 5] & Char )

=head2 test

Tests that C<$_> belongs to a class.

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

	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.

Simplification of the expression in this function may appear in the future.

	package Aion::Types;
	
	my $type = (Enum[1,2] | Enum[2,3]) & Enum[2,3,4];
	
	$type->simplify->stringify # => ( ( Enum[1, 2] | Enum[2, 3] ) & Enum[2, 3, 4] )
	
	my $range = Range[-10,0] & Range[4,8];
	$range->simplify->stringify # => ~Any

=head2 Any

A constant for a type that includes all values.

	package Aion::Type;
	
	42 ~~ Any   # -> 1
	42 ~~ None  # -> ""
	
	Any <= Any   # -> 1
	None <= Any  # -> 1
	Any <= None  # -> ""

=head2 None

Constant for an empty type that does not contain anything.



( run in 0.655 second using v1.01-cache-2.11-cpan-d01c6094234 )