Aion

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    released under this License and any conditions added under section
    7.  This requirement modifies the requirement in section 4 to
    "keep intact all notices".

    c) You must license the entire work, as a whole, under this
    License to anyone who comes into possession of a copy.  This
    License will therefore apply, along with any applicable section 7
    additional terms, to the whole of the work, and all its parts,
    regardless of how they are packaged.  This License gives no
    permission to license the work in any other way, but it does not
    invalidate such permission if you have separately received it.

    d) If the work has interactive user interfaces, each must display
    Appropriate Legal Notices; however, if the Program has interactive
    interfaces that do not display Appropriate Legal Notices, your
    work need not make them do so.

  A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an

lib/Aion.pm  view on Meta::CPAN

}

# isa => Type
sub isa_aspect {
    my ($cls, $name, $isa, $construct, $feature) = @_;
    die "has: $name - isa maybe Aion::Type"
        if !UNIVERSAL::isa($isa, 'Aion::Type');

    $feature->{isa} = $isa;

    $construct->{get} = "\$Aion::META{'$cls'}{feature}{$name}{isa}->validate(do{$construct->{get}}, 'Get feature `$name`')" if ISA =~ /ro|rw/;

    $construct->{set} = "\$Aion::META{'$cls'}{feature}{$name}{isa}->validate(\$val, 'Set feature `$name`'); $construct->{set}" if ISA =~ /wo|rw/;
}

# coerce => 1
sub coerce_aspect {
    my ($cls, $name, $coerce, $construct, $feature) = @_;

	return unless $coerce;

	die "coerce: isa not present!" unless $feature->{isa};

lib/Aion.pm  view on Meta::CPAN

    my ($cls, $name, $default, $construct, $feature) = @_;

    if(ref $default eq "CODE") {
        $feature->{lazy} = 1;
        *{"${cls}::${name}__DEFAULT"} = $default;

		$construct->{lazy_trigger} //= "";
		$construct->{lazy} = "\$self->{$name} = \$self->${name}__DEFAULT%(lazy_trigger)s if !exists \$self->{$name}; ";
        $construct->{get} = "%(lazy)s$construct->{get}";
    } else {
        $feature->{opt}{isa}->validate($default, $name) if $feature->{opt}{isa};
        $feature->{default} = $default;
    }
}

sub _trigger_init {
	my ($self, $feature) = @_;
	my $name = "$feature->{name}__TRIGGER";
	$self->$name;
}

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

"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'
```

# DESCRIPTION

This is construct for make any validators.

It using in `Aion::Types::subtype`.

# METHODS

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

$Int->detail(-5, "Feature car") # => Feature car must have the type Int. The it is -5

my $Num = Aion::Type->new(name => "Num", detail => sub {
    my ($val, $name) = @_;
    "Error: $val is'nt $name!"
});

$Num->detail("x", "car")  # => Error: x is'nt car!
```

## validate ($element, $feature)

It tested `$element` and throw `detail` if element is exclude from class.

```perl
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
```

## val_to_str ($element)

Translate `$val` to string.

```perl
Aion::Type->val_to_str([1,2,{x=>6}])   # => [\n    [0] 1,\n    [1] 2,\n    [2] {\n            x   6\n        }\n]

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

}

# Сообщение об ошибке
sub detail {
	my ($self, $val, $name) = @_;
	$self->{detail}? $self->{detail}->($val, $name):
		"$name must have the type $self. The it is " . $self->val_to_str($val)
}

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

# Преобразовать значение в параметре и вернуть преобразованное
sub coerce {
	(my $self, local $_) = @_;
	for my $coerce (@{$self->{coerce}}) {
		return $coerce->[1]->() if $coerce->[0]->test;

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

	"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

This is construct for make any validators.

It using in C<Aion::Types::subtype>.

=head1 METHODS

=head2 new (%ARGUMENTS)

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

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

=head2 validate ($element, $feature)

It tested C<$element> and throw C<detail> if element is exclude from 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 ($element)

Translate C<$val> to string.

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

=head2 make ($pkg)

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

use Aion::Types;

BEGIN {
    subtype SpeakOfKitty => as StrMatch[qr/\bkitty\b/i],
        message { "Speak is'nt included kitty!" };
}

"Kitty!" ~~ SpeakOfKitty # -> 1
"abc" ~~ SpeakOfKitty 	 # -> ""

eval { SpeakOfKitty->validate("abc", "This") }; "$@" # ~> Speak is'nt included kitty!


BEGIN {
	subtype IntOrArrayRef => as (Int | ArrayRef);
}

[] ~~ IntOrArrayRef  # -> 1
35 ~~ IntOrArrayRef  # -> 1
"" ~~ IntOrArrayRef  # -> ""

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


Make new type.

```perl
BEGIN {
	subtype One => where { $_ == 1 } message { "Actual 1 only!" };
}

1 ~~ One 	# -> 1
0 ~~ One 	# -> ""
eval { One->validate(0) }; $@ # ~> Actual 1 only!
```

`where` and `message` is syntax sugar, and `subtype` can be used without them.

```perl
BEGIN {
	subtype Many => (where => sub { $_ > 1 });
}

2 ~~ Many  # -> 1

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


Use with `subtype` for extended create type of `$parenttype`.

## init_where ($code)

Initialize type with new arguments. Use with `subtype`.

```perl
BEGIN {
	subtype 'LessThen[A]',
		init_where { Num->validate(A, "Argument LessThen[A]") }
		where { $_ < A };
}

eval { LessThen["string"] }; $@  # ~> Argument LessThen\[A\]

5 ~~ LessThen[5]  # -> ""
```

## where ($code)

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


	my @signature = map { ref($_)? $_: $pkg->can($_)->() } @$data;

	my $ret = pop @signature;

    my ($ret_array, $ret_scalar) = exists $ret->{is_wantarray}? @{$ret->{args}}: (Tuple([$ret]), $ret);

    my $args = Tuple(\@signature);

    my $sub = sub {
        $args->validate(\@_, $args_of_meth);
        wantarray? do {
            my @returns = $referent->(@_);
            $ret_array->validate(\@returns, $returns_of_meth);
            @returns
        }: do {
            my $return = $referent->(@_);
            $ret_scalar->validate($return, $return_of_meth);
            $return
        }
    };

	set_prototype prototype($referent), $sub;
	set_subname subname($referent) . "__Isa", $sub;

	*$symbol = $sub
}

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

	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, B...]", 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;
		subtype "Bool", as &Item, where { ref $_ eq "" and /^(1|0|)\z/ };
		subtype "Enum[A...]", 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 $_ };

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

					where {
						my ($K, $V) = ARGS;
						while(my ($k, $v) = each %$_) {
							return "" unless $K->include($k) && $V->include($v);
						}
						return 1;
					};

				my $tuple_args = ArrayRef([Object(['Aion::Type'])]);
				subtype "Tuple[A...]", as &ArrayRef,
					init_where { $tuple_args->validate(scalar ARGS, "Arguments Tuple[A...]") }
					where {
						my $k = 0;
						for my $A (ARGS) {
							return "" if $A->exclude($_->[$k++]);
						}
						$k == @$_
					};
				subtype "CycleTuple[A...]", as &ArrayRef,
					init_where { $tuple_args->validate(scalar ARGS, "Arguments CycleTuple[A...]") }
					where {
						my $k = 0;
						while($k < @$_) {
							for my $A (ARGS) {
								return "" if $A->exclude($_->[$k++]);
							}
						}
						$k == @$_
					};
				my $dict_args = CycleTuple([&Str, Object(['Aion::Type'])]);
				subtype "Dict[k => A, ...]", as &HashRef,
					init_where { $dict_args->validate(scalar ARGS, "Arguments Dict[k => A, ...]") }
					where {
						my $count = 0; my $k;
						for my $A (ARGS) {
							$k = $A, next unless ref $A;
							if(exists $_->{$k}) {
								return "" if $A->exclude($_->{$k});
								$count++;
							} else {
								return "" if !exists $A->{is_option};
							}

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

	use Aion::Types;
	
	BEGIN {
	    subtype SpeakOfKitty => as StrMatch[qr/\bkitty\b/i],
	        message { "Speak is'nt included kitty!" };
	}
	
	"Kitty!" ~~ SpeakOfKitty # -> 1
	"abc" ~~ SpeakOfKitty 	 # -> ""
	
	eval { SpeakOfKitty->validate("abc", "This") }; "$@" # ~> Speak is'nt included kitty!
	
	
	BEGIN {
		subtype IntOrArrayRef => as (Int | ArrayRef);
	}
	
	[] ~~ IntOrArrayRef  # -> 1
	35 ~~ IntOrArrayRef  # -> 1
	"" ~~ IntOrArrayRef  # -> ""
	

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

=head2 subtype ($name, @paraphernalia)

Make new type.

	BEGIN {
		subtype One => where { $_ == 1 } message { "Actual 1 only!" };
	}
	
	1 ~~ One 	# -> 1
	0 ~~ One 	# -> ""
	eval { One->validate(0) }; $@ # ~> Actual 1 only!

C<where> and C<message> is syntax sugar, and C<subtype> can be used without them.

	BEGIN {
		subtype Many => (where => sub { $_ > 1 });
	}
	
	2 ~~ Many  # -> 1
	
	eval { subtype Many => (where1 => sub { $_ > 1 }) }; $@ # ~> subtype Many unused keys left: where1

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

=head2 as ($parenttype)

Use with C<subtype> for extended create type of C<$parenttype>.

=head2 init_where ($code)

Initialize type with new arguments. Use with C<subtype>.

	BEGIN {
		subtype 'LessThen[A]',
			init_where { Num->validate(A, "Argument LessThen[A]") }
			where { $_ < A };
	}
	
	eval { LessThen["string"] }; $@  # ~> Argument LessThen\[A\]
	
	5 ~~ LessThen[5]  # -> ""

=head2 where ($code)

Set in type C<$code> as test. Value for test set in C<$_>.

t/aion/type.t  view on Meta::CPAN

::is scalar do {"a"  ~~ $IntOrChar}, "1", '"a"  ~~ $IntOrChar # => 1';
::is scalar do {"ab" ~~ $IntOrChar}, scalar do{""}, '"ab" ~~ $IntOrChar # -> ""';

my $Digit = $Int & $Char;
::is scalar do {7  ~~ $Digit}, "1", '7  ~~ $Digit # => 1';
::is scalar do {77 ~~ $Digit}, scalar do{""}, '77 ~~ $Digit # -> ""';

::is scalar do {"a" ~~ ~$Int;}, "1", '"a" ~~ ~$Int; # => 1';
::is scalar do {5   ~~ ~$Int;}, scalar do{""}, '5   ~~ ~$Int; # -> ""';

::like scalar do {eval { $Int->validate("a", "..Eval..") }; $@}, qr!..Eval.. must have the type Int. The it is 'a'!, 'eval { $Int->validate("a", "..Eval..") }; $@    # ~> ..Eval.. must have the type Int. The it is \'a\'';

# 
# # DESCRIPTION
# 
# This is construct for make any validators.
# 
# It using in `Aion::Types::subtype`.
# 
# # METHODS
# 

t/aion/type.t  view on Meta::CPAN

::is scalar do {$Int->detail(-5, "Feature car")}, "Feature car must have the type Int. The it is -5", '$Int->detail(-5, "Feature car") # => Feature car must have the type Int. The it is -5';

my $Num = Aion::Type->new(name => "Num", detail => sub {
    my ($val, $name) = @_;
    "Error: $val is'nt $name!"
});

::is scalar do {$Num->detail("x", "car")}, "Error: x is'nt car!", '$Num->detail("x", "car")  # => Error: x is\'nt car!';

# 
# ## validate ($element, $feature)
# 
# It tested `$element` and throw `detail` if element is exclude from class.
# 
done_testing; }; subtest 'validate ($element, $feature)' => sub { 
my $PositiveInt = Aion::Type->new(
    name => "PositiveInt",
    test => sub { /^\d+$/ },
);

eval {
    $PositiveInt->validate(-1, "Neg")
};
::like scalar do {$@}, qr!Neg must have the type PositiveInt. The it is -1!, '$@   # ~> Neg must have the type PositiveInt. The it is -1';

# 
# ## val_to_str ($element)
# 
# Translate `$val` to string.
# 
done_testing; }; subtest 'val_to_str ($element)' => sub { 
::is scalar do {Aion::Type->val_to_str([1,2,{x=>6}])}, "[\n    [0] 1,\n    [1] 2,\n    [2] {\n            x   6\n        }\n]", 'Aion::Type->val_to_str([1,2,{x=>6}])   # => [\n    [0] 1,\n    [1] 2,\n    [2] {\n            x   6\n        }\n]';

t/aion/types.t  view on Meta::CPAN

use Aion::Types;

BEGIN {
    subtype SpeakOfKitty => as StrMatch[qr/\bkitty\b/i],
        message { "Speak is'nt included kitty!" };
}

::is scalar do {"Kitty!" ~~ SpeakOfKitty}, scalar do{1}, '"Kitty!" ~~ SpeakOfKitty # -> 1';
::is scalar do {"abc" ~~ SpeakOfKitty}, scalar do{""}, '"abc" ~~ SpeakOfKitty 	 # -> ""';

::like scalar do {eval { SpeakOfKitty->validate("abc", "This") }; "$@"}, qr!Speak is'nt included kitty\!!, 'eval { SpeakOfKitty->validate("abc", "This") }; "$@" # ~> Speak is\'nt included kitty!';


BEGIN {
	subtype IntOrArrayRef => as (Int | ArrayRef);
}

::is scalar do {[] ~~ IntOrArrayRef}, scalar do{1}, '[] ~~ IntOrArrayRef  # -> 1';
::is scalar do {35 ~~ IntOrArrayRef}, scalar do{1}, '35 ~~ IntOrArrayRef  # -> 1';
::is scalar do {"" ~~ IntOrArrayRef}, scalar do{""}, '"" ~~ IntOrArrayRef  # -> ""';

t/aion/types.t  view on Meta::CPAN

# 
# Make new type.
# 
done_testing; }; subtest 'subtype ($name, @paraphernalia)' => sub { 
BEGIN {
	subtype One => where { $_ == 1 } message { "Actual 1 only!" };
}

::is scalar do {1 ~~ One}, scalar do{1}, '1 ~~ One 	# -> 1';
::is scalar do {0 ~~ One}, scalar do{""}, '0 ~~ One 	# -> ""';
::like scalar do {eval { One->validate(0) }; $@}, qr!Actual 1 only\!!, 'eval { One->validate(0) }; $@ # ~> Actual 1 only!';

# 
# `where` and `message` is syntax sugar, and `subtype` can be used without them.
# 

BEGIN {
	subtype Many => (where => sub { $_ > 1 });
}

::is scalar do {2 ~~ Many}, scalar do{1}, '2 ~~ Many  # -> 1';

t/aion/types.t  view on Meta::CPAN

# 
# Use with `subtype` for extended create type of `$parenttype`.
# 
# ## init_where ($code)
# 
# Initialize type with new arguments. Use with `subtype`.
# 
done_testing; }; subtest 'init_where ($code)' => sub { 
BEGIN {
	subtype 'LessThen[A]',
		init_where { Num->validate(A, "Argument LessThen[A]") }
		where { $_ < A };
}

::like scalar do {eval { LessThen["string"] }; $@}, qr!Argument LessThen\[A\]!, 'eval { LessThen["string"] }; $@  # ~> Argument LessThen\[A\]';

::is scalar do {5 ~~ LessThen[5]}, scalar do{""}, '5 ~~ LessThen[5]  # -> ""';

# 
# ## where ($code)
# 



( run in 0.558 second using v1.01-cache-2.11-cpan-4d50c553e7e )