File Coverage

blib/lib/Specio/Coercion.pm
Criterion Covered Total %
statement 46 46 100.0
branch 7 10 70.0
condition 7 9 77.7
subroutine 13 13 100.0
pod 4 5 80.0
total 77 83 92.7


line stmt bran cond sub pod time code
1             package Specio::Coercion;
2              
3 29     29   214 use strict;
  29         396  
  29         887  
4 29     29   156 use warnings;
  29         53  
  29         1105  
5              
6             our $VERSION = '0.47';
7              
8 29     29   5539 use Specio::OO;
  29         106  
  29         1557  
9              
10 29     29   5650 use Role::Tiny::With;
  29         3226  
  29         1329  
11              
12 29     29   5496 use Specio::Role::Inlinable;
  29         59  
  29         14302  
13             with 'Specio::Role::Inlinable';
14              
15             {
16             ## no critic (Subroutines::ProtectPrivateSubs)
17             my $role_attrs = Specio::Role::Inlinable::_attrs();
18             ## use critic
19              
20             my $attrs = {
21             %{$role_attrs},
22             from => {
23             does => 'Specio::Constraint::Role::Interface',
24             required => 1,
25             },
26             to => {
27             does => 'Specio::Constraint::Role::Interface',
28             required => 1,
29             weak_ref => 1,
30             },
31             _coercion => {
32             isa => 'CodeRef',
33             predicate => '_has_coercion',
34             init_arg => 'coercion',
35             },
36             _optimized_coercion => {
37             isa => 'CodeRef',
38             init_arg => undef,
39             lazy => 1,
40             builder => '_build_optimized_coercion',
41             },
42             };
43              
44             ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
45             sub _attrs {
46 59     59   120 return $attrs;
47             }
48             }
49              
50             sub BUILD {
51 19     19 0 347 my $self = shift;
52              
53 19 50 66     64 die
54             'A type coercion should have either a coercion or inline_generator parameter, not both'
55             if $self->_has_coercion && $self->_has_inline_generator;
56              
57 19 100 100     165 die
58             'A type coercion must have either a coercion or inline_generator parameter'
59             unless $self->_has_coercion || $self->_has_inline_generator;
60              
61 18         138 return;
62             }
63              
64             sub coerce {
65 11     11 1 25 my $self = shift;
66 11         17 my $value = shift;
67              
68 11         37 return $self->_optimized_coercion->($value);
69             }
70              
71             sub inline_coercion {
72 13     13 1 29 my $self = shift;
73              
74 13         48 return $self->_inline_generator->( $self, @_ );
75             }
76              
77             sub _build_optimized_coercion {
78 8     8   51 my $self = shift;
79              
80 8 100       22 if ( $self->_has_inline_generator ) {
81 1         11 return $self->_generated_inline_sub;
82             }
83             else {
84 7         48 return $self->_coercion;
85             }
86             }
87              
88             sub can_be_inlined {
89 25     25 1 44 my $self = shift;
90              
91 25   66     55 return $self->_has_inline_generator && $self->from->can_be_inlined;
92             }
93              
94             sub _build_description {
95 1     1   15 my $self = shift;
96              
97 1 50       4 my $from_name
98             = defined $self->from->name ? $self->from->name : 'anonymous type';
99 1 50       24 my $to_name
100             = defined $self->to->name ? $self->to->name : 'anonymous type';
101 1         17 my $desc = "coercion from $from_name to $to_name";
102              
103 1         7 $desc .= q{ } . $self->declared_at->description;
104              
105 1         4 return $desc;
106             }
107              
108             sub clone_with_new_to {
109 1     1 1 3 my $self = shift;
110 1         2 my $new_to = shift;
111              
112 1         4 my $from = $self->from;
113              
114 1         5 local $self->{from} = undef;
115 1         3 local $self->{to} = undef;
116              
117 1         3 my $clone = $self->clone;
118              
119 1         3 $clone->{from} = $from;
120 1         2 $clone->{to} = $new_to;
121              
122 1         5 return $clone;
123             }
124              
125             __PACKAGE__->_ooify;
126              
127             1;
128              
129             # ABSTRACT: A class representing a coercion from one type to another
130              
131             __END__
132              
133             =pod
134              
135             =encoding UTF-8
136              
137             =head1 NAME
138              
139             Specio::Coercion - A class representing a coercion from one type to another
140              
141             =head1 VERSION
142              
143             version 0.47
144              
145             =head1 SYNOPSIS
146              
147             my $coercion = $type->coercion_from_type('Int');
148              
149             my $new_value = $coercion->coerce_value(42);
150              
151             if ( $coercion->can_be_inlined() ) {
152             my $code = $coercion->inline_coercion('$_[0]');
153             }
154              
155             =head1 DESCRIPTION
156              
157             This class represents a coercion from one type to another. Internally, a
158             coercion is a piece of code that takes a value of one type returns a new value
159             of a new type. For example, a coercion from c<Num> to C<Int> might round a
160             number to its nearest integer and return that integer.
161              
162             Coercions can be implemented either as a simple subroutine reference or as an
163             inline generator subroutine. Using an inline generator is faster but more
164             complicated.
165              
166             =for Pod::Coverage BUILD clone_with_new_to
167              
168             =head1 API
169              
170             This class provides the following methods.
171              
172             =head2 Specio::Coercion->new( ... )
173              
174             This method creates a new coercion object. It accepts the following named
175             parameters:
176              
177             =over 4
178              
179             =item * from => $type
180              
181             The type this coercion is from. The type must be an object which does the
182             L<Specio::Constraint::Role::Interface> interface.
183              
184             This parameter is required.
185              
186             =item * to => $type
187              
188             The type this coercion is to. The type must be an object which does the
189             L<Specio::Constraint::Role::Interface> interface.
190              
191             This parameter is required.
192              
193             =item * coercion => sub { ... }
194              
195             A subroutine reference implementing the coercion. It will be called as a method
196             on the object and passed a single argument, the value to coerce.
197              
198             It should return the new value.
199              
200             This parameter is mutually exclusive with C<inline_generator>.
201              
202             Either this parameter or the C<inline_generator> parameter is required.
203              
204             You can also pass this option with the key C<using> in the parameter list.
205              
206             =item * inline_generator => sub { ... }
207              
208             This should be a subroutine reference which returns a string containing a
209             single term. This code should I<not> end in a semicolon. This code should
210             implement the coercion.
211              
212             The generator will be called as a method on the coercion with a single
213             argument. That argument is the name of the variable being coerced, something
214             like C<'$_[0]'> or C<'$var'>.
215              
216             This parameter is mutually exclusive with C<coercion>.
217              
218             Either this parameter or the C<coercion> parameter is required.
219              
220             You can also pass this option with the key C<inline> in the parameter list.
221              
222             =item * inline_environment => {}
223              
224             This should be a hash reference of variable names (with sigils) and values for
225             that variable. The values should be I<references> to the values of the
226             variables.
227              
228             This environment will be used when compiling the coercion as part of a
229             subroutine. The named variables will be captured as closures in the generated
230             subroutine, using L<Eval::Closure>.
231              
232             It should be very rare to need to set this in the constructor. It's more likely
233             that a special coercion subclass would need to provide values that it generates
234             internally.
235              
236             This parameter defaults to an empty hash reference.
237              
238             =item * declared_at => $declared_at
239              
240             This parameter must be a L<Specio::DeclaredAt> object.
241              
242             This parameter is required.
243              
244             =back
245              
246             =head2 $coercion->from(), $coercion->to(), $coercion->declared_at()
247              
248             These methods are all read-only attribute accessors for the corresponding
249             attribute.
250              
251             =head2 $coercion->description
252              
253             This returns a string describing the coercion. This includes the names of the
254             to and from type and where the coercion was declared, so you end up with
255             something like C<'coercion from Foo to Bar declared in package My::Lib
256             (lib/My/Lib.pm) at line 42'>.
257              
258             =head2 $coercion->coerce($value)
259              
260             Given a value of the right "from" type, returns a new value of the "to" type.
261              
262             This method does not actually check that the types of given or return values.
263              
264             =head2 $coercion->inline_coercion($var)
265              
266             Given a variable name like C<'$_[0]'> this returns a string with code for the
267             coercion.
268              
269             Note that this method will die if the coercion does not have an inline
270             generator.
271              
272             =head2 $coercion->can_be_inlined()
273              
274             This returns true if the coercion has an inline generator I<and> the constraint
275             it is from can be inlined. This exists primarily for the benefit of the
276             C<inline_coercion_and_check()> method for type constraint object.
277              
278             =head2 $coercion->inline_environment()
279              
280             This returns a hash defining the variables that need to be closed over when
281             inlining the coercion. The keys are full variable names like C<'$foo'> or
282             C<'@bar'>. The values are I<references> to a variable of the matching type.
283              
284             =head2 $coercion->clone()
285              
286             Returns a clone of this object.
287              
288             =head2 $coercion->clone_with_new_to($new_to_type)
289              
290             This returns a clone of the coercion, replacing the "to" type with a new one.
291             This is intended for use when the to type itself is being cloned as part of
292             importing that type. We need to make sure the newly cloned coercion has the
293             newly cloned type as well.
294              
295             =head1 ROLES
296              
297             This class does the L<Specio::Role::Inlinable> role.
298              
299             =head1 SUPPORT
300              
301             Bugs may be submitted at L<https://github.com/houseabsolute/Specio/issues>.
302              
303             I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
304              
305             =head1 SOURCE
306              
307             The source code repository for Specio can be found at L<https://github.com/houseabsolute/Specio>.
308              
309             =head1 AUTHOR
310              
311             Dave Rolsky <autarch@urth.org>
312              
313             =head1 COPYRIGHT AND LICENSE
314              
315             This software is Copyright (c) 2012 - 2021 by Dave Rolsky.
316              
317             This is free software, licensed under:
318              
319             The Artistic License 2.0 (GPL Compatible)
320              
321             The full text of the license can be found in the
322             F<LICENSE> file included with this distribution.
323              
324             =cut