Question

What am I missing in the following subtype and coercion chain? I’d like to be able to coerce an arrayref of validated types or die from the following inputs:

• Coercible string
• Valid string
• Arrayref of mixed coercible and valid strings

Assume that all types are fully namespaced and that the undeclared functions validate and coerce_str validate (returning bool) and coerce and return a valid string from input, respectively.

subtype 'CustomType'
  => as 'Str'
    => where { validate($_) }
  ;

coerce 'CustomType'
  => from 'Str'
    => via { if (my $coerced = coerce_str($_)) {
               return $coerced;
             } 
             return $_;
           }
  ;

subtype 'ArrayRefofCustomTypes'
  => as 'ArrayRef[CustomType]'
  ;

coerce 'ArrayRefofCustomTypes'
  => from 'CustomType'
    => via { [ $_ ] }
  ;

has 'values' => ( is => 'ro', required => 1,
                  isa => 'ArrayRefofCustomTypes', 
                  coerce => 1,
                );

I know CustomType works; as I can define an attribute as it and initialize the object using either a coercible string or an already valid string. What I’m not so sure how to do is to explicitly handle delving into the passed arrayref from the constructor and validating all of the contained strings individually. I’ve read through the documentation on deep coercion (http://search.cpan.org/dist/Moose/lib/Moose/Manual/Types.pod#Deep_coercion) a couple times and I’m just not quite getting it and am hoping someone can point me in the right direction. Thanks!

Here, I’d pared it down to outline it more succinctly, but:

{ 
  package My::Class;

  use strict;
  use warnings;

  use Moose;
  use Moose::Util::TypeConstraints;

  subtype 'CustomType'
    => as 'Str'
      => where { validate($_) }
    ;

  coerce 'CustomType'
    => from 'Str'
      => via { if (my $coerced = coerce_str($_)) {
                 return $coerced;
               } 
               return $_;
             }
    ;

  subtype 'ArrayRefofCustomTypes'
    => as 'ArrayRef[CustomType]'
    ;

  coerce 'ArrayRefofCustomTypes'
    => from 'CustomType'
      => via { [ $_ ] }
    ;

  has 'values' => ( is => 'ro', required => 1,
                    isa => 'ArrayRefofCustomTypes', 
                    coerce => 1,
                  );

  sub validate {
    my $val = shift;
    if ($val =~ /^\w+$/) {
      return 1;
    }
    return ();
  }

  sub coerce_str {
    my $val = shift;
    $val =~ s/\W/_/g;
    return $val;
  }
}

{
  package main;

  use strict;
  use warnings;
  use Test::More qw/no_plan/;

  new_ok( 'My::Class' => [ values => [ 'valid' ] ]); #ok
  new_ok( 'My::Class' => [ values => [ qw/valid valid still_valid/ ] ]); #ok
  new_ok( 'My::Class' => [ values => 'valid' ]); # ok
  new_ok( 'My::Class' => [ values => [ 'invalid; needs some coercion - ^&%&^' ] ]); #not ok
  new_ok( 'My::Class' => [ values => 'invalid; needs some coercion - ^&%&^' ]); # not ok
  cmp_ok( My::Class::coerce_str('invalid; needs some coercion - ^&%&^'), 'eq', 'invalid__needs_some_coercion________', 'properly coerces strings'); #ok

}

Running that as-is gives me the below. The problem is not the validation, but that I’m not explicitly defining my coercions, and I’m not sure what I’m missing:

ok 1 - The object isa My::Class
ok 2 - The object isa My::Class
ok 3 - The object isa My::Class    
not ok 4 - new() died
#   Failed test 'new() died'
#   at testcoercion.pl line 63.
#     Error was:  Attribute (values) does not pass the type constraint because: Validation failed for 'ArrayRefofCustomTypes' with value [ "invalid; needs some coercion - ^&%&^" ] at C:/strawberry/perl/site/lib/Moose/Meta/Attribute.pm line 1131

<< cut >>

not ok 5 - new() died
#   Failed test 'new() died'
#   at testcoercion.pl line 64.
#     Error was:  Attribute (values) does not pass the type constraint because: Validation failed for 'ArrayRefofCustomTypes' with value "invalid; needs some coercion - ^&%&^" at C:/strawberry/perl/site/lib/Moose/Meta/Attribute.pm line 1131

<< cut >>

ok 6 - properly coerces strings
1..6
# Looks like you failed 2 tests of 6.

Answer 1

So yeah, coercion needs to be explicitly defined from base types to custom types for all permutations of input you want to take. Moving the coercion and validation code out to subroutines helps with preventing code duplication, but doesn’t completely eliminate it. The following code works as I’d expect, along with a TAP plan to prove it.

Though, while it works I’m not absolutely convinced it’s the intended way to handle this sort of thing. It’s doing a lot of explicit casting from base types to the arrayref custom type, and I’m not sure how well this’d work in a larger context if an accessor accepts multiple types with coercion.

Edit: Actually, at this point the coerce 'ArrayRefofCustomTypes' => from 'CustomType' is entirely unnecessary, the => from 'Str' will handle both valid and invalid input.

{ 
  package My::Class;

  use strict;
  use warnings;

  use Moose;
  use Moose::Util::TypeConstraints;

  subtype 'CustomType'
    => as 'Str'
      => where { validate_cust($_) }
    ;

  coerce 'CustomType'
    => from 'Str'
      => via { coerce_str_to_cust($_) }
    ;

  subtype 'ArrayRefofCustomTypes'
    => as 'ArrayRef[CustomType]'
    ;

  coerce 'ArrayRefofCustomTypes'
    => from 'CustomType'
      => via { [ $_ ] }
    => from 'ArrayRef[Str]'
      => via { [ map { coerce_str_to_cust($_) } @$_ ] }
    => from 'Str'
      => via { [ coerce_str_to_cust($_) ] }
    ;

  has 'values' => ( is => 'ro', required => 1,
                    isa => 'ArrayRefofCustomTypes', 
                    coerce => 1,
                  );

  sub validate_cust {
    my $val = shift;
    if ($val =~ /^\w+$/) {
      return 1;
    }
    return ();
  }

  sub coerce_str_to_cust {
    my $val = shift;
    my $coerced = $val;
    $coerced =~ s/\s/_/g;

    if (validate_cust($coerced)) {
      return $coerced;
    }
    else {
      return $val;
    }
  }
}

{
  package main;

  use strict;
  use warnings;
  use Test::More tests => 12;
  use Test::Exception;

  new_ok( 'My::Class' => [ values => [ 'valid' ] ]);
  new_ok( 'My::Class' => [ values => [ qw/valid valid still_valid/ ] ]);
  new_ok( 'My::Class' => [ values => 'valid' ]);
  new_ok( 'My::Class' => [ values => [ 'invalid and needs some coercion' ] ]);
  new_ok( 'My::Class' => [ values => 'invalid and needs some coercion' ]);
  new_ok( 'My::Class' => [ values => [ 'valid', 'valid', 'invalid and needs some coercion' ] ]);
  throws_ok { my $obj =  My::Class->new( values => [ q/can't be coerced cause it has &^%#$*&^%#$s in it/ ] ); } qr/Attribute \(values\) does not pass the type constraint because: Validation failed/, 'throws exception on uncoercible input';

  my $uncoercible = q/can't be coerced cause it has &^%#$*&^%#$s in it/;
  cmp_ok( My::Class::coerce_str_to_cust('invalid and needs some coercion'), 'eq', 'invalid_and_needs_some_coercion', 'properly coerces strings');
  cmp_ok( My::Class::coerce_str_to_cust($uncoercible), 'eq', $uncoercible , 'returns uncoercible strings unmodified');
  ok( My::Class::validate_cust('valid'), 'valid string validates');
  ok( My::Class::validate_cust(My::Class::coerce_str_to_cust('invalid and needs some coercion')), 'coerced string validates');
  ok( !My::Class::validate_cust('invalid and needs some coercion'), "invalid string doesn't validate");
}