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

package Types::PDL;

# ABSTRACT: PDL types using Type::Tiny

use strict;
use warnings;

our $VERSION = '0.02';

use Carp;

use Type::Library -base,
  -declare => qw[
    Piddle
    Piddle0D
    Piddle1D
    Piddle2D
    Piddle3D

    PiddleFromAny
  ];


use Types::Standard -types, 'is_Int';
use Type::Utils;
use Type::TinyX::Facets;
use String::Errf 'errf';
use B qw(perlstring);


facet 'empty', sub {
    my ( $o, $var ) = @_;
    return unless exists $o->{empty};
    errf '%{not}s%{var}s->isempty',
      { var => $var, not => ( !!delete( $o->{empty} ) ? '' : '!' ) };
};

facet 'null', sub {
    my ( $o, $var ) = @_;
    return unless exists $o->{null};
    errf '%{not}s%{var}s->isnull',
      { var => $var, not => ( !!delete( $o->{null} ) ? '' : '!' ) };
};

facet ndims => sub {
    my ( $o, $var ) = @_;

    my %o = map { ( $_ => delete $o->{$_} ) }
      grep { exists $o->{$_} } qw[ ndims ndims_min ndims_max ];

    return unless keys %o;

    croak( "'$_' must be an integer\n" )
      for grep { !is_Int( $o{$_} ) } keys %o;


    if ( exists $o{ndims_max} and exists $o{ndims_min} ) {

        if ( $o{ndims_max} < $o{ndims_min} ) {
            croak( "'ndims_min' must be <= 'ndims_max'\n" );
        }

        elsif ( $o{ndims_min} == $o{ndims_max} ) {

            croak(
                "cannot mix 'ndims' facet with either 'ndims_min' or 'ndims_max'\n"
            ) if exists $o{ndims};

            $o{ndims} = delete $o{ndims_min};
            delete $o{ndims_max};
        }
    }

    my @code;

    if ( exists $o{ndims_max} or exists $o{ndims_min} ) {

        if ( exists $o{ndims_min} ) {

            push @code, errf '%{var}s->ndims >= %{value}i',
              {
                var   => $var,
                value => delete $o{ndims_min} };
        }

        if ( exists $o{ndims_max} ) {

            push @code, errf '%{var}s->ndims <= %{value}i',
              {
                var   => $var,
                value => delete $o{ndims_max} };
        }
    }

    elsif ( exists $o{ndims} ) {

        push @code, errf '%{var}s->ndims == %{value}i',
          { var => $var, value => delete $o{ndims} };
    }

    else {
        return;
    }

    croak( "cannot mix 'ndims' facet with either 'ndims_min' or 'ndims_max'\n" )
      if keys %o;

    return join( ' and ', @code );
};


facet 'type', sub {
    my ( $o, $var ) = @_;
    return unless exists $o->{type};
    my $type = eval { PDL::Type->new( delete $o->{type} )->ioname };
    croak( "type must be a valid type name or a PDL::Type object: $@\n" )
      if $@;

    errf '%{var}s->type->ioname eq q[%{type}s]',
      { var => $var, type => $type };
};

facetize qw[ empty null ndims type ], class_type Piddle, { class => 'PDL' };

facetize qw[ null ], declare Piddle0D, as Piddle [ ndims => 0 ];

facetize qw[ empty null ], declare Piddle1D, as Piddle [ ndims => 1 ];

facetize qw[ empty null ], declare Piddle2D, as Piddle [ ndims => 2 ];

facetize qw[ empty null ], declare Piddle3D, as Piddle [ ndims => 3 ];

declare_coercion PiddleFromAny, to_type Piddle, from Any, q[ do { local $@;
          require PDL::Core;
          my $new = eval { PDL::Core::topdl( $_ )  };
          $@ ? $_ : $new
     }
  ];


1;

#
# This file is part of Types-PDL
#
# This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.
#
# This is free software, licensed under:
#
#   The GNU General Public License, Version 3, June 2007
#

=pod

=head1 NAME

Types::PDL - PDL types using Type::Tiny

=head1 VERSION

version 0.02

=head1 SYNOPSIS

  use Types::PDL -types;
  use Type::Params qw[ validate ];
  use PDL;

  validate( [ pdl ], Piddle );

=head1 DESCRIPTION

This module provides L compatible types for L.

=head2 Types

Types which accept parameters (see L) will list them.

=head3 C

Allows an object blessed into the class C, e.g.

  validate( [pdl], Piddle );

It accepts the following parameters:

  null
  empty
  ndims
  ndims_min
  ndims_max
  type

=head3 C

Allows an object blessed into the class C with C = 0.
It accepts the following parameters:

  null
  type

=head3 C

Allows an object blessed into the class C with C = 1.
It accepts the following parameters:

  null
  empty
  type

=head3 C

Allows an object blessed into the class C with C = 2.
It accepts the following parameters:

  null
  empty
  type

=head3 C

Allows an object blessed into the class C with C = 3.
It accepts the following parameters:

  null
  empty
  type

=head2 Coercions

The following coercions are provided, and may be applied via a type
object's L or
L methods, e.g.

  Piddle->plus_coercions( PiddleFromAny );

=head3 C

Uses L to coerce the value into a piddle.

=head2 Parameters

Some types take optional parameters which add additional constraints
on the object.  For example, to indicate that only empty piddles are
accepted:

  validate( [pdl], Piddle[ empty => 1 ] );

The available parameters are:

=head3 C

This accepts a boolean value; if true the piddle must be empty
(i.e. the C method returns true), if false, it must not be
empty.

=head3 C

This accepts a boolean value; if true the piddle must be a null
piddle, if false, it must not be null.

=head3 C

This specifies a fixed number of dimensions which the piddle must
have. Don't mix use this with C or C.

=head3 C

The minimum number of dimensions the piddle may have. Don't specify
this with C.

=head3 C

The maximum number of dimensions the piddle may have. Don't specify
this with C.

=head3 C

The type of the piddle. The value may be a L object or a
string containing the name of a type (e.g., C). For a complete
list of types, run this command:

  perl -MPDL::Types=mapfld,ppdefs \
    -E 'say mapfld( $_ => 'ppsym' => 'ioname' )  for ppdefs'

=head1 BUGS AND LIMITATIONS

You can make new bug reports, and view existing ones, through the
web interface at L.

=head1 AUTHOR

Diab Jerius

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2017 by Smithsonian Astrophysical Observatory.

This is free software, licensed under:

  The GNU General Public License, Version 3, June 2007

=cut

__END__