view release on metacpan or  search on metacpan

lib/Salvation/TC/Utils.pm  view on Meta::CPAN

=head2 where( CodeRef $code )

=cut

sub where( & ) { ## no critic (ProhibitSubroutinePrototypes)

    my ( $code ) = @_;

    return ( validator => sub {

        my ( $type_name ) = @_;

        return sub {

            local $_ = $_[ 0 ];

            $code -> () || Salvation::TC::Exception::WrongType -> throw(
                type => $type_name, value => $_
            );
        };
    } );
}

=head2 subtype( Str $name, Salvation::TC::Meta::Type :$parent!, CodeRef :$validator! )

Объявляет новый тип, наследуемый от другого, уже существующего, типа.
Предполагаемое использование:

    subtype 'ChildTypeName',
        as 'ParentTypeName',
        where { check_value_and_return_true_or_false( $_ ) };

Блок кода, переданный во C<where>, будет содержать в C<$_> значение, которое
необходимо проверить на соответствие объявляемому типу, и должен вернуть
C<true> если значение подходит по тип, или C<false>, если значение не подходит.

Технически сначала будет выполнена проверка значения на соответствие
родительскому типу, и только если эта проверка прошла успешно - будет
выполнена проверка соответствия дочернему типу. Это гарантирует, что в C<$_>
у C<where> типа C<ChildTypeName> всегда будет находиться значение типа
C<ParentTypeName>.

=cut

sub subtype {

    my ( $name, %params ) = @_;

    die( "Type ${name} is already present" ) if( Salvation::TC -> get_type( $name ) );

    Salvation::TC -> setup_type( $name => (
        validator => $params{ 'validator' } -> ( $name ),
        parent => $params{ 'parent' },
    ) );
}

=head2 as( Str $type )

=cut

sub as( $ ) { ## no critic (ProhibitSubroutinePrototypes)

    my ( $type ) = @_;

    return ( parent => Salvation::TC -> get( $type ) );
}

=head2 enum( Str $name, ArrayRef[Str] $values )

Хэлпер для создания enum'ов значений типа C<Str>. Пример использования:

    enum 'RGB', [ 'red', 'green', 'blue' ];

=cut

sub enum {

    my ( $name, $values ) = @_;

    subtype $name,
        as 'Str',
        where {
            my $input = $_;

            foreach ( @$values ) {

                return true if( $_ eq $input );
            }

            return false;
        };
}

1;

__END__