File Coverage

blib/lib/Salvation/TC/Utils.pm
Criterion Covered Total %
statement 45 45 100.0
branch 6 8 75.0
condition n/a
subroutine 16 16 100.0
pod 8 8 100.0
total 75 77 97.4


line stmt bran cond sub pod time code
1             package Salvation::TC::Utils;
2              
3             =head1 NAME
4              
5             Salvation::TC::Utils - Дополнительные публичные функции L
6              
7             =head1 SYNOPSIS
8              
9             use Salvation::TC::Utils;
10              
11             subtype 'CustomString',
12             as 'Str',
13             where { $_ eq 'asd' };
14              
15             subtype 'ArrayRefOfCustomStrings',
16             as 'ArrayRef[CustomString]',
17             where {};
18              
19             coerce 'ArrayRefOfCustomStrings',
20             from 'CustomString',
21             via { [ $_ ] };
22              
23             type 'CustomTopLevelType',
24             where { ( ref( $_ ) eq 'HASH' ) && exists $_ -> { 'asd' } };
25              
26             enum 'RGB', [ 'red', 'green', 'blue' ];
27              
28             no Salvation::TC::Utils;
29              
30             Salvation::TC -> is( 'asd', 'CustomString' ); # true
31             Salvation::TC -> is( 'qwe', 'CustomString' ); # false
32              
33             Salvation::TC -> is( 'green', 'RGB' ); # true
34             Salvation::TC -> is( 'white', 'RGB' ); # false
35              
36             Salvation::TC -> coerce( 'asd', 'ArrayRefOfCustomStrings' ); # [ 'asd' ]
37             Salvation::TC -> coerce( 'qwe', 'ArrayRefOfCustomStrings' ); # 'qwe'
38              
39             Salvation::TC -> ensure( 'asd', 'ArrayRefOfCustomStrings' ); # [ 'asd' ]
40             Salvation::TC -> ensure( 'qwe', 'ArrayRefOfCustomStrings' ); # BOOM
41              
42             Salvation::TC -> assert( { asd => 123 }, 'CustomTopLevelType' ); # true
43             Salvation::TC -> assert( { qwe => 123 }, 'CustomTopLevelType' ); # BOOM
44              
45             =head1 SEE ALSO
46              
47             L
48              
49             =cut
50              
51 2     2   7602 use strict;
  2         4  
  2         65  
52 2     2   8 use warnings;
  2         3  
  2         53  
53 2     2   8 use boolean;
  2         2  
  2         13  
54              
55 2     2   109 use Salvation::TC ();
  2         2  
  2         20  
56 2     2   7 use Salvation::TC::Exception::WrongType ();
  2         6  
  2         28  
57 2     2   1076 use List::MoreUtils 'uniq';
  2         17417  
  2         13  
58              
59             require Exporter;
60              
61             our @ISA = ( 'Exporter' );
62              
63             our %EXPORT_TAGS = (
64             coerce => [
65             'coerce',
66             'from',
67             'via',
68             ],
69             type => [
70             'type',
71             'where',
72             ],
73             subtype => [
74             'subtype',
75             'as',
76             'where',
77             ],
78             enum => [
79             'enum',
80             ],
81             );
82              
83             our @EXPORT = uniq( map( { @$_ } values( %EXPORT_TAGS ) ) );
84              
85             our @EXPORT_OK = @EXPORT;
86              
87             $EXPORT_TAGS{ 'all' } = \@EXPORT_OK;
88              
89             =head1 METHODS
90              
91             =cut
92              
93             =head2 coerce( Str $to, Salvation::TC::Meta::Type :$from!, CodeRef :$how! )
94              
95             Объявляет новое правило приведения типа. Предполагаемое использование:
96              
97             coerce 'DestTypeName',
98             from 'SourceTypeName',
99             via { do_something_with( $_ ) };
100              
101             Блок кода, переданный в C, будет содержать в C<$_> значение типа
102             C, и должен вернуть значение типа C.
103              
104             Каждое правило приведения - глобальное, и доступно по всему коду сразу после
105             определения правила.
106              
107             При попытке привести значение к типу будет выбрано первое подходящее правило
108             приведения. Например, если объявлено два правила:
109              
110             coerce 'Something',
111             from 'Str',
112             via { ... };
113              
114             coerce 'Something',
115             from 'Int',
116             via { ... };
117              
118             , и происходит попытка привести к типу C значение типа C, то
119             с указанными выше правилами будет выполнено приведение по правилу для типа C,
120             так как значение типа C подходит и к типу C. Если поменять правила
121             местами, вот так:
122              
123             coerce 'Something',
124             from 'Int',
125             via { ... };
126              
127             coerce 'Something',
128             from 'Str',
129             via { ... };
130              
131             , то поведение будет более ожидаемым: при попытке привести к типу C
132             значение типа C будет выполнено приведение именно по правилу для типа C:
133             это правило встречается раньше, чем правило приведения для типа C,
134             и приводимое значение подходит под требуемый правилом тип.
135              
136             Объявление правил приведения одних стандартных типов к другим стандартным типам
137             напрямую крайне не рекомендуется. Best practice для подобных случаев:
138              
139             subtype 'MyCustomArrayOfStrings',
140             as 'ArrayRef[Str]',
141             where {}; # не проводить дополнительных проверок
142              
143             coerce 'MyCustomArrayOfStrings',
144             from 'Str',
145             via { [ $_ ] };
146              
147             =cut
148              
149             sub coerce {
150              
151 5     5 1 15 my ( $to, %params ) = @_;
152              
153 5         11 Salvation::TC -> get( $to ) -> add_coercion( @params{ 'from', 'how' } );
154              
155 5         17 return;
156             }
157              
158             =head2 from( Str $type )
159              
160             =cut
161              
162             sub from( $ ) { ## no critic (ProhibitSubroutinePrototypes)
163              
164 5     5 1 6 my ( $type ) = @_;
165              
166 5         10 return ( from => Salvation::TC -> get( $type ) );
167             }
168              
169             =head2 via( CodeRef $code )
170              
171             =cut
172              
173             sub via( & ) { ## no critic (ProhibitSubroutinePrototypes)
174              
175 5     5 1 6 my ( $code ) = @_;
176              
177 5         12 return ( how => $code );
178             }
179              
180             =head2 type( Str $name, CodeRef :$validator! )
181              
182             Объявляет новый тип верхнего уровня (без родительского типа). Предполагаемое
183             использование:
184              
185             type 'NewTypeName',
186             where { check_value_and_return_true_or_false( $_ ) };
187              
188             Блок кода, переданный во C, будет содержать в C<$_> значение, которое
189             необходимо проверить на соответствие объявляемому типу, и должен вернуть
190             C если значение подходит по тип, или C, если значение не подходит.
191              
192             Имея в распоряжении стандартные типы системы типов L
193             (L), вместо C всегда достаточно использовать
194             C, что сохранит отношения между типами и не потребует дублирования
195             кода самой проверки.
196              
197             =cut
198              
199             sub type {
200              
201 1     1 1 3 my ( $name, %params ) = @_;
202              
203 1 50       3 die( "Type ${name} is already present" ) if( Salvation::TC -> get_type( $name ) );
204              
205 1         4 Salvation::TC -> setup_type( $name, validator => $params{ 'validator' } -> ( $name ) );
206             }
207              
208             =head2 where( CodeRef $code )
209              
210             =cut
211              
212             sub where( & ) { ## no critic (ProhibitSubroutinePrototypes)
213              
214 10     10 1 11 my ( $code ) = @_;
215              
216             return ( validator => sub {
217              
218 10     10   9 my ( $type_name ) = @_;
219              
220             return sub {
221              
222 26         29 local $_ = $_[ 0 ];
223              
224 26 100       43 $code -> () || Salvation::TC::Exception::WrongType -> throw(
225             type => $type_name, value => $_
226             );
227 10         48 };
228 10         41 } );
229             }
230              
231             =head2 subtype( Str $name, Salvation::TC::Meta::Type :$parent!, CodeRef :$validator! )
232              
233             Объявляет новый тип, наследуемый от другого, уже существующего, типа.
234             Предполагаемое использование:
235              
236             subtype 'ChildTypeName',
237             as 'ParentTypeName',
238             where { check_value_and_return_true_or_false( $_ ) };
239              
240             Блок кода, переданный во C, будет содержать в C<$_> значение, которое
241             необходимо проверить на соответствие объявляемому типу, и должен вернуть
242             C если значение подходит по тип, или C, если значение не подходит.
243              
244             Технически сначала будет выполнена проверка значения на соответствие
245             родительскому типу, и только если эта проверка прошла успешно - будет
246             выполнена проверка соответствия дочернему типу. Это гарантирует, что в C<$_>
247             у C типа C всегда будет находиться значение типа
248             C.
249              
250             =cut
251              
252             sub subtype {
253              
254 9     9 1 13 my ( $name, %params ) = @_;
255              
256 9 50       23 die( "Type ${name} is already present" ) if( Salvation::TC -> get_type( $name ) );
257              
258 9         20 Salvation::TC -> setup_type( $name => (
259             validator => $params{ 'validator' } -> ( $name ),
260             parent => $params{ 'parent' },
261             ) );
262             }
263              
264             =head2 as( Str $type )
265              
266             =cut
267              
268             sub as( $ ) { ## no critic (ProhibitSubroutinePrototypes)
269              
270 9     9 1 28 my ( $type ) = @_;
271              
272 9         31 return ( parent => Salvation::TC -> get( $type ) );
273             }
274              
275             =head2 enum( Str $name, ArrayRef[Str] $values )
276              
277             Хэлпер для создания enum'ов значений типа C. Пример использования:
278              
279             enum 'RGB', [ 'red', 'green', 'blue' ];
280              
281             =cut
282              
283             sub enum {
284              
285 1     1 1 19 my ( $name, $values ) = @_;
286              
287             subtype $name,
288             as 'Str',
289             where {
290 6     6   7 my $input = $_;
291              
292 6         9 foreach ( @$values ) {
293              
294 13 100       30 return true if( $_ eq $input );
295             }
296              
297 2         5 return false;
298 1         4 };
299             }
300              
301             1;
302              
303             __END__