lib/Moose/Meta/TypeConstraint/Parameterized.pm

   1 package Moose::Meta::TypeConstraint::Parameterized;
   2
   3 use strict;
   4 use warnings;
   5 use metaclass;
   6
   7 use Scalar::Util 'blessed';
   8 use Carp         'confess';
   9 use Moose::Util::TypeConstraints;
  10
  11 our $VERSION   = '0.02';
  12 our $AUTHORITY = 'cpan:STEVAN';
  13
  14 use base 'Moose::Meta::TypeConstraint';
  15
  16 __PACKAGE__->meta->add_attribute('type_parameter' => (
  17     accessor  => 'type_parameter',
  18     predicate => 'has_type_parameter',
  19 ));
  20
  21 sub compile_type_constraint {
  22     my $self = shift;
  23
  24     ($self->has_type_parameter)
  25         || confess "You cannot create a Higher Order type without a type parameter";
  26
  27     my $type_parameter = $self->type_parameter;
  28
  29     (blessed $type_parameter && $type_parameter->isa('Moose::Meta::TypeConstraint'))
  30         || confess "The type parameter must be a Moose meta type";
  31
  32     foreach my $type (Moose::Util::TypeConstraints::get_all_parameterizable_types()) {
  33         if (my $constraint = $type->generate_constraint_for($self)) {
  34             $self->_set_constraint($constraint);
  35             return $self->SUPER::compile_type_constraint;
  36         }
  37     }
  38
  39     # if we get here, then we couldn't
  40     # find a way to parameterize this type
  41     confess "The " . $self->name . " constraint cannot be used, because "
  42           . $self->parent->name . " doesn't subtype or coerce from a parameterizable type.";
  43 }
  44
  45 1;
  46
  47 __END__
  48
  49
  50 =pod
  51
  52 =head1 NAME
  53
  54 Moose::Meta::TypeConstraint::Parameterized - Higher Order type constraints for Moose
  55
  56 =head1 METHODS
  57
  58 =over 4
  59
  60 =item B<compile_type_constraint>
  61
  62 =item B<type_parameter>
  63
  64 =item B<has_type_parameter>
  65
  66 =item B<meta>
  67
  68 =back
  69
  70 =head1 BUGS
  71
  72 All complex software has bugs lurking in it, and this module is no
  73 exception. If you find a bug please either email me, or add the bug
  74 to cpan-RT.
  75
  76 =head1 AUTHOR
  77
  78 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  79
  80 =head1 COPYRIGHT AND LICENSE
  81
  82 Copyright 2006-2008 by Infinity Interactive, Inc.
  83
  84 L<http://www.iinteractive.com>
  85
  86 This library is free software; you can redistribute it and/or modify
  87 it under the same terms as Perl itself.
  88
  89 =cut