Aion
9 results

 view release on metacpan or  search on metacpan

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

package Aion::Type;
# Базовый класс для типов и преобразователей
use common::sense;

use Aion::Meta::Util qw//;
use Scalar::Util qw/looks_like_number/;

use overload
	"fallback" => 1,
	"&{}" => sub {
		my ($self) = @_;
		sub { $self->test }
	},	# Чтобы тип мог быть выполнен, как функция
	'""' => "stringify",									# Отображать тип в трейсбеке в строковом представлении
	"|" => sub {
		my ($type1, $type2) = @_;
		__PACKAGE__->new(name => "Union", args => [$type1, $type2], test => sub { $type1->test || $type2->test });
	},
	"&" => sub {
		my ($type1, $type2) = @_;
		__PACKAGE__->new(name => "Intersection", args => [$type1, $type2], test => sub { $type1->test && $type2->test });
	},
	"~" => sub {
		my ($type1) = @_;
		__PACKAGE__->new(name => "Exclude", args => [$type1], test => sub { !$type1->test });
	},
	"~~" => "include",
	"eq" => "equal",
	"ne" => "nonequal",
	">>" => "coerce",
;

Aion::Meta::Util::create_getters(qw/name args as me/);
Aion::Meta::Util::create_accessors(qw/message/);

$Aion::Type::SELF = {
	A => __PACKAGE__->new(name => "Argument_A"),
	B => __PACKAGE__->new(name => "Argument_B"),
	C => __PACKAGE__->new(name => "Argument_C"),
	D => __PACKAGE__->new(name => "Argument_D"),
	N => __PACKAGE__->new(name => "Argument_N"),
	M => __PACKAGE__->new(name => "Argument_M"),
};

# конструктор
# * name (Str) — Имя типа.
# * as (Object[Aion::Type]) — наследуемый тип.
# * args (ArrayRef) — Список аргументов.
# * init (CodeRef) — Инициализатор типа.
# * test (CodeRef) — Чекер.
# * a_test (CodeRef) — Используется для проверки типа с аргументами, если аргументы не указаны, то используется test.
# * coerce (ArrayRef) — Массив преобразователей в этот тип: [Type => sub {}].
# * message (CodeRef) — Сообщение об ошибке.
# * title (Str) — Заголовок.
# * description (Str) — Описание.
# * example (Any) — Пример.
# * me (Str) — Только для типа Me: пакет в котором он был объявлен.
sub new {
	my $cls = shift;
	bless {@_}, $cls;
}

# Строковое представление
sub stringify {
	my ($self) = @_;

	my @args = map {
		UNIVERSAL::isa($_, __PACKAGE__)?
			$_->stringify:
			Aion::Meta::Util::val_to_str($_)
	} @{$self->{args}};

	$self->{name} eq "Union"? join "", "( ", join(" | ", @args), " )":
	$self->{name} eq "Intersection"? join "", "( ", join(" & ", @args), " )":
	$self->{name} eq "Exclude"? (
		@args == 1? join "", "~", @args:
			join "", "~( ", join(" | ", @args), " )"
	):
	join("", $self->{name}, @args? ("[", join(", ", @args), "]") : ());
}

sub equal {
	my ($self, $type) = @_;

	return 1 if Scalar::Util::refaddr $self == Scalar::Util::refaddr $type;
	return "" unless UNIVERSAL::isa($type, __PACKAGE__);	
	return "" unless $self->{name} eq $type->{name};
	return "" unless @{$self->{args}} == @{$type->{args}};
	return "" unless $self->{as} && $self->{as}->equal($type->{as})
		|| !$self->{as} && !$type->{as};

	my $i = 0;
	for my $arg (@{$self->{args}}) {
		return "" unless $arg eq $type->{args}[$i++];
	}

	return 1;
}

sub nonequal {
	my ($self, $type) = @_;
	!$self->equal($type)
}

# Тестировать значение в $_
sub test {
	my ($self) = @_;
	local $Aion::Type::SELF = $self;
	my $ok = $self->{test}->();
	$ok
}

# Инициализировать тип
sub init {
	my ($self) = @_;
	local $Aion::Type::SELF = $self;
	$self->{init}->();
	$self
}

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

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

# Сообщение об ошибке
sub detail {

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

	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 => [$Int, $Char])->stringify   # => ~( Int[3, 5] | 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.

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

=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

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

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).

=head1 OPERATORS

=head2 &{}

Tests C<$_>.

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

=head2 ""

Strings an object.

	Aion::Type->new(name => "Int") . ""   # => Int
	
	my $Enum = Aion::Type->new(name => "Enum", args => [qw/A B C/]);
	
	"$Enum" # => Enum['A', 'B', 'C']

=head2 |

Or. Creates a new type as a union of two.

	my $Int = Aion::Type->new(name => "Int", test => sub { /^-?\d+$/ });
	my $Char = Aion::Type->new(name => "Char", test => sub { /^.\z/ });
	
	my $IntOrChar = $Int | $Char;
	
	77   ~~ $IntOrChar # -> 1
	"a"  ~~ $IntOrChar # -> 1
	"ab" ~~ $IntOrChar # -> ""

=head2 &

I. Creates a new type as the intersection of two.

	my $Int = Aion::Type->new(name => "Int", test => sub { /^-?\d+$/ });
	my $Char = Aion::Type->new(name => "Char", test => sub { /^.\z/ });
	
	my $Digit = $Int & $Char;
	
	7  ~~ $Digit # -> 1
	77 ~~ $Digit # -> ""
	"a" ~~ $Digit # -> ""

=head2 ~

Not. Creates a new type as an exception to the given one.

	my $Int = Aion::Type->new(name => "Int", test => sub { /^-?\d+$/ });
	
	"a" ~~ ~$Int; # -> 1
	5   ~~ ~$Int; # -> ""

=head2 ~~

Tests the value.

	my $Int = Aion::Type->new(name => "Int", test => sub { /^-?\d+$/ });
	
	$Int ~~ 3    # -> 1
	-6   ~~ $Int # -> 1

=head2 eq, ==

Compares two types.

	my $Int1 = Aion::Type->new(name => "Int");
	my $Int2 = Aion::Type->new(name => "Int");
	
	$Int1 eq $Int2 # -> 1
	$Int1 == $Int2 # -> 1

=head2 ne, !=

Checks that the types are not equal.

	my $Int1 = Aion::Type->new(name => "Int");
	my $Int2 = Aion::Type->new(name => "Int");
	
	$Int1 ne $Int2 # -> ""
	$Int1 != $Int2 # -> ""
	123   ne $Int2 # -> 1

=head2 >>

Casting to type.

	my $Int = Aion::Type->new(name => "Int", test => sub { /^-?\d+$/ });
	$Int->{coerce} = [[$Int => sub { $_ + 5 }]];
	
	5 >> $Int # -> 10
	
	$Int >> -4 # -> 1



( run in 1.111 second using v1.01-cache-2.11-cpan-39bf76dae61 )