File Coverage

blib/lib/Specio/Constraint/Structurable.pm
Criterion Covered Total %
statement 52 55 94.5
branch 10 22 45.4
condition n/a
subroutine 15 15 100.0
pod 1 2 50.0
total 78 94 82.9


line stmt bran cond sub pod time code
1             package Specio::Constraint::Structurable;
2              
3 3     3   19 use strict;
  3         7  
  3         77  
4 3     3   12 use warnings;
  3         6  
  3         118  
5              
6             our $VERSION = '0.46';
7              
8 3     3   15 use Carp qw( confess );
  3         6  
  3         118  
9 3     3   17 use Role::Tiny::With;
  3         8  
  3         126  
10 3     3   25 use Scalar::Util qw( blessed );
  3         7  
  3         122  
11 3     3   16 use Specio::DeclaredAt;
  3         14  
  3         66  
12 3     3   14 use Specio::OO;
  3         5  
  3         136  
13 3     3   1150 use Specio::Constraint::Structured;
  3         8  
  3         109  
14 3     3   20 use Specio::TypeChecks qw( does_role isa_class );
  3         5  
  3         144  
15              
16 3     3   18 use Specio::Constraint::Role::Interface;
  3         6  
  3         1351  
17             with 'Specio::Constraint::Role::Interface';
18              
19             {
20             ## no critic (Subroutines::ProtectPrivateSubs)
21             my $role_attrs = Specio::Constraint::Role::Interface::_attrs();
22             ## use critic
23              
24             my $attrs = {
25             %{$role_attrs},
26             _parameterization_args_builder => {
27             isa => 'CodeRef',
28             init_arg => 'parameterization_args_builder',
29             required => 1,
30             },
31             _name_builder => {
32             isa => 'CodeRef',
33             init_arg => 'name_builder',
34             required => 1,
35             },
36             _structured_constraint_generator => {
37             isa => 'CodeRef',
38             init_arg => 'structured_constraint_generator',
39             predicate => '_has_structured_constraint_generator',
40             },
41             _structured_inline_generator => {
42             isa => 'CodeRef',
43             init_arg => 'structured_inline_generator',
44             predicate => '_has_structured_inline_generator',
45             },
46             };
47              
48             ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
49             sub _attrs {
50 15     15   28 return $attrs;
51             }
52             }
53              
54             sub BUILD {
55 9     9 0 192 my $self = shift;
56              
57 9 50       30 if ( $self->_has_constraint ) {
58 0 0       0 die
59             'A structurable constraint with a constraint parameter must also have a structured_constraint_generator'
60             unless $self->_has_structured_constraint_generator;
61             }
62              
63 9 50       55 if ( $self->_has_inline_generator ) {
64 9 50       50 die
65             'A structurable constraint with an inline_generator parameter must also have a structured_inline_generator'
66             unless $self->_has_structured_inline_generator;
67             }
68              
69 9         44 return;
70             }
71              
72             sub parameterize {
73 9     9 1 86 my $self = shift;
74 9         27 my %args = @_;
75              
76 9         20 my $declared_at = $args{declared_at};
77              
78 9 50       22 if ($declared_at) {
79 9 50       25 isa_class( $declared_at, 'Specio::DeclaredAt' )
80             or confess
81             q{The "declared_at" parameter passed to ->parameterize must be a Specio::DeclaredAt object};
82             }
83              
84             my %parameters
85 9         44 = $self->_parameterization_args_builder->( $self, $args{of} );
86              
87 9 50       29 $declared_at = Specio::DeclaredAt->new_from_caller(1)
88             unless defined $declared_at;
89              
90 9         70 my %new_p = (
91             parent => $self,
92             parameters => \%parameters,
93             declared_at => $declared_at,
94             name => $self->_name_builder->( $self, \%parameters ),
95             );
96              
97 9 50       46 if ( $self->_has_structured_constraint_generator ) {
98             $new_p{constraint}
99 0         0 = $self->_structured_constraint_generator->(%parameters);
100             }
101             else {
102 9         51 for my $p (
103             grep {
104 12 100       52 blessed($_)
105             && does_role('Specio::Constraint::Role::Interface')
106             } values %parameters
107             ) {
108              
109 0 0       0 confess
110             q{Any type objects passed to ->parameterize must be inlinable constraints if the structurable type has an inline_generator}
111             unless $p->can_be_inlined;
112             }
113              
114 9         29 my $ig = $self->_structured_inline_generator;
115             $new_p{inline_generator}
116 9     24   57 = sub { $ig->( shift, shift, %parameters, @_ ) };
  24         167  
117             }
118              
119 9         57 return Specio::Constraint::Structured->new(%new_p);
120             }
121              
122             ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
123             sub _name_or_anon {
124 26 50   26   115 return $_[1]->_has_name ? $_[1]->name : 'ANON';
125             }
126             ## use critic
127              
128             __PACKAGE__->_ooify;
129              
130             1;
131              
132             # ABSTRACT: A class which represents structurable constraints
133              
134             __END__
135              
136             =pod
137              
138             =encoding UTF-8
139              
140             =head1 NAME
141              
142             Specio::Constraint::Structurable - A class which represents structurable constraints
143              
144             =head1 VERSION
145              
146             version 0.46
147              
148             =head1 SYNOPSIS
149              
150             my $tuple = t('Tuple');
151              
152             my $tuple_of_str_int = $tuple->parameterize( of => [ t('Str'), t('Int') ] );
153              
154             =head1 DESCRIPTION
155              
156             This class implements the API for structurable types like C<Dict>, C<Map>< and
157             C<Tuple>.
158              
159             =for Pod::Coverage BUILD
160              
161             =head1 API
162              
163             This class implements the same API as L<Specio::Constraint::Simple>, with a few
164             additions.
165              
166             =head2 Specio::Constraint::Structurable->new(...)
167              
168             This class's constructor accepts two additional parameters:
169              
170             =over 4
171              
172             =item * parameterization_args_builder
173              
174             This is a subroutine that takes the values passed to C<of> and returns a hash
175             of named arguments. These arguments will then be passed into the
176             C<structured_constraint_generator> or C<structured_inline_generator>.
177              
178             This should also do argument checking to make sure that the argument passed
179             are valid. For example, the C<Tuple> type turns the arrayref passed to C<of>
180             into a hash, along the way checking that the caller did not do things like
181             interleave optional and required elements or mix optional and slurpy together
182             in the definition.
183              
184             This parameter is required.
185              
186             =item * name_builder
187              
188             This is a subroutine that is called to generate a name for the structured type
189             when it is created. This will be called as a method on the
190             C<Specio::Constraint::Structurable> object. It will be passed the hash of
191             arguments returned by the C<parameterization_args_builder>.
192              
193             This parameter is required.
194              
195             =item * structured_constraint_generator
196              
197             This is a subroutine that generates a new constraint subroutine when the type
198             is structured.
199              
200             It will be called as a method on the type and will be passed the hash of
201             arguments returned by the C<parameterization_args_builder>.
202              
203             This parameter is mutually exclusive with the C<structured_inline_generator>
204             parameter.
205              
206             This parameter or the C<structured_inline_generator> parameter is required.
207              
208             =item * structured_inline_generator
209              
210             This is a subroutine that generates a new inline generator subroutine when the
211             type is structured.
212              
213             It will be called as a method on the L<Specio::Constraint::Structured> object
214             when that object needs to generate an inline constraint. It will receive the
215             type parameter as the first argument and the variable name as a string as the
216             second.
217              
218             The remaining arguments will be the parameter hash returned by the
219             C<parameterization_args_builder>.
220              
221             This probably seems fairly confusing, so looking at the examples in the
222             L<Specio::Library::Structured::*> code may be helpful.
223              
224             This parameter is mutually exclusive with the
225             C<structured_constraint_generator> parameter.
226              
227             This parameter or the C<structured_constraint_generator> parameter is
228             required.
229              
230             =back
231              
232             =head2 $type->parameterize(...)
233              
234             This method takes two arguments. The C<of> argument should be an object which
235             does the L<Specio::Constraint::Role::Interface> role, and is required.
236              
237             The other argument, C<declared_at>, is optional. If it is not given, then a
238             new L<Specio::DeclaredAt> object is creating using a call stack depth of 1.
239              
240             This method returns a new L<Specio::Constraint::Structured> object.
241              
242             =head1 SUPPORT
243              
244             Bugs may be submitted at L<https://github.com/houseabsolute/Specio/issues>.
245              
246             I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
247              
248             =head1 SOURCE
249              
250             The source code repository for Specio can be found at L<https://github.com/houseabsolute/Specio>.
251              
252             =head1 AUTHOR
253              
254             Dave Rolsky <autarch@urth.org>
255              
256             =head1 COPYRIGHT AND LICENSE
257              
258             This software is Copyright (c) 2012 - 2020 by Dave Rolsky.
259              
260             This is free software, licensed under:
261              
262             The Artistic License 2.0 (GPL Compatible)
263              
264             The full text of the license can be found in the
265             F<LICENSE> file included with this distribution.
266              
267             =cut