File Coverage

blib/lib/Types/PDL.pm
Criterion Covered Total %
statement 27 27 100.0
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 36 36 100.0


line stmt bran cond sub pod time code
1             package Types::PDL;
2              
3             # ABSTRACT: PDL types using Type::Tiny
4              
5 6     6   1464611 use strict;
  6         51  
  6         212  
6 6     6   46 use warnings;
  6         16  
  6         295  
7              
8             our $VERSION = '0.01';
9              
10 6     6   43 use Carp;
  6         16  
  6         640  
11              
12 6         93 use Type::Library -base,
13             -declare => qw[
14             Piddle
15             Piddle0D
16             Piddle1D
17             Piddle2D
18             Piddle3D
19              
20             PiddleFromAny
21 6     6   2196 ];
  6         163104  
22              
23              
24 6     6   16236 use Types::Standard -types, 'is_Int';
  6         348066  
  6         87  
25 6     6   40236 use Type::Utils;
  6         32337  
  6         72  
26 6     6   13329 use Type::TinyX::Facets;
  6         51078  
  6         458  
27 6     6   2436 use String::Errf 'errf';
  6         127839  
  6         54  
28 6     6   2663 use B qw(perlstring);
  6         19  
  6         4690  
29              
30              
31             facet 'empty', sub {
32             my ( $o, $var ) = @_;
33             return unless exists $o->{empty};
34             errf '%{not}s%{var}s->isempty',
35             { var => $var, not => ( !!delete( $o->{empty} ) ? '' : '!' ) };
36             };
37              
38             facet 'null', sub {
39             my ( $o, $var ) = @_;
40             return unless exists $o->{null};
41             errf '%{not}s%{var}s->isnull',
42             { var => $var, not => ( !!delete( $o->{null} ) ? '' : '!' ) };
43             };
44              
45             facet ndims => sub {
46             my ( $o, $var ) = @_;
47              
48             my %o = map { ( $_ => delete $o->{$_} ) }
49             grep { exists $o->{$_} } qw[ ndims ndims_min ndims_max ];
50              
51             return unless keys %o;
52              
53             croak( "'$_' must be an integer\n" )
54             for grep { !is_Int( $o{$_} ) } keys %o;
55              
56              
57             if ( exists $o{ndims_max} and exists $o{ndims_min} ) {
58              
59             if ( $o{ndims_max} < $o{ndims_min} ) {
60             croak( "'ndims_min' must be <= 'ndims_max'\n" );
61             }
62              
63             elsif ( $o{ndims_min} == $o{ndims_max} ) {
64              
65             croak(
66             "cannot mix 'ndims' facet with either 'ndims_min' or 'ndims_max'\n"
67             ) if exists $o{ndims};
68              
69             $o{ndims} = delete $o{ndims_min};
70             delete $o{ndims_max};
71             }
72             }
73              
74             my @code;
75              
76             if ( exists $o{ndims_max} or exists $o{ndims_min} ) {
77              
78             if ( exists $o{ndims_min} ) {
79              
80             push @code, errf '%{var}s->ndims >= %{value}i',
81             {
82             var => $var,
83             value => delete $o{ndims_min} };
84             }
85              
86             if ( exists $o{ndims_max} ) {
87              
88             push @code, errf '%{var}s->ndims <= %{value}i',
89             {
90             var => $var,
91             value => delete $o{ndims_max} };
92             }
93             }
94              
95             elsif ( exists $o{ndims} ) {
96              
97             push @code, errf '%{var}s->ndims == %{value}i',
98             { var => $var, value => delete $o{ndims} };
99             }
100              
101             else {
102             return;
103             }
104              
105             croak( "cannot mix 'ndims' facet with either 'ndims_min' or 'ndims_max'\n" )
106             if keys %o;
107              
108             return join( ' and ', @code );
109             };
110              
111              
112             facetize qw[ empty null ndims ], class_type Piddle, { class => 'PDL' };
113              
114             facetize qw[ null ],
115             declare Piddle0D,
116             as Piddle[ ndims => 0];
117              
118             facetize qw[ empty null ],
119             declare Piddle1D,
120             as Piddle[ ndims => 1];
121              
122             facetize qw[ empty null ],
123             declare Piddle2D,
124             as Piddle[ ndims => 2];
125              
126             facetize qw[ empty null ],
127             declare Piddle3D,
128             as Piddle[ ndims => 3];
129              
130             declare_coercion PiddleFromAny,
131             to_type Piddle,
132             from Any,
133             q[ do { local $@;
134             require PDL::Core;
135             my $new = eval { PDL::Core::topdl( $_ ) };
136             $@ ? $_ : $new
137             }
138             ];
139              
140              
141             1;
142              
143             #
144             # This file is part of Types-PDL
145             #
146             # This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
147             #
148             # This is free software, licensed under:
149             #
150             # The GNU General Public License, Version 3, June 2007
151             #
152              
153             =pod
154              
155             =head1 NAME
156              
157             Types::PDL - PDL types using Type::Tiny
158              
159             =head1 VERSION
160              
161             version 0.01
162              
163             =head1 SYNOPSIS
164              
165             use Types::PDL -types;
166             use Type::Params qw[ validate ];
167             use PDL;
168              
169             validate( [ pdl ], Piddle );
170              
171             =head1 DESCRIPTION
172              
173             This module provides L compatible types for L.
174              
175             =head2 Types
176              
177             Types which accept parameters (see L) will list them.
178              
179             =head3 C
180              
181             Allows an object blessed into the class C, e.g.
182              
183             validate( [pdl], Piddle );
184              
185             It accepts the following parameters:
186              
187             null
188             empty
189             ndims
190             ndims_min
191             ndims_max
192              
193             =head3 C
194              
195             Allows an object blessed into the class C with C = 0.
196             It accepts the following parameters:
197              
198             null
199              
200             =head3 C
201              
202             Allows an object blessed into the class C with C = 1.
203             It accepts the following parameters:
204              
205             null
206             empty
207              
208             =head3 C
209              
210             Allows an object blessed into the class C with C = 2.
211             It accepts the following parameters:
212              
213             null
214             empty
215              
216             =head3 C
217              
218             Allows an object blessed into the class C with C = 3.
219             It accepts the following parameters:
220              
221             null
222             empty
223              
224             =head2 Coercions
225              
226             The following coercions are provided, and may be applied via a type
227             object's L or
228             L methods, e.g.
229              
230             Piddle->plus_coercions( PiddleFromAny );
231              
232             =head3 C
233              
234             Uses L to coerce the value into a piddle.
235              
236             =head2 Parameters
237              
238             Some types take optional parameters which add additional constraints
239             on the object. For example, to indicate that only empty piddles are
240             accepted:
241              
242             validate( [pdl], Piddle[ empty => 1 ] );
243              
244             The available parameters are:
245              
246             =head3 C
247              
248             This accepts a boolean value; if true the piddle must be empty
249             (i.e. the C method returns true), if false, it must not be
250             empty.
251              
252             =head3 C
253              
254             This accepts a boolean value; if true the piddle must be a null
255             piddle, if false, it must not be null.
256              
257             =head3 C
258              
259             This specifies a fixed number of dimensions which the piddle must
260             have. Don't mix use this with C or C.
261              
262             =head3 C
263              
264             The minimum number of dimensions the piddle may have. Don't specify
265             this with C.
266              
267             =head3 C
268              
269             The maximum number of dimensions the piddle may have. Don't specify
270             this with C.
271              
272             =head1 BUGS AND LIMITATIONS
273              
274             You can make new bug reports, and view existing ones, through the
275             web interface at L.
276              
277             =head1 AUTHOR
278              
279             Diab Jerius
280              
281             =head1 COPYRIGHT AND LICENSE
282              
283             This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
284              
285             This is free software, licensed under:
286              
287             The GNU General Public License, Version 3, June 2007
288              
289             =cut
290              
291             __END__