lib/Moose/Meta/TypeConstraint/Parameterizable.pm

   1 package Moose::Meta::TypeConstraint::Parameterizable;
   2
   3 use strict;
   4 use warnings;
   5 use metaclass;
   6
   7 our $VERSION   = '0.56';
   8 our $AUTHORITY = 'cpan:STEVAN';
   9
  10 use base 'Moose::Meta::TypeConstraint';
  11
  12 __PACKAGE__->meta->add_attribute('constraint_generator' => (
  13     accessor  => 'constraint_generator',
  14     predicate => 'has_constraint_generator',
  15 ));
  16
  17 sub generate_constraint_for {
  18     my ($self, $type) = @_;
  19
  20     return unless $self->has_constraint_generator;
  21
  22     return $self->constraint_generator->($type->type_parameter)
  23         if $type->is_subtype_of($self->name);
  24
  25     return $self->_can_coerce_constraint_from($type)
  26         if $self->has_coercion
  27         && $self->coercion->has_coercion_for_type($type->parent->name);
  28
  29     return;
  30 }
  31
  32 sub _can_coerce_constraint_from {
  33     my ($self, $type) = @_;
  34     my $coercion   = $self->coercion;
  35     my $constraint = $self->constraint_generator->($type->type_parameter);
  36     return sub {
  37         local $_ = $coercion->coerce($_);
  38         $constraint->(@_);
  39     };
  40 }
  41
  42
  43 1;
  44
  45 __END__
  46
  47
  48 =pod
  49
  50 =head1 NAME
  51
  52 Moose::Meta::TypeConstraint::Parameterizable - Higher Order type constraints for Moose
  53
  54 =head1 METHODS
  55
  56 =over 4
  57
  58 =item B<constraint_generator>
  59
  60 =item B<has_constraint_generator>
  61
  62 =item B<generate_constraint_for>
  63
  64 =item B<meta>
  65
  66 =back
  67
  68 =head1 BUGS
  69
  70 All complex software has bugs lurking in it, and this module is no
  71 exception. If you find a bug please either email me, or add the bug
  72 to cpan-RT.
  73
  74 =head1 AUTHOR
  75
  76 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  77
  78 =head1 COPYRIGHT AND LICENSE
  79
  80 Copyright 2006-2008 by Infinity Interactive, Inc.
  81
  82 L<http://www.iinteractive.com>
  83
  84 This library is free software; you can redistribute it and/or modify
  85 it under the same terms as Perl itself.
  86
  87 =cut