File Coverage

blib/lib/Sub/Meta/Type.pm
Criterion Covered Total %
statement 66 66 100.0
branch 20 20 100.0
condition n/a
subroutine 21 21 100.0
pod 9 9 100.0
total 116 116 100.0


line stmt bran cond sub pod time code
1             package Sub::Meta::Type;
2 5     5   1529 use 5.010;
  5         14  
3 5     5   22 use strict;
  5         10  
  5         84  
4 5     5   20 use warnings;
  5         9  
  5         127  
5              
6 5     5   1126 use parent qw(Type::Tiny);
  5         707  
  5         22  
7              
8 5     5   58498 use Type::Coercion;
  5         15365  
  5         153  
9 5     5   1375 use Types::Standard qw(Ref InstanceOf);
  5         165103  
  5         43  
10              
11 26     26 1 149 sub submeta { my $self = shift; return $self->{submeta} }
  26         90  
12 10     10 1 15 sub submeta_strict_check { my $self = shift; return $self->{submeta_strict_check} }
  10         33  
13 19     19 1 23 sub find_submeta { my $self = shift; return $self->{find_submeta} }
  19         47  
14              
15             ## override
16             sub new {
17 13     13 1 7539 my $class = shift;
18 13 100       74 my %params = ( @_ == 1 ) ? %{ $_[0] } : @_;
  1         3  
19              
20             ## no critic (Subroutines::ProtectPrivateSubs)
21 13 100       39 Type::Tiny::_croak "Need to supply submeta" unless exists $params{submeta};
22 11 100       26 Type::Tiny::_croak "Need to supply submeta_strict_check" unless exists $params{submeta_strict_check};
23 10 100       25 Type::Tiny::_croak "Need to supply find_submeta" unless exists $params{find_submeta};
24             ## use critic
25              
26 9 100       21 if (!exists $params{name}) {
27 8 100       26 $params{name} = $params{submeta_strict_check} ? 'StrictSubMeta' : 'SubMeta';
28             }
29              
30             $params{inlined} = $params{submeta_strict_check}
31 2     2   14 ? sub { my ($self, $var) = @_; $self->submeta->is_strict_same_interface_inlined($var) }
  2         5  
32 9 100   6   53 : sub { my ($self, $var) = @_; $self->submeta->is_relaxed_same_interface_inlined($var) };
  6         72  
  6         17  
33              
34 9         54 return $class->SUPER::new(%params);
35             }
36              
37             ## override
38 16     16 1 48 sub has_parent { return !!0 }
39 20     20 1 446 sub can_be_inlined { return !!1 }
40 20     20 1 1588 sub has_coercion { return !!1 }
41 12     12   1651 sub _is_null_constraint { return !!0 } ## no critic (ProhibitUnusedPrivateSubroutines)
42              
43             ## override
44             sub _build_display_name { ## no critic (ProhibitUnusedPrivateSubroutines)
45 4     4   34 my $self = shift;
46 4         14 return sprintf('%s[%s]', $self->name, $self->submeta->display);
47             }
48              
49             #
50             # e.g.
51             # Reference bless( sub { "DUMMY" }, 'Sub::WrapInType' ) did not pass type constraint "SubMeta"
52             # Reason : invalid scalar return. got: Str, expected: Int
53             # Expected : sub (Int,Int) => Int
54             # Got : sub (Int,Int) => Str
55             #
56             ## override
57             sub get_message {
58 4     4 1 16542 my $self = shift;
59 4         6 my $other_meta = shift;
60              
61 4         11 my $default_message = $self->SUPER::get_message($other_meta);
62 4         5730 my $detail_message = $self->get_detail_message($other_meta);
63              
64 4         9 my $message = <<"```";
65             $default_message
66             $detail_message
67             ```
68              
69 4         8 return $message;
70             }
71              
72             sub get_detail_message {
73 5     5 1 17 my $self = shift;
74 5         7 my $other_meta = shift;
75              
76 5         14 state $SubMeta = InstanceOf['Sub::Meta'];
77              
78 5         3527 my ($error_message, $expected, $got);
79 5 100       12 if ($self->submeta_strict_check) {
80 2         4 $error_message = $self->submeta->error_message($other_meta);
81 2         5 $expected = $self->submeta->display;
82 2 100       5 $got = $SubMeta->check($other_meta) ? $other_meta->display : "";
83             }
84             else {
85 3         10 $error_message = $self->submeta->relaxed_error_message($other_meta);
86 3         8 $expected = $self->submeta->display;
87 3 100       14 $got = $SubMeta->check($other_meta) ? $other_meta->display : "";
88             }
89              
90 5         26 my $message = <<"```";
91             Reason : $error_message
92             Expected : $expected
93             Got : $got
94             ```
95              
96 5         12 return $message;
97             }
98              
99             ## override
100             sub _build_coercion { ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
101 4     4   477 my $self = shift;
102              
103             return Type::Coercion->new(
104             display_name => "to_${self}",
105             type_constraint => $self,
106             type_coercion_map => [
107             Ref['CODE'] => sub {
108 18     18   2608 my $sub = shift;
109 18         41 return $self->find_submeta->($sub);
110             },
111 4         13 ],
112             );
113             }
114              
115             1;
116             __END__